Trailing-Edge
-
PDP-10 Archives
-
BB-H506E-SM
-
cobol/source/putera.mac
There are 7 other files named putera.mac in the archive. Click here to see a list.
; UPD ID= 3261 on 11/26/80 at 4:42 PM by WRIGHT
TITLE PUTERA FOR COBOL V12C
SUBTTL PUT OUT A DIAGNOSTIC AL BLACKINGTON/CAM
SEARCH COPYRT
SALL
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1974, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
SEARCH P
%%P==:%%P
DEBUG==:DEBUG
;EDITS
;V10*****************
;NAME DATE COMMENTS
;********************
TWOSEG
.COPYRIGHT ;Put COPYRIGHT statement in .REL file.
RELOC 400000
SALL
ENTRY FATALW ;PUT OUT A FATAL DIAG FOR CURRENT WORD
ENTRY WARNW ;PUT OUT A WARNING DIAG FOR CURRENT WORD
ENTRY FATAL ;PUT OUT A FATAL DIAG (LN & CP HAVE BEEN SET UP)
ENTRY WARN ;PUT OUT A WARNING DIAG (LN & CP HAVE BEEN SET UP)
ENTRY WARNAD ;PUT OUT A WARNING DIAG WITH APPENDED DATA
ENTRY PUTERA ;PUT OUT "DW" AS IS
IFN ANS74,<
INTERN FLG.ER ;PUT OUT FIPS FLAGGER WARNING
INTERN FLG.ES ;DITTO (LN & CP HAVE BEEN SET UP)
INTERN TST.L,TST.LI,TST.HI,TST.H,TST.RP,TST.DB,TST.68,TST.IB,TST.VX,TST.8,TST.NS
>
EXTERNAL DEVDED ;OUTPUT ERROR
EXTERNAL ERALN, ERAPOS, ERAFAZ, PHASEN
EXTERNAL ERABHO, ERADEV
EXTERNAL WORDLN, WORDCP
;ENTER WITH DIAG NUMBER IN "DW"
FATALW: MOVE LN,WORDLN ;SET UP LN &
MOVE CP,WORDCP ; CP
JRST FATAL
WARNW: MOVE LN,WORDLN
MOVE CP,WORDCP
JRST WARN
;ENTER WITH DIAG NUMBER IN "DW", LINE NUMBER IN "LN", AND
; CHARACTER POSITION IN "CP".
FATAL: IORI DW,DWFATL ;SET "FATAL" FLAG
SWON FFATAL ;SET "FATAL" SWITCH
IFE DEBUG,<SETZM BINDEV##> ;OMIT REL FILE IF FATAL ERROR
WARN: DPB LN,ERALN ;INSERT LN INTO DW
DPB CP,ERAPOS ;INSERT CP INTO DW
MOVE TE,PHASEN ;PUT PHASE NUMBER INTO
DPB TE,ERAFAZ ; DW
;ENTER WITH "DW" ALL SET UP
PUTERA: SOSG ERABHO+2 ;IS BUFFER FULL?
JRST RITERA ;YES--GO WRITE IT OUT
PUTER1: IDPB DW,ERABHO+1 ;PUT "DW" INTO BUFFER
POPJ PP,
IFN ANS74,<
;HERE FOR ERRORS FOUND IN THE SYNTAX SCAN (PHASE B, C, & D)
TST.L: MOVEI TA,%LV.L ;LOW
JRST TST.ER
TST.LI: MOVEI TA,%LV.LI ;LOW-INTERMEDIATE
JRST TST.ER
TST.HI: MOVEI TA,%LV.HI ;HIGH-INTERMEDIATE
JRST TST.ER
TST.H: MOVEI TA,%LV.H ;HIGH
JRST TST.ER
TST.RP: MOVEI TA,%LV.RP ;REPORT WRITER
JRST TST.ER
TST.DB: MOVEI TA,%LV.DB ;DATA BASE
JRST TST.ER
TST.68: MOVEI TA,%LV.68 ;COBOL-68 LEFTOVER
JRST TST.ER
TST.IB: MOVEI TA,%LV.IB ;IBM COMPATIBILITY
JRST TST.ER
TST.VX: MOVEI TA,%LV.VX ;VAX COBOL-74 COMPATIBLE
JRST TST.ER
TST.8: MOVEI TA,%LV.8 ;COBOL-8x EXTENSION
JRST TST.ER
TST.NS: MOVEI TA,%LV.NS ;NON-STANDARD
TST.ER: SKIPN FLGSW## ;DO WE WANT FIPS FLAGGING?
POPJ PP, ;NO
; JRST FLG.ER ;YES, TEST LEVEL REQUIRED
;ENTER WITH TA CONTAINING THE LEVEL FLAG
FLG.ER: MOVE LN,WORDLN ;SET UP LN &
MOVE CP,WORDCP ; CP
FLG.ES: ANDCM TA,FLGSW ;CLEAR THE BITS WE ALLOW
JUMPE TA,CPOPJ## ;RETURN IF ITS WITHIN LIMITS
PUSH PP,TB ;SAVE NEXT ACC
MOVE TB,TA
JFFO TB,.+1 ;GET LEFT MOST 1
MOVEI TB,^D36
SUB TB,TA ;GET BIT NUMBER
MOVS TA,TB ;LEVEL FOUND IN LHS
POP PP,TB
HRRI TA,E.507 ;WARNING NO. WITH EXTRA DATA
; JRST WARNAD ; SO WE CAN GIVE EXACT MESSAGE
>
;PUT OUT A WARNING DIAG WITH APPENDED NAME.
;ENTER WITH LH OF "TA" CONTAINING A TABLE-LINK TO NAME TO BE PRINTED,
; RH OF "TA" CONTAINING DIAGNOSTIC NUMBER.
WARNAD: HRRZ DW,TA ;GET DIAG NUMBER
PUSHJ PP,WARN ;WRITE OUT FIRST WORD
HLRZ DW,TA ;GET TABLE LINK
JRST PUTERA ;WRITE IT OUT AND RETURN
;EMPTY THE BUFFER
RITERA: OUT ERA,
JRST PUTER1 ;NO ERRORS -- RETURN
MOVEI CH,ERADEV ;ERROR -- WE LOSE
JRST DEVDED ;NEVER RETURN
END