Trailing-Edge
-
PDP-10 Archives
-
BB-Z759A-SM
-
cobol-source/handan.mac
There are 21 other files named handan.mac in the archive. Click here to see a list.
; UPD ID= 1395 on 9/26/83 at 4:07 PM by HOFFMAN
TITLE HANDAN - HANDY, DANDY DEBUGGING ROUTINES FOR THE COBOL COMPILER.
SUBTTL /DAW
SEARCH COPYRT
SALL
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
COPYRIGHT (C) 1980, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION
;REWRITE OF ANDY KASMAR'S ORIGINAL "HANDAN" MODULE.
;CALL THE DEBUGGER BY TYPING "PUSHJ PP,DEB" TO DDT.
;THIS ROUTINE IS NATIVE ON TOPS-20 AND USES THE COMMAND JSYS.
HISEG
.COPYRIGHT ;Put standard copyright statement in REL file
SALL
SEARCH P
SEARCH TABLES
SEARCH COMUNI
IFN TOPS20,< SEARCH MONSYM,MACSYM>
IFE TOPS20,< SEARCH UUOSYM,MACTEN>
;MAKE SURE "TA" IS WHAT WE THOUGHT IT WAS.
IFN <TA-16>,<PRINTX ?WRONG AC DEFINITION!>
;AND USE NEW AC DEFS.
T1=1
T2=2
T3=3
T4=4
T5=5
P1=6
P2=7
P3=10
CH=11 ;USED BY TOPS10 COMMAND SCANNER
P=17
EXTERN PHASEN
EXTERN DEBC0,ATMBUF,TXTBUF
EXTERN AKTLOC,ALTLOC,CONLOC,CPYLOC,CRFLOC,DATLOC,DEBLOC,EOPLOC
EXTERN EXTLOC,FILLOC,FLOLOC,HLDLOC,LITLOC,MNELOC,NAMLOC,PRGLOC,PROLOC
EXTERN RCOLOC,RENLOC,RESLOC,RPWLOC,SECLOC,TAGLOC,TEMLOC,USELOC,VALLOC
EXTERN AKTNXT,ALTNXT,CONNXT,CPYNXT,CRFNXT,DATNXT,DEBNXT,EOPNXT
EXTERN EXTNXT,FILNXT,FLONXT,HLDNXT,LITNXT,MNENXT,NAMNXT,PRGNXT,PRONXT
EXTERN RCONXT,RENNXT,RESNXT,RPWNXT,SECNXT,TAGNXT,TEMNXT,USENXT,VALNXT
IFN MCS,<
EXTERN CDLOC,CDNXT
>
IFE TOPS20,< ;MORE COMMAND SCANNER THINGS
EXTERN TXTBBP,PRSCHR,PRSBBP,HLPTXT,CPOPJ1
>
IFN TOPS20,<
EXTERN CMDBLK,NOIBLK
>
SUBTTL MACRO DEFS.
DEFINE COMMANDS,<
AA EXIT,CMDEXT ;EXIT
AA HELP,CMDHLP ;HELP
AA SHOW,CMDSHO ;SHOW
>;END DEFINE COMMANDS
DEFINE SHOCMS,<
AA AKTTAB,SHOAKT ;SHOW AKTTAB
AA ALTAB,SHOAL ;SHOW ALTAB
AA CDTAB,SHOCD ;SHOW CDTAB
AA CONTAB,SHOCON ;SHOW CONTAB
AA CPYTAB,SHOCPY ;SHOW CPYTAB
AA CRFTAB,SHOCRF ;SHOW CRFTAB
AA DATAB,SHODAT ;SHOW DATAB
AA DBDTAB,SHODBD ;SHOW DBDTAB
AA DEBTAB,SHODEB ;SHOW DEBTAB
AA EOPTAB,SHOEOP ;SHOW EOPTAB
AA EXTAB,SHOEXT ;SHOW EXTAB
AA FILTAB,SHOFIL ;SHOW FILTAB
AA FLOTAB,SHOFLO ;SHOW FLOTAB
AA HLDTAB,SHOHLD ;SHOW HLDTAB
AA ITEM,SHOITM ;SHOW ITEM (FROM TABLE)
AA LITTAB,SHOLIT ;SHOW LITTAB
AA MNETAB,SHOMNE ;SHOW MNETAB
AA NAMTAB,SHONAM ;SHOW NAMTAB
AA PRGTAB,SHOPRG ;SHOW PRGTAB
AA PROTAB,SHOPRO ;SHOW PROTAB
AA RCOTAB,SHORCO ;SHOW RCOTAB
AA RENTAB,SHOREN ;SHOW RENTAB
AA RESTAB,SHORES ;SHOW RESTAB
AA RPWTAB,SHORPW ;SHOW RPWTAB
AA SECTAB,SHOSEC ;SHOW SECTAB
AA TAGTAB,SHOTAG ;SHOW TAGTAB
AA TEMTAB,SHOTEM ;SHOW TEMTAB
AA USETAB,SHOUSE ;SHOW USETAB
AA VALTAB,SHOVAL ;SHOW VALTAB
>;END DEFINE SHOCMS
DEFINE TEXT (STRING),<
XLIST
ASCIZ @STRING@
LIST
>
IFN TOPS20,<
DEFINE TYPE (ADDRESS),<
HRROI T1,ADDRESS
PSOUT%
>
DEFINE AA(NAME,DATA,FLAGS),< ;MACRO FOR COMMAND TABLES
XWD [IFNB <FLAGS>,<EXP CM%FW!<FLAGS>>
ASCIZ/NAME/],DATA
>
>;END TOPS20 MACRO DEFS.
IFE TOPS20,<
DEFINE TYPE (ADDRESS),<
OUTSTR ADDRESS
>
DEFINE AA(NAME,DATA,FLAGS),<
XWD [ASCIZ/NAME/],DATA
>
>;END TOPS10 MACRO DEFS.
SUBTTL ENTRY AND EXIT POINTS
TRN 1000 ;SEARCH WORD FOR TOPS10
; (IN CASE THERE ARE NO SYMBOLS)
;HERE FROM DDT WHEN HE TYPES "PUSHJ PP,DEB"
ENTRY DEB
DEB: MOVEM 0,DEBC0 ;SAVE ACS NOW.
MOVE 0,[1,,DEBC0+1] ;FROM,,TO
BLT 0,DEBC0+17 ;SAVE 'EM ALL.
IFN TOPS20,<
DMOVE T1,NOILIT ;GET PROTOTYPE NOISE BLOCK
DMOVEM T1,NOIBLK ;STORE IT
MOVE T1,[CMDLIT,,CMDBLK] ;COPY COMMAND BLOCK TO LOWSEG.
BLT T1,CMDBLK+.CMBLN-1 ;. .
>;END IFN TOPS20
TYPE <[ASCIZ/[COBOL compiler debugger]
/]>
JRST NEWCMD ;GO GET A NEW COMMAND
;HERE TO EXIT FROM THE DEBUGGER.
DEBEXT: TYPE <[ASCIZ/[Exit compiler debugger]
/]>
MOVE 0,[DEBC0+1,,1] ;RESTORE SAVED ACS.
BLT 0,17
MOVE 0,DEBC0 ; . .
POPJ PP, ;AND RETURN TO DDT
SUBTTL COMMAND SCANNER
;SEPARATE COMMAND SCANNERS, TOPS10 AND TOPS20
IFN TOPS20,<
NEWCMD: MOVEI T1,CMDBLK ;POINT TO COMMAND BLOCK
MOVEI T2,[FLDDB. (.CMINI)] ;INITIALIZATION FUNCTION
PUSHJ P,COMMND ;GO DO IT
NEWPAR: MOVE P,DEBC0+P ;RESTORE THE STACK
MOVEI T2,[FLDDB. (.CMKEY,,CMDTAB)] ;POINT TO COMMAND TABLE
PUSHJ P,COMMND ;READ THE COMMAND
NEWP1B: MOVE T2,(T2) ;GET ADDRESS OF ROUTINE
PUSHJ P,(T2) ;CALL IT
JRST NEWCMD ;AND GET A NEW COMMAND
;TOPS20 COMMAND SCANNER (CONT'D)
;COMMAND TABLE.
CMDTAB: CMDLEN,,CMDLEN ;HEADER
COMMANDS
CMDLEN==.-CMDTAB-1 ;NUMBER OF COMMANDS
;SHOW COMMAND TABLE.
SHOTAB: SHOLEN,,SHOLEN ;HEADER
SHOCMS
SHOLEN==.-SHOTAB-1 ;NUMBER OF COMMANDS
;COMMAND JSYS BLOCK
CMDLIT: EXP NEWPAR ;ADDRESS OF REPARSE ROUTINE
.PRIIN,,.PRIOU ;INPUT,,OUTPUT JFNS
-1,,APROMP ;CONTROL-R BUFFER
-1,,TXTBUF ;POINTER TO TEXT BUFFER
-1,,TXTBUF ;POINTER TO CURRENT POSITION
TXTLEN ;NUMBER OF CHARACTERS IN BUFFER
0 ;NUMBER OF UNPARSED CHARACTERS
-1,,ATMBUF ;POINTER TO ATOM BUFFER
TXTLEN ;NUMBER OF CHARACTERS IN BUFFER
.CMBLN==.-CMDLIT ;LENGTH OF COMMAND JSYS BLOCK
;PROTOTYPE NOISE BLOCK
NOILIT: FLDDB. (.CMNOI)
SUBTTL EXIT COMMAND - HELP COMMAND - SHOW COMMAND
;EXIT
CMDEXT: MOVEI T2,[ASCIZ/from debugger/]
PUSHJ P,NOISE ;PARSE NOISE
PUSHJ P,CONFRM ;CONFIRM COMMAND
JRST DEBEXT ;GO EXIT
;HELP
CMDHLP: PUSHJ P,CONFRM ;CONFIRM
TYPE HLPMSG ;TYPE HELP MESSAGE
POPJ P, ;DONE, RETURN
;SHOW
CMDSHO: MOVEI T2,[FLDDB. (.CMKEY,,SHOTAB)] ;LIST OF SHOW COMMANDS
PUSHJ P,COMMND ;GO DO IT
MOVE T2,(T2) ;GET ADDRESS OF ROUTINE
JRST (T2) ;GO TO IT
;SHOW ITEM
SHOITM: MOVEI T2,[ASCIZ/whose table address is/]
PUSHJ P,NOISE ;PARSE NOISE
MOVEI T2,[FLDDB. (.CMNUM,CM%SDH,^D8,<Octal relative table address>)]
PUSHJ P,COMMND ;PARSE NUMBER
MOVE TA,T2 ;COPY NUMBER TO TA.
PUSHJ P,CONFRM ;CONFIRM
JRST SHOIGO ;GO SHOW ITEM
;SHOW <TABLE> AT OFFSET..
SHOTBL: MOVEI T2,[ASCIZ/entry at offset/]
PUSHJ P,NOISE ;PARSE NOISE
MOVEI T2,[FLDDB. (.CMNUM,CM%SDH,^D8,<Octal relative table address>)]
PUSHJ P,COMMND ;PARSE NUMBER
MOVE TA,T2 ;COPY NUMBER TO TA
PUSHJ P,CONFRM ;CONFIRM
TYPE CRLF ;TYPE A CRLF
JRST @SHOTBB(T4) ;JUMP TO ROUTINE
SUBTTL PARSING SUBROUTINES
LOSE: TYPE [ASCIZ/
? /] ;TYPE PRELIMIARY TEXT
PUSHJ P,LSTFER ;TYPE LAST ERROR IN THIS FORK
LOSFIN: TYPE CRLF ;TYPE FINAL STRING
ERESET: MOVEI T1,.PRIIN ;GET READY
CFIBF% ;CLEAR INPUT BUFFER
MOVE P,DEBC0+P ;RESET STACK
JRST NEWCMD ;AND GO GET ANOTHER COMMAND
;TYPE LAST ERROR IN THIS FORK
LSTFER: MOVEI T1,.PRIOU ;OUTPUT TO TERMINAL
HRLOI T2,.FHSLF ;LAST ERROR IN THIS FORK
SETZ T3, ;ALL OF THE TEXT
ERSTR%
JFCL
JFCL
POPJ P, ;RETURN
NOISE: HRROM T2,NOIBLK+.CMDAT ;SAVE AS DATA
MOVEI T2,NOIBLK ;POINT TO BLOCK
JRST COMMND ;AND GO TO COMMAND JSYS
CONFRM: MOVEI T2,[FLDDB. (.CMCFM)] ;GET CONFIRM FUNCTION
COMMND: COMND% ;PARSE THE FUNCTION
ERJMP LOSE ;ERROR, GO COMPLAIN
TXNE T1,CM%NOP ;DID IT PARSE?
JRST LOSE ;NO, COMPLAIN
POPJ P, ;YES, RETURN SUCESSFULLY
>;END IFN TOPS20
SUBTTL TOPS10 COMMAND SCANNER
IFE TOPS20,<
XECUTC: TYPE CRLF
XECUTX: MOVE P,DEBC0+P ;RESTORE THE STACK PTR.
NEWCMD: OUTSTR APROMP ;TYPE PROMPT
MOVEI T3,TXTLEN ;GET MAX SIZE OF BUFFER
MOVE T2,[POINT 7,TXTBUF] ;POINT TO IT
MOVEM T2,TXTBBP ;SET INITIAL BP TO IT
DECOD0: INCHWL T1 ;GET A CHAR
CAIN T1,33 ;ALTMODE
JRST DECALT ;YES
CAIN T1,15 ;CR--IGNORE
JRST DECOD0
CAIE T1,32 ;CONTROL-Z
CAIN T1,7 ;CONTROL-G
JRST DECALT ;ALTERNATE FORM OF CRLF
CAIE T1,13 ;VT?
CAIN T1,14 ;FORM-FEED
MOVEI T1,12 ;PRETEND IT'S A LF
CAIN T1,12 ;GOT A LF NOW?
JRST DECEOL ;YES
IDPB T1,T2 ;STORE CHAR IN COMMAND LINE
SOJG T3,DECOD0 ;IF STILL ROOM, GO GET SOME MORE
TYPE [ASCIZ/?Command line too long/]
JRST XECUTC ;TRY AGAIN
;HERE FOR ALTERNATE FORMS OF CRLF, WHEN THE EOL DOESN'T DO A CRLF
DECALT: TYPE CRLF ;ALTMODE--TYPE CRLF
MOVEI T1,12 ;PRETEND IT'S A LF
;HERE WHEN LINE IS DONE
DECEOL: IDPB T1,T2 ;STORE EOL CHAR
MOVEI T1,0 ;STORE NULL
IDPB T1,T2
;COMMAND LINE IS NOW IN "TXTBUF"
PUSHJ P,GETUCH ;GET FIRST UPPERCASE CHAR
PUSHJ P,NONSP ;GET FIRST NON-SPACE
CAIN CH,12 ;JUST A CR ON LINE?
JRST XECUTX ;YES, GO TYPE PROMPT AGAIN
MOVSI T1,-NMCMDS ;GET -# OF COMMANDS,,ADDR OF TABLE
HRRI T1,CMDTBL
PUSHJ P,KEYWRD ;PARSE THE KEYWORD
JRST XECUTX ;UNKNOWN KEYWORD
;KEYWORD MATCHED -- GO DO IT
PUSHJ P,(T2) ;GO DO IT NOW
JRST XECUTX ;RETURN FROM DOING COMMAND
SUBTTL TOPS10 COMMAND TABLES
CMDTBL: COMMANDS ;EXPAND COMMAND TABLE
NMCMDS==.-CMDTBL ;NUMBER OF COMMANDS
;SHOW COMMANDS
SHOCTB: SHOCMS ;EXPAND SHOW COMMANDS
NMSHCM==.-SHOCTB ;NUMBER OF "SHOW" COMMANDS
SUBTTL TOPS10 COMMANDS
;EXIT
CMDEXT: PUSHJ P,CONFRM ;CONFIRM COMMAND
JRST DEBEXT ;GO EXIT
;HELP
CMDHLP: PUSHJ P,CONFRM ;CONFIRM COMMAND
TYPE HLPMSG ;TYPE HELP MESSAGE
POPJ P, ;RETURN
;SHOW
CMDSHO: PUSHJ P,NONSP ;GET 1ST NON-SPACE
CAIN CH,12 ;CR?
JRST LISSHO ;LIST SHOW COMMANDS
MOVE T1,[-NMSHCM,,SHOCTB]
PUSHJ P,KEYWRD ;PARSE THE KEYWORD
JRST XECUTX ;FAILED
JRST (T2) ;GO TO ROUTINE
LISSHO: TYPE [ASCIZ/?Type a keyword after SHOW, one of the following:
/]
MOVE P1,[-NMSHCM,,SHOCTB]
LISSH1: HLRZ T1,(P1) ;GET ASCII TEXT
OUTSTR (T1) ;TYPE IT
TYPE CRLF
AOBJN P1,LISSH1 ;TYPE OUT ALL COMMANDS
POPJ P, ;RETURN
;SHOW ITEM at table address ... nnn
SHOITM: PUSH P,TXTBBP ;SAVE BP FOR A SEC.
PUSHJ P,NONSP
POP P,TXTBBP
CAIE CH,12 ;GOT CR NEXT?
JRST SHOIT1 ;NO, LOOK FOR NUMBER
TYPE [ASCIZ/?SHOW ITEM requires an argument (table address)/]
JRST XECUTC
SHOIT1: PUSHJ P,PRSOCT ;PARSE OCTAL NUMBER
JUMPE T2,NOTPIN ;"POSITIVE INTEGER REQUIRED"
JUMPLE T1,NOTPIN
MOVE TA,T1 ;COPY NUMBER TO TA
PUSHJ P,CONFRM ;CONFIRM
JRST SHOIGO ;GO DO IT
;SHOW <TABLE> AT OFFSET..
SHOTBL: PUSH P,TXTBBP ;SAVE BP FOR A SEC.
PUSHJ P,NONSP
POP P,TXTBBP
CAIE CH,12 ;GOT CR?
JRST SHOTB1 ;NO, LOOK FOR NUMBER
TYPE [ASCIZ/?Requires another argument (octal table offset)/]
JRST XECUTC
SHOTB1: MOVE P1,T4 ;SAVE T4 FOR A SEC..
PUSHJ P,PRSOCT ;PARSE OCTAL NUMBER
JUMPE T2,NOTPIN
JUMPLE T1,NOTPIN
MOVE TA,T1 ;COPY NUMBER TO TA
PUSHJ P,CONFRM ;CONFIRM
TYPE CRLF ;TYPE A CRLF
JRST @SHOTBB(P1) ;JUMP TO ROUTINE
;GIVE ERROR MESSAGE: "POSITIVE INTEGER REQUIRED"
NOTPIN: TYPE [ASCIZ/?Positive integer required/]
PUSHJ P,BUTGOT
JRST XECUTX
SUBTTL TOPS10 KEYWORD PARSER
;ROUTINE TO PARSE A KEYWORD. READS AND UPDATES BYTE POINTER TO COMMAND
; LINE (TXTBBP).
;CALL: T1/ -# OF KEYWORDS IN TABLE,,ADDR OF TABLE
; CH/ FIRST CHAR OF KEYWORD
; TABLE FORMAT IS [ASCIZ/KEYWORD/],,ADDR OF ROUTINE TO CALL
;
;RETURNS .+1 IF KEYWORD DOESN'T MATCH, OR IS NOT A UNIQUE ABBREVIATION
;RETURNS .+2 IF KEYWORD DOES MATCH, WITH ADDRESS OF ROUTINE IN T2
;
;UPPER AND LOWERCASE ARE TREATED AS EQUIVALENT
KEYWRD: MOVEM CH,PRSCHR ;SAVE 1ST PARSED CHARACTER
MOVE T4,[POINT 7,ATMBUF] ;PUT KEYWORD IN ATOM BUFFER FIRST
PUSH P,TXTBBP ;REMEMBER BP AT START OF KEYWORD
POP P,PRSBBP
KEYWR2: CAIL CH,"A"
CAILE CH,"Z" ;BETWEEN "A" AND "Z"?
JRST NOTLTR ;NO
OKLTR: IDPB CH,T4 ;OK, STORE CHARACTER
PUSHJ P,GETUCH ;GET NEXT CHARACTER OF KEYWORD
JRST KEYWR2 ;GO CHECK IT OUT
NOTLTR: CAIL CH,"0"
CAILE CH,"9" ;ALLOW 0 THRU 9 IN KEYWORD
CAIA
JRST OKLTR
CAIN CH,"-" ;ALLOW DASH IN KEYWORD
JRST OKLTR
;HMM THIS CHARACTER IS INVALID. MUST BE END OF KEYWORD.
;NOW WE TRY TO MATCH IT WITH TABLE ENTRIES.
KEYWD2: MOVEI T2,0 ;STORE NULL TO END KEYWORD ATOM
IDPB T2,T4
MOVE T4,[POINT 7,ATMBUF] ;GET POINTER TO ATOM BUFFER
ILDB T5,T4 ;GET FIRST CHARACTER OF KEYWORD
JUMPE T5,[MOVEI T1,[ASCIZ/Keyword expected/]
JRST KEWERR]
KEYWD3: HLR T3,(T1) ;GET PTR TO AN ASCII STRING
HRLI T3,(POINT 7,)
ILDB T2,T3 ;GET FIRST CHAR OF THIS STRING
CAMN T2,T5 ;DOES IT MATCH SO FAR?
JRST KEYWD4 ;YES!
CAML T2,T5 ;GONE TOO FAR?
JRST NOMTCH ;YES, SAY "NO MATCH"
AOBJN T1,KEYWD3 ;NO, GET DOWN TO A COMMAND THAT STARTS WITH
;THIS CHARACTER
NOMTCH: MOVEI T1,[ASCIZ/Invalid keyword/] ;DEFAULT MESSAGE
;HERE WHEN WE GOT A KEYWORD ERROR.. TYPE THE STANDARD ERROR MESSAGE
; UNLESS HE HAS SETUP "HLPTXT"
KEWERR: OUTCHR ["?"] ;START MESSAGE
SKIPE HLPTXT ;ANY HELP MESSAGE?
JRST [OUTSTR @HLPTXT ;YES, PRINT IT
SETZM HLPTXT ;CLEAR MESSAGE
JRST KEWER1] ;AND GO FINISH MESSAGE
OUTSTR (T1) ;PRINT STANDARD MESSAGE
KEWER1: OUTSTR CRLF ;CRLF TO END MESSAGE
SETZM PRSCHR ;CLEAR 1ST PARSED CHAR
POPJ P, ;ERROR RETURN
;HERE IF FIRST CHARACTER OF KEYWORD MATCHES
KEYWD4: ILDB T5,T4 ;GET NEXT CHARACTER
ILDB T2,T3
JUMPE T5,[JUMPE T2,KWDMTC ;GOT A MATCH
JRST TRYUNI] ;ELSE TRY FOR A UNIQUE ABBREVIATION
CAMN T2,T5 ;STILL MATCH?
JRST KEYWD4 ;YES, CONTINUE TRYING TO MATCH
;STOPPED MATCHING. LOOK AT NEXT COMMAND FOR POSSIBLE MATCH.
CAML T2,T5 ;SKIP IF MAYBE NEXT COMMAND IS OK
JRST NOMTCH ;NO, INVALID KEYWORD
MOVE T4,[POINT 7,ATMBUF] ;POINT TO ATOM BUFFER AGAIN
ILDB T5,T4 ;GET 1ST CHAR AGAIN
AOBJN T1,KEYWD3 ;IF MORE COMMANDS, TRY NEXT ONE
JRST NOMTCH ;REACHED END OF TABLE, NO MATCH
;HERE TO TRY FOR A UNIQUE ABBREVIATION
TRYUNI: AOBJP T1,OKUNI ;NO MORE COMMANDS = IT MATCHES!
HLR T3,(T1) ;POINT TO NEXT COMMAND
HRLI T3,(POINT 7,)
MOVE T4,[POINT 7,ATMBUF] ;BETTER NOT MATCH TO UNIQUE ABBREV..
TRYUN1: ILDB T5,T4 ;GET CHAR TYPED
ILDB T2,T3 ;GET CHAR OF NEXT COMMAND
CAMN T5,T2 ;SAME SO FAR?
JRST TRYUN1 ;YES, KEEP LOOKING
JUMPN T5,OKUNI ;IT IS UNIQUE IF REAL CHAR TYPED AND NO MATCH
NOTUNI: MOVEI T1,[ASCIZ/Not unique/] ;GET DEFAULT MESSAGE
JRST KEWERR ;GO PRINT ERROR
OKUNI: SUBI T1,1 ;MAKE T1 POINT TO THE COMMAND THAT IS UNIQUE
;HERE WHEN WE GOT A MATCH. RETURN T2=ADDRESS OF ROUTINE TO CALL
KWDMTC: HRRZ T2,(T1) ;RH OF TABLE ENTRY = ADDRESS OF ROUTINE
SETZM HLPTXT ;CLEAR HELP TEXT IF GIVEN
SETZM PRSCHR ;CLEAR 1ST PARSED CHAR
JRST CPOPJ1 ;GIVE GOOD RETURN
;ROUTINE TO TYPE ", GOT: ", 'REST OF LINE'
; CALL AFTER TYPING "?BLAH EXPECTED"
;RETURNS WITH POPJ
BUTGOT: TYPE [ASCIZ/, got: /]
SKIPE T1,PRSCHR ;A PARSED CHAR TO TYPE?
OUTCHR T1 ;YES
SETZM PRSCHR ;CLEAR PARSED CHARACTER
BUTGT1: ILDB T1,PRSBBP
JUMPE T1,BGERR ;?INTERNAL COBDDT ERROR
CAIN T1,12 ;EOL
JRST TEOL
OUTCHR T1 ;TYPE THE CHARACTER
JRST BUTGT1 ;LOOP
TEOL: TYPE [ASCIZ/<EOL>
/]
POPJ P, ;RETURN
BGERR: TYPE [ASCIZ/
?Internal HANDAN error - a bug!
/]
POPJ P,
;ROUTINE TO CONFIRM A COMMAND
; IT POPJ'S IF NEXT THING ON THE LINE IS A CRLF, WHICH CONFIRMS THE
;COMMAND. IF THE NEXT THING ISN'T A CRLF, IT TYPES AN ERROR MESSAGE
; AND GOES TO XECUTX TO PARSE ANOTHER COMMAND.
CONFRM: PUSHJ P,NONSP ;GET TO FIRST NON-BLANK
CAIN CH,12 ;CR?
POPJ P, ;YES, POPJ
NOTCFM: TYPE [ASCIZ/?Not confirmed/]
PUSH P,TXTBBP
POP P,PRSBBP
MOVEM CH,PRSCHR ;ALSO TYPE THIS CHAR
PUSHJ P,BUTGOT
JRST XECUTX
;GET FIRST CHAR WHICH IS A NON-SPACE
NONSP: CAIE CH,11
CAIN CH,40
CAIA
POPJ P,
PUSHJ P,GETUCH ;GET UPPERCASE CHAR
JRST NONSP
;ROUTINE TO PARSE A NUMBER
;RETURNS NUMBER PARSED IN T1
;RETURNS NUMBER OF DIGITS IN T2
PRSDEC: SKIPA T3,[^D10] ;PARSE A DECIMAL NUMBER
PRSOCT: MOVEI T3,^D8 ;PARSE AN OCTAL NUMBER
SETZB T1,T2 ;CLEAR RESULT ,T2=0 MEANS NO NUMBERS SEEN YET
MOVE T4,TXTBBP
MOVEM T4,PRSBBP
SETZM PRSCHR ;CHAR IN CH IS NOT USED
PRSRD1: ILDB CH,TXTBBP
CAIE CH,11
CAIN CH," "
JRST PRSRD1
CAIN CH,"-" ;MINUS SIGN
JRST [SETO T5, ;YES, SET FLAG
ILDB CH,TXTBBP ;GET NEXT CHAR
JRST PRSRD2] ;GO LOOK AT NUMBER
SETZ T5, ;NO, CLEAR FLAG
PRSRD2: CAIL CH,"0"
CAILE CH,"0"-1(T3) ;IS NUMBER IN RANGE?
JRST [SKIPE T5 ;STOP PARSING, IF NUMBER NEGATIVE?
MOVN T1,T1 ;YES, NEGATE
POPJ P,] ;RETURN
IMUL T1,T3 ;MAKE ROOM FOR NEXT DIGIT
ADDI T1,-"0"(CH) ;ADD IT IN
ADDI T2,1 ;COUNT DIGITS SEEN
ILDB CH,TXTBBP ;GET NEXT CHARACTER
JRST PRSRD2 ;AND KEEP GOING...
;ROUTINE TO RETURN NEXT CHARACTER OF COMMAND LINE AND MAKE IT UPPERCASE.
GETUCH: ILDB CH,TXTBBP ;GET NEXT CHAR
CAIL CH,"A"+40 ;CONVERT LOWERCASE
CAILE CH,"Z"+40
POPJ P,
SUBI CH,40 ;TO UPPERCASE
POPJ P, ;AND RETURN
>;END IFE TOPS20
SUBTTL COMMON COMMAND SCANNER THINGS
;ROUTINES TO SETUP INDEX FOR SHOW KEYWORD
;SHOW AKTTAB
SHOAKT: MOVEI T4,0 ;T4=0 FOR AKTTAB TYPE
JRST SHOTBL
;SHOW ALTTAB
SHOAL: MOVEI T4,1 ;T4=1 FOR ALTTAB TYPE
JRST SHOTBL
;SHOW CDTAB
SHOCD: MOVEI T4,2 ;T4=2 FOR CDTAB TYPE
JRST SHOTBL
;SHOW CONTAB
SHOCON: MOVEI T4,3 ;T4=3 FOR CONTAB TYPE
JRST SHOTBL
;SHOW CPYTAB
SHOCPY: MOVEI T4,4 ;T4=4 FOR CPYTAB TYPE
JRST SHOTBL
;SHOW CRFTAB
SHOCRF: MOVEI T4,5 ;T4=5 FOR CRFTAB TYPE
JRST SHOTBL
;SHOW DATAB
SHODAT: MOVEI T4,6 ;T4=6 FOR DATAB TYPE
JRST SHOTBL
;SHOW DBDTAB
SHODBD: MOVEI T4,7 ;T4=7 FOR DBDTAB TYPE
JRST SHOTBL
;SHOW DEBTAB
SHODEB: MOVEI T4,10 ;T4=10 FOR DEBTAB TYPE
JRST SHOTBL
;SHOW EOPTAB
SHOEOP: MOVEI T4,11 ;T4=11 FOR RPWTAB TYPE
JRST SHOTBL
;SHOW EXTAB
SHOEXT: MOVEI T4,12 ;T4=12 FOR EXTAB TYPE
JRST SHOTBL
;SHOW FILTAB
SHOFIL: MOVEI T4,13 ;T4=13 FOR FILTAB TYPE
JRST SHOTBL
;SHOW FLOTAB
SHOFLO: MOVEI T4,14 ;T4=14 FOR FLOTAB TYPE
JRST SHOTBL
;SHOW HLDTAB
SHOHLD: MOVEI T4,15 ;T4=15 FOR HLDTAB TYPE
JRST SHOTBL
;SHOW LITTAB
SHOLIT: MOVEI T4,16 ;T4=16 FOR LITTAB TYPE
JRST SHOTBL
;SHOW MNETAB
SHOMNE: MOVEI T4,17 ;T4=17 FOR MNETAB TYPE
JRST SHOTBL
;SHOW NAMTAB
SHONAM: MOVEI T4,20 ;T4=20 FOR NAMTAB TYPE
JRST SHOTBL
;SHOW PRGTAB
SHOPRG: MOVEI T4,21 ;T4=21 FOR RPWTAB TYPE
JRST SHOTBL
;SHOW PROTAB
SHOPRO: MOVEI T4,22 ;T4=22 FOR PROTAB TYPE
JRST SHOTBL
;SHOW RCOTAB
SHORCO: MOVEI T4,23 ;T4=23 FOR RCOTAB TYPE
JRST SHOTBL
;SHOW RENTAB
SHOREN: MOVEI T4,24 ;T4=24 FOR RENTAB TYPE
JRST SHOTBL
;SHOW RESTAB
SHORES: MOVEI T4,25 ;T4=25 FOR RESTAB TYPE
JRST SHOTBL
;SHOW RPWTAB
SHORPW: MOVEI T4,26 ;T4=26 FOR RPWTAB TYPE
JRST SHOTBL
;SHOW SECTAB
SHOSEC: MOVEI T4,27 ;T4=27 FOR SECTAB TYPE
JRST SHOTBL
;SHOW TAGTAB
SHOTAG: MOVEI T4,30 ;T4=30 FOR TAGTAB TYPE
JRST SHOTBL
;SHOW TEMTAB
SHOTEM: MOVEI T4,31 ;T4=31 FOR TEMTAB TYPE
JRST SHOTBL
;SHOW UPNTAB
SHOUPN: MOVEI T4,32 ;T4=32 FOR RPWTAB TYPE
JRST SHOTBL
;SHOW USETAB
SHOUSE: MOVEI T4,33 ;T4=33 FOR USETAB TYPE
JRST SHOTBL
;SHOW VALTAB
SHOVAL: MOVEI T4,34 ;T4=34 FOR VALTAB TYPE
JRST SHOTBL
;DISPATCH VECTOR
SHOTBB: TYPAKT ;0-AKTTAB
TYPAL ;1-ALTAB
TYPCD ;2-CDTAB
TYPCON ;3-CONTAB
TYPCPY ;4-CPYTAB
TYPCRF ;5-CRFAB
TYPDAT ;6-DATTAB
TYPDBD ;7-DBDTAB
TYPDEB ;10-DEBTAB
TYPEOP ;11-EOPTAB
TYPEXT ;12-EXTTAB
TYPFIL ;13-FILTAB
TYPFLO ;14-FLOTAB
TYPHLD ;15-HLDTAB
TYPLIT ;16-LITTAB
TYPMNE ;17-MNETAB
TYPNAM ;20-NAMTAB
TYPPRG ;21-PRGTAB
TYPPRO ;22-PROTAB
TYPRCO ;23-RCOTAB
TYPREN ;24-RENTAB
TYPRES ;25-RESTAB
TYPRPW ;26-RPWTAB
TYPSEC ;27-SECTAB
TYPTAG ;30-TAGTAB
TYPTEM ;31-TEMTAB
TYPUPN ;32-UPNTAB
TYPUSE ;33-USETAB
TYPVAL ;34-VALTAB
SUBTTL SHOW ITEM
;HERE TO EXECUTE THE "SHOW ITEM" COMMAND.
; THE ITEM ADDRESS IS IN TA.
SHOIGO: TLNE TA,-1 ;MAKE SURE LH IS 0
JRST SHOIE0 ;NO, ERROR
JUMPE TA,SHOIE1 ;CAN'T BE 0
LDB T4,[POINT 3,TA,20] ;GET TABLE TYPE CODE
TRZ TA,700000 ;CLEAR 3 BITS TO GIVE REL ADDRESS.
TYPE [ASCIZ/
--/] ;PRETTY FORMAT
HLRZ T1,TYPTBL(T4) ;GET ADDRESS OF ASCIZ TABLE NAME
TYPE <(T1)> ;TYPE IT
TYPE [ASCIZ/ entry--
/]
TYPE CRLF
HRRZ T1,TYPTBL(T4) ;GET ADDRESS OF ROUTINE TO DO IT
JRST (T1) ;GO DO IT.
SHOIE0: TYPE [ASCIZ/?Must be positive number less than 777777
/]
POPJ P,
SHOIE1: TYPE [ASCIZ/?Must be non-zero, e.g. 100043
/]
POPJ P,
;THE TABLE TYPES
DEFINE TT(NAME),<
[ASCIZ/NAME'TAB/],,TYP'NAME
>
TYPTBL: TT FIL
TT DAT
TT CON
TT LIT
TT PRO
TT EXT
TT VAL
TT MNE
SUBTTL TABLES USED TO TYPE OUT ENTRIES
;MACROS
DEFINE BYT(BP,KIND,MESSAGE),<
XLIST ;DON'T WASTE SPACE IN LISTING
EXTERN BP
XWD BP,KIND
[ASCIZ @BP@],,[ASCIZ @MESSAGE@]
LIST
>
;OPTIONAL ITEMS
DEFINE OPTBYT(BP,CHKROU,DOROU,KIND,MESSAGE),<
XLIST ;DON'T WASTE SPACE IN LISING
EXTERN BP
XWD BP,KIND
[ASCIZ @BP@],,[ASCIZ @MESSAGE@]
XWD CHKROU,DOROU
LIST
>
;AKTTAB ENTRIES
AKTDAT: XWD AKTLEN,0
BYT AK.FLK,FILINK,<FILTAB link>
AKTLEN==.-AKTDAT
;OPTIONAL DATA FOR AKTTAB ENTRIES
AKTODT: XWD AKTOLN,0
OPTBYT AK.DLK,NONZRO,0,FILINK,<DATAB link>
OPTBYT AK.DUP,NONZRO,0,STATEM,<Duplicates specified>
AKTOLN==.-AKTODT
;ALTAB ENTRIES
ALDAT: XWD ALLEN,0
BYT AL.TAG,VALUE,<0= RH is relative address, 1= RH is TAG number>
BYT AL.ADD,VALUE,<Relative address of PROTAB entry, or tag number>
ALLEN==.-ALDAT
;CDTAB ENTRIES
IFN MCS,<
CDDAT: XWD CDLEN,0
BYT CD.NAM,NMLINK,<NAMTAB LINK>
BYT CD.LIN,DVALUE,<Line number of CD entry>
BYT CD.CHR,DVALUE,<Character position of CD entry>
BYT CD.RDL,ITMLNK,<CD record link>
BYT CD.TLL,ITMLNK,<Text lenght link>
BYT CD.FDL,ITMLNK,<Fake DATAB entry that points to CD name in NAMTAB>
CDLEN==.-CDDAT
CD1OPT: XWD CD1LEN,0
OPTBYT CD.SNL,ITMLNK,NONZRO,0,<Link to item with same name>
OPTBYT CD.OUT,STATEM,ISZERO,0,<Input CD>
OPTBYT CD.OUT,STATEM,NONZRO,0,<Output CD>
OPTBYT CD.INT,STATEM,NONZRO,0,<Initial input CD>
OPTBYT CD.DUP,VALUE,NONZRO,0,<Debug use procedure>
CD1LEN==.-CD1OPT
CD2OPT: XWD CD2LEN,0
OPTBYT CD.QNL,ITMLNK,NONZRO,0,<Q name link>
OPTBYT CD.Q1L,ITMLNK,NONZRO,0,<Sub Q1 link>
OPTBYT CD.Q2L,ITMLNK,NONZRO,0,<Sub Q2 link>
OPTBYT CD.Q3L,ITMLNK,NONZRO,0,<Sub Q3 link>
OPTBYT CD.MDL,ITMLNK,NONZRO,0,<Message data link>
OPTBYT CD.DC,ITMLNK,NONZRO,0,<Message time link>
OPTBYT CD.NAL,ITMLNK,NONZRO,0,<Source name link>
OPTBYT CD.KYL,ITMLNK,NONZRO,0,<Find key link>
OPTBYT CD.SKL,ITMLNK,NONZRO,0,<Status key link>
OPTBYT CD.COL,ITMLNK,NONZRO,0,<Message count link>
CD2LEN==.-CD2OPT
CD3OPT: XWD CD3LEN,0
OPTBYT CD.Q3L,ITMLNK,NONZRO,0,<Dest. table occ. # link>
OPTBYT CD.MDL,ITMLNK,NONZRO,0,<Index name link>
OPTBYT CD.DC,ITMLNK,NONZRO,0,<Message class link>
OPTBYT CD.NAL,ITMLNK,NONZRO,0,<Destination name link>
OPTBYT CD.KYL,ITMLNK,NONZRO,0,<Error key link>
OPTBYT CD.COL,ITMLNK,NONZRO,0,<Destination count link>
CD3LEN==.-CD3OPT
>;END IFN MCS
;CONTAB ENTRIES
CONDAT: XWD CONLEN,0
BYT CO.NAM,NMLINK,<NAMTAB link>
BYT CO.DAT,DTLINK,<Link to DATAB entry which this is a conditional>
CONLEN==.-CONDAT
CONODT: XWD CONOLN,0
OPTBYT CO.SAM,NONZRO,0,ITMLNK,<Link to item with same name>
OPTBYT CO.NVL,NONZRO,0,DVALUE,<Number of literal entries>
OPTBYT CO.FIG,NONZRO,0,STATEM,<Figurative constant>
OPTBYT CO.ALL,NONZRO,0,STATEM,<All>
OPTBYT CO.SP,NONZRO,0,STATEM,<Spaces>
OPTBYT CO.ZRO,NONZRO,0,STATEM,<Zero>
OPTBYT CO.QT,NONZRO,0,STATEM,<Quote>
OPTBYT CO.HV,NONZRO,0,STATEM,<High-value>
OPTBYT CO.LV,NONZRO,0,STATEM,<Low-value>
OPTBYT CO.TAG,NONZRO,0,DVALUE,<Tag value if not figcon>
CONOLN==.-CONODT
;CPYAB ENTRIES
CPYDAT: XWD CPYLEN,0
CPYLEN==.-CPYDAT
;CRFAB ENTRIES
CRFDAT: XWD CRFLEN,0
CRFLEN==.-CRFDAT
;DATAB ENTRIES
DATDAT: XWD DATLEN,0 ;HEADER
BYT DA.NAM,NMLINK,<NAMTAB LINK>
BYT DA.POP,ITMLNK,<LINK TO FATHER/BROTHER>
BYT DA.FAL,VALUE,<1= LINK TO FATHER, 0= LINK TO BROTHER>
BYT DA.SON,ITMLNK,<LINK TO SON>
BYT DA.LVL,LVLNUM,<Level number>
BYT DA.CLA,DCLASS,<CLASS>
BYT DA.USG,DUSAGE,<USAGE mode>
BYT DA.INS,DVALUE,<Internal size>
BYT DA.EXS,DVALUE,<External size>
BYT DA.NDP,DVALUE,<Number of decimal places>
BYT DA.LN,DVALUE,<Line number>
BYT DA.CP,DVALUE,<Character position>
BYT DA.RES,VALUE,<Byte residue>
DATLEN==.-DATDAT ;LENGTH INCLUDING HEADER
;OPTIONALLY PRINTED DATAB ENTRIES
OPBDAT: XWD OPBDLN,0 ;HEADER
OPTBYT DA.ERR,NONZRO,0,VALUE,<Syntax Error bit is set>
OPTBYT DA.DEF,ISZERO,0,STATEM,<Item is not defined>
OPTBYT DA.FAK,NONZRO,0,STATEM,<Item has a fake name>
OPTBYT DA.LPC,NONZRO,0,STATEM,<Item is LINAGE COUNTER or PAGE COUNTER>
OPTBYT DA.RBE,NONZRO,0,STATEM,<Item is referenced by ENTRY or PD USING>
OPTBYT DA.SCT,NONZRO,0,STATEM,<Item is a SUM counter>
OPTBYT DA.DFS,NONZRO,0,STATEM,<Item defined in the FILE SECTION>
OPTBYT DA.LKS,NONZRO,0,STATEM,<Item defined in the LINKAGE SECTION>
OPBDLN==.-OPBDAT ;LENGTH INCLUDING HEADER
;AND AFTER THE MAIN ITEMS
OPADAT: XWD OPADLN,0 ;HEADER
OPTBYT DA.SNL,NONZRO,0,VALUE,<Link to item with same name>
OPTBYT DA.VAL,NONZRO,0,VALUE,<VALUE link or addr. of LINKAGE ptr.>
OPTBYT DA.LOC,NONZRO,0,VALUE,<Run-time location>
OPTBYT DA.RPW,NONZRO,0,VALUE,<LINK to RPWTAB>
OPTBYT DA.SYL,NONZRO,0,STATEM,<Item is SYNC LEFT>
OPTBYT DA.SYR,NONZRO,0,STATEM,<Item is SYNC RIGHT>
OPTBYT DA.SGN,NONZRO,0,STATEM,<Item is signed>
OPTBYT DA.SSC,NONZRO,0,STATEM,<Separate sign character>
OPTBYT DA.LSC,NONZRO,0,STATEM,<Leading sign character>
OPTBYT DA.BWZ,NONZRO,0,STATEM,<BLANK WHEN ZERO>
OPTBYT DA.SUB,NONZRO,0,STATEM,<Item must be subscripted>
OPTBYT DA.EDT,NONZRO,0,STATEM,<Item is edited>
OPTBYT DA.RBS,NONZRO,0,STATEM,<Referenced by SUM>
OPTBYT DA.RDS,NONZRO,0,STATEM,<Referenced by "SOURCE" in DETAIL>
OPTBYT DA.JST,NONZRO,0,STATEM,<Item is Justified>
OPTBYT DA.DLL,NONZRO,0,STATEM,<DEPENDING at lower level>
OPTBYT DA.IDX,NONZRO,0,STATEM,<Item is INDEX>
OPTBYT DA.RDF,NONZRO,0,STATEM,<Item is a redefinition of another item>
OPTBYT DA.PIC,NONZRO,0,STATEM,<PICTURE clause seen>
OPTBYT DA.DRC,NONZRO,0,STATEM,<Item appears in DATA RECORDS clause>
OPTBYT DA.DEB,NONZRO,0,STATEM,<DEBUGGING on data-name>
OPTBYT DA.SLL,NONZRO,0,STATEM,<SYNC clause at lower level>
OPTBYT DA.PWA,NONZRO,0,STATEM,<Picture words allocated>
OPTBYT DA.VHL,NONZRO,0,STATEM,<VALUE at higher level>
OPTBYT DA.RDH,NONZRO,0,STATEM,<REDEFINES at higher level>
OPTBYT DA.DPR,NONZRO,0,STATEM,<Decimal point to right of item>
OPTBYT DA.NOC,NONZRO,0,VALUE,<Number of occurances>
OPADLN==.-OPADAT ;LENGTH INCLUDING HEADER
OPADT1: XWD OPAD1L,0 ;MORE OPTIONAL STUFF
OPTBYT DA.OCH,NONZRO,0,VALUE,<Higher level OCCURS>
OPTBYT DA.DEP,NONZRO,0,ITMLNK,<Link to depending item>
OPTBYT DA.DCR,NONZRO,0,VALUE,<DEPENDING conversion routine>
OPTBYT DA.KEY,NONZRO,0,VALUE,<Number of keys for OCCURS>
OPTBYT DA.XBY,NONZRO,0,VALUE,<First "INDEXED BY" item>
OPAD1L==.-OPADT1 ;LENGTH OF MORE OPTIONAL DATAB STUFF
OPADT2: XWD OPAD2L,0 ;EVEN MORE OPTIONAL STUFF
OPTBYT DA.FSC,NONZRO,0,VALUE,<Float or suppression character>
OPAD2L==.-OPADT2 ;LENGTH OF EVEN MORE OPTIONAL DATAB STUFF
;DBDTAB ENTRIES
DBDDAT: XWD DBDLEN,0
DBDLEN==.-DBDDAT
;DEBTAB ENTRIES
DEBDAT: XWD DEBLEN,0
BYT DB.DAT,DTLINK,<DATAB link>
BYT DB.DUP,ITMLNK,<USETAB link>
BYT DB.LN,DVALUE,<LINE number>
BYT DB.PRM,VALUE,<Param base>
DEBLEN==.-DEBDAT
DEBODT: XWD DEBOLN,0
OPTBYT DB.ARO,NONZRO,0,STATEM,<All references seen>
OPTBYT DB.IDP,NONZRO,0,STATEM,<Debug procedure should be used>
DEBOLN==.-DEBODT
;EOPTAB ENTRIES
;DATA DISPLAYED FOR OPERATOR ENTRIES
EOPOD1: XWD EO1LEN,0
BYT EO.COD,DVALUE,<Code for operator>
BYT EO.FLG,VALUE,<Runtime flags>
BYT EO.LN,DVALUE,<Line number for errors>
BYT EO.CP,DVALUE,<Character position for errors>
BYT EO.CD1,DVALUE,<Code for operator>
EO1LEN==.-EOPOD1
;DATA DISPLAYED FOR OPERANDS OTHER THAN LITERALS
EOPOD2: XWD EO2LEN,0
BYT EO.USG,DVALUE,<Usage code>
BYT EO.LN,DVALUE,<Line number for errors>
BYT EO.CP,DVALUE,<Character position for errors>
BYT EO.NUM,DVALUE,<Number of following entries to be used as subscripts>
BYT EO.TYP,VALUE,<Type of operand>
BYT EO.ADR,ITMLNK,<Relative address of operand entry>
EO2LEN==.-EOPOD2
;OPTIONAL DATA FOR OPERANDS OTHER THAN LITERALS
EOPOD3: XWD EO3LEN,0
OPTBYT EO.SYL,NONZRO,0,STATEM,<Synchronized left>
OPTBYT EO.SYR,NONZRO,0,STATEM,<Synchronized right>
OPTBYT EO.NNU,NONZRO,0,STATEM,<Operand is numeric>
OPTBYT EO.NNU,ISZERO,0,STATEM,<Operand is non-numeric>
OPTBYT EO.JUS,ISZERO,0,STATEM,<Justified left>
OPTBYT EO.JUS,NONZRO,0,STATEM,<Justified right>
OPTBYT EO.LNK,NONZRO,0,STATEM,<Operand is in LINKAGE SECTION>
OPTBYT EO.TRU,NONZRO,0,STATEM,<Ignore truncation errors>
OPTBYT EO.ROU,NONZRO,0,STATEM,<ROUNDED clause is present>
OPTBYT EO.REF,NONZRO,0,STATEM,<Operand references FLOTAB>
OPTBYT EO.ASC,NONZRO,0,STATEM,<ASCENDING KEY for search>
OPTBYT EO.TMP,NONZRO,0,STATEM,<Operand is temp or AC's>
EO3LEN==.-EOPOD3
;DATA FOR LITERAL OR FIGURATIVE CONSTANT OPERANDS
EOPOD4: XWD EO4LEN,0
BYT EO.LN,DVALUE,<Line number for errors>
BYT EO.CP,DVALUE,<Character position for errors>
EO4LEN==.-EOPOD4
;OPTIONAL DATA FOR LITERAL OR FIGURATIVE CONSTANT OPERANDS
EOPOD5: XWD EO5LEN,0
OPTBYT EO.NIC,NONZRO,0,STATEM,<Item is numeric>
OPTBYT EO.NIC,ISZERO,0,STATEM,<Item is non-numeric>
OPTBYT EO.FIG,NONZRO,0,STATEM,<Item is a figurative constant>
OPTBYT EO.LIT,NONZRO,0,STATEM,<Literal contains non-sixbit characters>
OPTBYT EO.TOD,NONZRO,0,STATEM,<"TODAY">
OPTBYT EO.TAL,NONZRO,0,STATEM,<"TALLY">
OPTBYT EO.SPC,NONZRO,0,STATEM,<"SPACE", or "SPACES">
OPTBYT EO.ZRO,NONZRO,0,STATEM,<"ZERO", "ZEROS", or "ZEROES">
OPTBYT EO.QUO,NONZRO,0,STATEM,<"QUOTE", or "QUOTES">
OPTBYT EO.HIG,NONZRO,0,STATEM,<"HIGH-VALUE", or "HIGH-VALUES">
OPTBYT EO.LOW,NONZRO,0,STATEM,<"LOW-VALUE", or "LOW-VALUES">
OPTBYT EO.ALL,NONZRO,0,STATEM,<"ALL">
OPTBYT EO.SIZ,NONZRO,0,DVALUE,<Size of literal in words>
OPTBYT EO.VAL,NONZRO,0,ITMLNK,<Link to VALTAB>
EO5LEN==.-EOPOD5
;EXTAB ENTRIES
EXTDAT: XWD EXTLEN,0
BYT EX.NAM,NMLINK,<NAMTAB LINK>
BYT EX.CNT,DVALUE,<Extra words allocated>
BYT EX.HLD,VALUE,<Misc uses (incl HLDTAB lnk for CANCEL)>
EXTLEN==.-EXTDAT
EXTODT: XWD EXTOLN,0
OPTBYT EX.SAM,NONZRO,0,ITMLNK,<Link to item with same name>
OPTBYT EX.NRS,NONZRO,0,STATEM,<Referenced by a NON-RESIDENT segment>
OPTBYT EX.IND,NONZRO,0,STATEM,<Referenced by USER NAME>
OPTBYT EX.IND,ISZERO,0,STATEM,<Referenced by OP-SYS>
OPTBYT EX.PID,NONZRO,0,STATEM,<This is the program id>
OPTBYT EX.ENT,NONZRO,0,STATEM,<Entry entry>
OPTBYT EX.CAL,NONZRO,0,STATEM,<Referenced by a CALL>
EXTOLN==.-EXTODT
;FILTAB ENTRIES
FILDAT: XWD FILLEN,0 ;HEADER
BYT FI.NAM,NMLINK,<NAMTAB LINK>
BYT FI.OFT,VALUE,<OBJECT-TIME FILE TABLE LOCATION>
BYT FI.FBS,VALUE,<FILE BUFFER SIZE>
BYT FI.LN,VALUE,<LINE NUMBER OF SELECT>
BYT FI.CP,VALUE,<CHAR. POSITION OF SELECT>
BYT FI.NDV,VALUE,<NUMBER OF DEVICES>
BYT FI.VAL,ITMLNK,<LINK TO VALTAB DEVICE ENTRY>
BYT FI.FAM,ORGTYP,<File access>
BYT FI.ERM,RCMODE,<EXTERNAL RECORDING MODE>
BYT FI.IRM,RCMODE,<INTERNAL RECORDING MODE>
BYT FI.LBL,LABTYP,<Labels>
BYT FI.ORG,ORGTYP,<Organization>
BYT FI.RD,RDTYP,<Recording density>
BYT FI.RP,RPTYP,<Recording parity>
FILLEN==.-FILDAT ;LENGTH INCLUDING HEADER
FILOPD: XWD FILOLN,0 ;HEADER
OPTBYT FI.SAM,NONZRO,0,NMLINK,<Link to item with same name>
OPTBYT FI.RCT,NONZRO,0,DVALUE,<Count specified in rerun>
OPTBYT FI.ONE,NONZRO,0,STATEM,<First RD seen for this file>
OPTBYT FI.MRE,NONZRO,0,STATEM,<More than one report for this file>
OPTBYT FI.COD,NONZRO,0,STATEM,<Code clause specified for this file>
OPTBYT FI.POS,NONZRO,0,DVALUE,<File position in a multi-file reel>
OPTBYT FI.NXT,NONZRO,0,ITMLNK,<Table link to the next FILTAB entry>
OPTBYT FI.INO,NONZRO,0,STATEM,<There are input OPENS>
OPTBYT FI.OUO,NONZRO,0,STATEM,<There are output OPENS>
OPTBYT FI.IOO,NONZRO,0,STATEM,<There are input/output OPENS>
OPTBYT FI.ADV,NONZRO,0,STATEM,<Write advancing seen>
OPTBYT FI.DSD,NONZRO,0,STATEM,<Defined in an SD>
OPTBYT FI.VLR,NONZRO,0,STATEM,<Data records are variable length>
OPTBYT FI.RER,NONZRO,0,STATEM,<Rerun on END-OF-REEL>
OPTBYT FI.RRC,NONZRO,0,STATEM,<Rerun on count>
OPTBYT FI.FDD,NONZRO,0,STATEM,<FD or SD is defined>
OPTBYT FI.OPT,NONZRO,0,STATEM,<Optional file>
OPTBYT FI.PSN,NONZRO,0,STATEM,<Write positioning>
OPTBYT FI.RMS,NONZRO,0,STATEM,<RMS file>
OPTBYT FI.ACK,NONZRO,0,ITMLNK,<Link to "ACTUAL KEY">
OPTBYT FI.NBF,NONZRO,0,DVALUE,<Number of buffers>
OPTBYT FI.MRS,NONZRO,0,DVALUE,<Maximum record size>
OPTBYT FI.DRL,NONZRO,0,ITMLNK,<Link to first data record>
OPTBYT FI.ALK,NONZRO,0,ITMLNK,<Link to AKTTAB>
OPTBYT FI.SDL,NONZRO,0,ITMLNK,<Link to another file table with same multi file clause>
OPTBYT FI.VID,NONZRO,0,ITMLNK,<Link to VALUE OF ID>
OPTBYT FI.VDW,NONZRO,0,ITMLNK,<Link to VALUE OF DATE WRITTEN>
OPTBYT FI.SAL,NONZRO,0,ITMLNK,<Link to same area>
OPTBYT FI.ERR,NONZRO,0,ITMLNK,<Error use>
OPTBYT FI.LRS,NONZRO,0,DVALUE,<Minimum record size>
OPTBYT FI.MRS,NONZRO,0,DVALUE,<Maximum record size>
OPTBYT FI.SRA,NONZRO,0,ITMLNK,<Link to file sharing the same record area>
OPTBYT FI.LCP,NONZRO,0,ITMLNK,<Linage counter pointer>
OPTBYT FI.LPP,NONZRO,0,DVALUE,<Linage lines per page>
OPTBYT FI.WFA,NONZRO,0,DVALUE,<Linage with footing at>
OPTBYT FI.LAT,NONZRO,0,DVALUE,<Linage lines at top>
OPTBYT FI.LAB,NONZRO,0,DVALUE,<Linage lines at bottom>
OPTBYT FI.DEB,NONZRO,0,ITMLNK,<Use on debugging FILTAB>
OPTBYT FI.LCI,NONZRO,0,ITMLNK,<Linage counter initialization routine>
OPTBYT FI.DRC,NONZRO,0,STATEM,<Data records clause appeared in FD or SD>
OPTBYT FI.ADR,NONZRO,0,STATEM,<RH contains record area address>
OPTBYT FI.RM2,NONZRO,0,STATEM,<Recording mode declared>
OPTBYT FI.ENT,NONZRO,0,STATEM,<Use after error on open>
OPTBYT FI.DFR,NONZRO,0,STATEM,<Diferred output ISAM>
OPTBYT FI.BM,NONZRO,0,STATEM,<Byte mode>
OPTBYT FI.CKP,NONZRO,0,STATEM,<Checkpoint output>
OPTBYT FI.AKS,NONZRO,0,STATEM,<Alternate keys defined for this file>
OPTBYT FI.KYE,NONZRO,0,STATEM,<Error occured while building ISAM key info>
OPTBYT FI.VRS,NONZRO,0,STATEM,<Variable size data record>
OPTBYT FI.LOC,NONZRO,0,VALUE,<Base address of record area>
OPTBYT FI.SKY,NONZRO,0,ITMLNK,<Link to symbolic key>
OPTBYT FI.RKY,NONZRO,0,ITMLNK,<Link to record key>
OPTBYT FI.RLC,NONZRO,0,STATEM,<Bits 16-35 (FI.ALN) point to record>
OPTBYT FI.BLF,NONZRO,0,DVALUE,<Blocking factor>
OPTBYT FI.ALN,NONZRO,0,DVALUE,<LN of same record>
OPTBYT FI.VPP,NONZRO,0,ITMLNK,<Value of Project-Programmer link>
OPTBYT FI.RPG,NONZRO,0,ITMLNK,<RPWTAB link>
OPTBYT FI.OWA,NONZRO,0,VALUE,<Owner access bits>
OPTBYT FI.OTA,NONZRO,0,VALUE,<Owner access bits>
OPTBYT FI.RTC,NONZRO,0,DVALUE,<Retained records count>
OPTBYT FI.PFS,NONZRO,0,ITMLNK,<File status link>
OPTBYT FI.PEN,NONZRO,0,ITMLNK,<Error number link>
OPTBYT FI.PAC,NONZRO,0,ITMLNK,<Action code link>
OPTBYT FI.PIV,NONZRO,0,ITMLNK,<Value of id link>
OPTBYT FI.PBN,NONZRO,0,ITMLNK,<Block number link>
OPTBYT FI.PRN,NONZRO,0,ITMLNK,<Record number link>
OPTBYT FI.PFN,NONZRO,0,ITMLNK,<File name link>
OPTBYT FI.PFT,NONZRO,0,ITMLNK,<File table link>
OPTBYT FI.CKB,NONZRO,0,DVALUE,<Convert relative key before>
OPTBYT FI.CKA,NONZRO,0,DVALUE,<Convert relative key after>
OPTBYT FI.CRC,NONZRO,0,DVALUE,<Checkpoint record count>
OPTBYT FI.SID,NONZRO,0,DVALUE,<Size of value of id>
OPTBYT FI.FLN,NONZRO,0,DVALUE,<Line number of FD>
OPTBYT FI.FCP,NONZRO,0,DVALUE,<Character number of FD>
OPTBYT FI.NUM,NONZRO,0,DVALUE,<Number of this file>
OPTBYT FI.PRT,NONZRO,0,ITMLNK,<Value of protection code link>
OPTBYT FI.DEP,NONZRO,0,ITMLNK,<Depending item link>
OPTBYT FI.PAD,NONZRO,0,ITMLNK,<Padding character link>
OPTBYT FI.RKL,NONZRO,0,ITMLNK,<RMS key argument link>
OPTBYT FI.NOR,NONZRO,0,STATEM,<Write / No-write for CR ASCII stm>
OPTBYT FI.ABL,NONZRO,0,STATEM,<Apply basic-locking flag>
OPTBYT FI.ACP,NONZRO,0,DVALUE,<Character position of access>
FILOLN==.-FILOPD
;FLOTAB ENTRIES
FLODAT: XWD FLOLEN,0
BYT FL.PRO,ITMLNK,<PROTAB link>
BYT FL.NAM,ITMLNK,<NAMTAB link>
BYT FL.LN,DVALUE,<Line number>
BYT FL.CP,DVALUE,<Character position>
FLOLEN==.-FLODAT
;OPTIONAL DATA FOR FLOTAB
FLOOPD: XWD FLOOLN,0
OPTBYT FL.PND,NONZRO,0,STATEM,<Procedure name defined>
OPTBYT FL.SPF,NONZRO,0,STATEM,<Subject of PERFORM>
OPTBYT FL.OPF,NONZRO,0,STATEM,<Object of PERFORM>
OPTBYT FL.SAL,NONZRO,0,STATEM,<Subject of ALTER>
OPTBYT FL.OAL,NONZRO,0,STATEM,<Object of ALTER>
OPTBYT FL.OGO,NONZRO,0,STATEM,<Object of GO>
OPTBYT FL.OEN,NONZRO,0,STATEM,<Object of ENTER>
OPTBYT FL.DEB,NONZRO,0,STATEM,<Object for USE FOR DEBUGGING>
OPTBYT FL.QUA,NONZRO,0,STATEM,<Qualified entry>
OPTBYT FL.RDC,NONZRO,0,STATEM,<Referenced in declaratives>
FLOOLN==.-FLOOPD
;HLDTAB ENTRIES
;IF IN PHASE D DISPLAY AS
HLDDA1: XWD HLD1LN,0
BYT HL.COD,VALUE,<Code=100: cancelled program name>
BYT HL.QAL,DVALUE,<Number of words used for name>
HLD1LN==.-HLDDA1
;IF IN PHASE E DISPLAY AS
HLDDA2: XWD HLD2LN,0
BYT HL.FLG,HLDFLG,<FLAG>
BYT HL.LNK,ITMLNK,<Link to last HLDTAB entry>
HLD2LN==.-HLDDA2
;IF NOT IN PHASE D OR E DISPLAY AS
HLDDA3: XWD HLD3LN,0
BYT HL.NAM,NMLINK,<NAMTAB LINK>
BYT HL.LN,DVALUE,<Line position>
BYT HL.CP,DVALUE,<Character position>
BYT HL.COD,HLDCOD,<Code>
BYT HL.QAL,DVALUE,<Number of qualifiers>
BYT HL.LNK,VALUE,<Link to some table>
HLD3LN==.-HLDDA3
;LITTAB ENTRIES
;IF BEFORE PHASE E DISPLAY AS
LITDA1: XWD LIT1LN,0
BYT LI.NCH,DVALUE,<Number of characters in literal>
BYT LI.FCC,DVALUE,<Number of words containing the literal>
LIT1LN==.-LITDA1
LITODT: XWD LITOLN,0
OPTBYT LI.EBC,NONZRO,0,STATEM,<Ebcdic literal>
OPTBYT LI.PUR,NONZRO,0,STATEM,<Non-sixbit>
OPTBYT LI.ALL,NONZRO,0,STATEM,<ALL>
OPTBYT LI.NLT,NONZRO,0,STATEM,<Numeric literal>
OPTBYT LI.FGC,NONZRO,0,STATEM,<Figurative constant>
OPTBYT LI.INT,NONZRO,0,STATEM,<Numeric literal has imbedded decimal point>
LITOLN==.-LITODT
;AFTER PHASE E DISPLAY AS
LITDA2: XWD LIT2LN,0
BYT LI.TYP,VALUE,<Type of constant>
BYT LI.FCC,DVALUE,<Number of words containing the literal>
LIT2LN==.-LITDA2
;MNETAB ENTRIES
MNEDAT: XWD MNELEN,0
BYT MN.NAM,NMLINK,<NAMTAB link>
MNELEN==.-MNEDAT
;PRGTAB ENTRIES
PRGDAT: XWD PRGLEN,0
BYT PG.NAM,NMLINK,<NAMTAB link>
BYT PG.LVL,DVALUE,<Level number of contained program>
BYT PG.TAG,VALUE,<Tag to jump over contained program>
PRGLEN==.-PRGDAT
;OPTIONAL DATA FOR PRGTAB
PRGODT: XWD PRGOLN,0
OPTBYT PG.COM,NONZRO,0,STATEM,<Program is common>
OPTBYT PG.INI,NONZRO,0,STATEM,<Program is initial>
OPTBYT PG.FAL,NONZRO,0,STATEM,<Link to brother>
OPTBYT PG.FAL,ISZERO,0,STATEM,<Link to father>
OPTBYT PG.POP,NONZRO,0,ITMLNK,<Link to father/brother>
OPTBYT PG.SON,NONZRO,0,ITMLNK,<Link to son>
PRGOLN==.-PRGODT
;PROTAB ENTRIES
PRODAT: XWD PROLEN,0 ;HEADER
BYT PR.NAM,NMLINK,<NAMTAB link>
PROLEN==.-PRODAT
;PROTAB PARAGRAPH DATA
PROPDT: XWD PROPLN,0 ;HEADER
BYT PR.LSC,VALUE,<Link to section>
PROPLN==.-PROPDT
;PROTAB SECTION DATA
PROSDT: XWD PROSLN,0 ;HEADER
BYT PR.GNW,VALUE,<GENWRD for next section>
PROSLN==.-PROSDT
;PROTAB PARAGRAPH & SECTION COMMON OPTIONAL DATA
PROODT: XWD PROOLN,0 ;HEADER
OPTBYT PR.SNL,NONZRO,0,VALUE,<Same name link>
OPTBYT PR.AOB,NONZRO,0,VALUE,<AOBTAB link (ALTER)>
OPTBYT PR.EXR,NONZRO,0,STATEM,<EXIT required>
OPTBYT PR.DEF,ISZERO,0,STATEM,<Item not defined>
OPTBYT PR.ALT,NONZRO,0,STATEM,<Alterable>
OPTBYT PR.ARS,NONZRO,0,STATEM,<ALTER to same or resident segment>
OPTBYT PR.ANR,NONZRO,0,STATEM,<ALTER to non-resident segment>
OPTBYT PR.RFD,NONZRO,0,STATEM,<Referenced in DECLARATIVES>
OPTBYT PR.DFD,NONZRO,0,STATEM,<Defined in declaratives>
OPTBYT PR.MDF,NONZRO,0,STATEM,<Multiply defined procedure>
OPTBYT PR.TUT,NONZRO,0,STATEM,<Terminated with unconditional transfer>
OPTBYT PR.DEB,NONZRO,0,VALUE,<Address of DEBUG USE PROCEDURE>
OPTBYT PR.SFI,NONZRO,0,VALUE,<Symbolic first address (i.e. tag #)>
PROOLN==.-PROODT
;OPTIONAL PARAGRAPH DATA
;PROPOD: XWD PROPDL,0 ;HEADER
;PROPDL==.-PROPOD
;OPTIONAL SECTION DATA
PROSOD: XWD PROSDL,0 ;HEADER
OPTBYT PR.PRI,NONZRO,0,DVALUE,<PRIORITY>
PROSDL==.-PROSOD
;RCOTAB ENTRIES
RCODAT: XWD RCOLEN,0
BYT RC.DCI,DTLINK,<DATAB link for control item>
BYT RC.SAV,VALUE,<%PARM area for saving value>
BYT RC.CHG,ITMLNK,<Link to CH group>
BYT RC.CFG,ITMLNK,<Link to CF group>
BYT RC.REE,VALUE,<Tag of reset routine>
BYT RC.BRO,ITMLNK,<Link to brother control identifier>
BYT RC.BR1,ITMLNK,<Link to previous brother control identifier>
BYT RC.FAL,ITMLNK,<Link to father>
RCOLEN==.-RCODAT
;RENTAB ENTRIES
RENDAT: XWD RENLEN,0
BYT RN.01,DTLINK,<DATAB link to 01 entry>
BYT RN.66,DTLINK,<DATAB link to 66 entry (renames item)>
RENLEN==.-RENDAT
;RESTAB ENTRIES
RESDAT: XWD RESLEN,0
BYT RE.EOP,ITMLNK,<EOPTAB link>
BYT RE.NIP,DVALUE,<Number of intergral places in item>
BYT RE.NDP,DVALUE,<Number of decimal places in item>
RESLEN==.-RESDAT
;OPTIONAL DATA FOR RESTAB
RESODT: XWD RESOLN,0
OPTBYT RE.ROU,NONZRO,0,STATEM,<Result is to be rounded>
RESOLN==.-RESODT
;RPWTAB ENTRIES
; RD ENTRY
RPWDAT: XWD RPWLEN,0
BYT RW.NAM,NMLINK,<NAMTAB LINK>
BYT RW.SAM,DVALUE,<Link to item with same name>
BYT RW.BRO,RWLINK,<Link to BROTHER RD entry>
BYT RW.LN,DVALUE,<Line number of RD entry>
BYT RW.CP,DVALUE,<Character position of RD entry>
BYT RW.FIL,ITMLNK,<FILTAB link to associated file>
BYT RW.FGP,DTLINK,<DATAB link to last group of RD>
BYT RW.LC,DTLINK,<DATAB link to line counter>
BYT RW.PC,DTLINK,<DATAB link to page counter>
RPWLEN==.-RPWDAT ;LENGTH INCLUDING HEADER
; GROUP RPWTAB ENTRY
RP1DAT: XWD RP1LEN,0
BYT RW.RDL,RWLINK,<Link to RD entry>
BYT RW.DAT,DTLINK,<Link to associated DATAB entry>
BYT RW.NSI,DVALUE,<Number of sum identifiers>
BYT RW.RES,DTLINK,<Datab link to RESET entry>
BYT RW.UPN,RWLINK,<RPWTAB link to UPON type detail entry>
RP1LEN==.-RP1DAT ;LENGTH INCLUDING HEADER
OP1DAT: XWD OP1LEN,0
OPTBYT RW.DEF,NONZRO,0,STATEM,<Report is defined in an RD clause>
OPTBYT RW.DEF,ISZERO,0,STATEM,<Report is not defined by RD clause>
OPTBYT RW.PHL,NONZRO,0,DVALUE,<Heading line number>
OPTBYT RW.CFL,NONZRO,0,DVALUE,<Footing line number>
OPTBYT RW.FDE,NONZRO,0,DVALUE,<First detail line number>
OPTBYT RW.LDE,NONZRO,0,DVALUE,<Last detail line number>
OPTBYT RW.PAG,NONZRO,0,DVALUE,<Page limit>
OPTBYT RW.INI,NONZRO,0,STATEM,<There is an 'INDICATE' for this RD>
OPTBYT RW.RHL,NONZRO,0,STATEM,<Report heading seen>
OPTBYT RW.RWT,NONZRO,0,VALUE,<Tag of run time RPWTAB>
OPTBYT RW.RHR,NONZRO,0,VALUE,<Tag of report header routine>
OPTBYT RW.RFR,NONZRO,0,VALUE,<Tag of report footing routine>
OPTBYT RW.PHR,NONZRO,0,VALUE,<Tag of page heading routine>
OPTBYT RW.PFR,NONZRO,0,VALUE,<Tag of page footing routine>
OPTBYT RW.GIR,NONZRO,0,VALUE,<Tag of group indicate setup>
OPTBYT RW.COD,NONZRO,0,VALUE,<Mnemonic link for code>
OPTBYT RW.CID,NONZRO,0,ITMLNK,<RCOTAB link>
OPTBYT RW.NCI,NONZRO,0,DVALUE,<Number of different control identifiers>
OPTBYT RW.FCI,NONZRO,0,ITMLNK,<RCOLNK link to first control identifier>
OPTBYT RW.BKT,NONZRO,0,VALUE,<Tag of break test routine>
OPTBYT RW.FBT,NONZRO,0,VALUE,<Tag of final break routine>
OP1LEN==.-OP1DAT
OP2DAT: XWD OP2LEN,0
OPTBYT RW.LCD,NONZRO,0,LNCODE,<Line code>
OPTBYT RW.NLC,NONZRO,0,LNCODE,<Next code>
OPTBYT RW.SCD,NONZRO,0,SSVCOD,<Code is >
OPTBYT RW.TYP,NONZRO,0,TYPCOD,<Type is >
OPTBYT RW.RSF,NONZRO,0,STATEM,<Reset on final>
OPTBYT RW.RSI,NONZRO,0,STATEM,<Reset on identifier>
OPTBYT RW.GPI,NONZRO,0,STATEM,<Group indicate>
OPTBYT RW.GEN,NONZRO,0,STATEM,<Generate for this group>
OPTBYT RW.FNC,NONZRO,0,STATEM,<Final control>
OPTBYT RW.RLS,NONZRO,0,STATEM,<Line statement at lower level>
OPTBYT RW.RSU,NONZRO,0,STATEM,<Referenced by sum>
OPTBYT RW.LIN,NONZRO,0,DVALUE,<Line integer>
OPTBYT RW.COL,NONZRO,0,DVALUE,<Column number>
OPTBYT RW.NXT,NONZRO,0,DVALUE,<Next integer>
OPTBYT RW.SLK,NONZRO,0,ITMLNK,<Link to source, sum, or value identifier>
OPTBYT RW.USE,NONZRO,0,VALUE,<Tag of USE procedure>
OPTBYT RW.SUP,NONZRO,0,VALUE,<Runtime address>
OPTBYT RW.NUP,NONZRO,0,DVALUE,<Number of upon identifiers>
OP2LEN==.-OP2DAT
;SECTAB ENTRIES
SECDAT: XWD SECLEN,0
BYT SE.LIT,VALUE,<Starting address for literals>
BYT SE.NAS,DVALUE,<Number of ALTAB entries for this segment>
BYT SE.SAA,VALUE,<Starting address of ALTAB address at object time>
SECLEN==.-SECDAT
;TAGTAB ENTRIES
TAGDAT: XWD TAGLEN,0
BYT TA.REF,DVALUE,<Reference count>
BYT TA.PC,VALUE,<PC>
TAGLEN==.-TAGDAT
;OPTIONAL DATA FOR TAGTAB
TAGOPT: XWD TAGOLN,0
OPTBYT TA.IND,NONZRO,0,STATEM,<Indirect pointer to TAGTAB or PROTAB>
OPTBYT TA.CPO,NONZRO,0,STATEM,<Tag created in PHASE O for another tag+1>
OPTBYT TA.ANO,NONZRO,0,STATEM,<Another tag is defined at this one+1>
TAGOLN==.-TAGOPT
;TEMTAB ENTRIES
TM1DAT: XWD TM1LEN,0
BYT TM.RD,ITMLNK,<RD link>
BYT TM.LNK,ITMLNK,<Link to HLDTAB for first sum counter>
BYT TM.NUM,DVALUE,<Number of ID's>
BYT TM.BRO,ITMLNK,<TEMTAB link to next RD>
TM1LEN==.-TM1DAT
TM2DAT: XWD TM2LEN,0
BYT TM.LVL,DVALUE,<Level number>
BYT TM.LNK,ITMLNK,<HLDTAB link to next RD>
TM2LEN==.-TM2DAT
TM3DAT: XWD TM3LEN,0
BYT TM.TGN,VALUE,<Tag number for in-line PERFORM>
BYT TM.COD,VALUE,<Code for XX of END-XX reserved word>
TM3LEN==.-TM3DAT
;UPNTAB ENTRIES
;RPWTAB ENTRIES IN THE FORMAT OF UPON ENTRY
UPNDAT: XWD UPNLEN,0
BYT RW.UP1,DTLINK,<DATAB link to upon entry>
UPNLEN==.-UPNDAT
;USETAB ENTRIES
USEDAT: XWD USELEN,0
BYT US.TYP,USETYP,<Type of use procedure>
BYT US.PRO,ITMLNK,<PROTAB link to associated section>
USELEN==.-USEDAT
USEODT: XWD USEOLN,0
OPTBYT US.XTR,NONZRO,0,STATEM,<Extra word flag>
OPTBYT US.CNT,NONZRO,0,DVALUE,<Number of extra words including this one>
USEOLN==.-USEODT
;VALTAB ENTRIES
VALDAT: XWD VALLEN,0
BYT VA.SIZ,DVALUE,<Number of characters in literal>
VALLEN==.-VALDAT
SUBTTL TYPE-OUT ROUTINES
;TYPE AN AKTTAB ENTRY
TYPAKT: HRRZ T2,AKTNXT
HRRZ T1,AKTLOC
SUB T2,T1 ;GET SIZE OF TABLE
CAMG T2,TA ;OUTSIDE TABLE ?
JRST OUTSID ;YES, COMPLAIN
ADD TA,AKTLOC ;RELOCATE TO AKTTAB
MOVEI P1,AKTDAT
PUSHJ P,TYPINF ;TYPE STANDARD INFO
MOVEI P1,AKTODT
PUSHJ P,TYPIFO ;TYPE OPTIONAL DATA
POPJ P,
;TYPE A ALTAB ENTRY
TYPAL: HRRZ T2,ALTNXT
HRRZ T1,ALTLOC
SUB T2,T1 ;GET SIZE OF TABLE
CAMG T2,TA ;OUTSIDE OF TABLE ?
JRST OUTSID ; YES, COMPLAIN
ADD TA,ALTLOC ;RELOCATE TO ALTAB
MOVEI P1,ALDAT
PUSHJ PP,TYPINF
TYPE CRLF
POPJ P,
;TYPE A CDTAB ENTRY
TYPCD:
IFN MCS,<
HRRZ T2,CDNXT
HRRZ T1,CDLOC
SUB T2,T1 ;GET SIZE OF TABLE
CAMG T2,TA ;OUTSIDE TABLE ?
JRST OUTSID ;YES, COMPLAIN
ADD TA,CDLOC ;RELOCATE TO CDTAB
MOVEI P1,CDDAT
PUSHJ P,TYPINF ;TYPE STANDARD INFO
MOVEI P1,CD1OPT
PUSHJ P,TYPIFO ;TYPE OPTIONAL DATA FOR BOTH INPUT AND OUTPUT
LDB TB,CD.OUT
SKIPE TB ;INPUT CD ?
JRST TYPCD1 ;NO
MOVEI P1,CD2OPT
PUSHJ P,TYPIFO ;TYPE OPTIONAL DATA FOR INPUT CD
POPJ P,
TYPCD1: MOVEI P1,CD3OPT
PUSHJ P,TYPIFO ;TYPE OPTIONAL DATA FOR OUTPUT CD
POPJ P,
>;END IFN MCS
IFE MCS,<
TYPE NOMCS
POPJ P,
NOMCS: ASCIZ /
?This compiler does not support the MCS module.
/
>
;TYPE A CONTAB ENTRY
TYPCON: HRRZ T2,CONNXT
HRRZ T1,CONLOC
SUB T2,T1 ;FIND OUT HOW BIG CONTAB IS
CAMG T2,TA ;DID HE WANT AN ENTRY OUTSIDE TABLE ?
JRST OUTSID ;YES, COMPLAIN
;START OF A GOOD ENTRY
ADD TA,CONLOC ;RELOCATE TO CONSTANT TABLE
LDB T1,[POINT 3,0(TA),2] ;GET TABLE TYPE CODE
CAIE T1,2 ;IS IT 2 ?
PUSHJ P,TCONE1 ;NO, GIVE WARNING, BUT CONTINUE
MOVEI P1,CONDAT
PUSHJ P,TYPINF ;TYPE STANDARD INFORMATION
MOVEI P1,CONODT
PUSHJ P,TYPIFO ;TYPE OPTIONAL DATA
POPJ P,
;DOESN'T LOOK LIKE A CONAB ENTRY.
TCONE1: TYPE [ASCIZ/%This doesn't appear to be the correct offset for
a real CONTAB entry: The first three bits in the first word are not = 2.
/]
POPJ P, ;RETURN
;TYPE A CPYTAB ENTRY
TYPCPY: HRRZ T2,CPYNXT
HRRZ T1,CPYLOC
SUB T2,T1
CAMG T2,TA
JRST OUTSID
ADD TA,CPYLOC
MOVE T2,(TA) ;GET VALUE IN POSITION POINTED TO BY TA
PUSHJ P,TYPOCT ;TYPE THE OCTAL VALUE
POPJ P,
;TYPE A CRFTAB ENTRY
TYPCRF: HRRZ T2,CRFNXT
HRRZ T1,CRFLOC
SUB T2,T1
CAMG T2,TA
JRST OUTSID
ADD TA,CRFLOC
MOVE T2,(TA) ;GET VALUE IN POSITION POINTED TO BY TA
PUSHJ P,TYPOCT ;TYPE THE OCTAL VALUE
POPJ P,
;TYPE A DATAB ENTRY
TYPDAT: HRRZ T2,DATNXT
HRRZ T1,DATLOC
SUB T2,T1 ;FIND OUT HOW BIG DATAB IS
CAMG T2,TA ;DID HE WANT AN ENTRY OUTSIDE TABLE?
JRST OUTSID ;YES, COMPLAIN
;START OF A GOOD ENTRY
CAIE TA,1 ;IS THIS THE DUMMY ENTRY?
JRST TDATB1 ;NO
TYPE <[ASCIZ/ [This is the "dummy" DATAB entry]
/]>
TDATB1: ADD TA,DATLOC ;RELOCATE TO DATAB TABLE
;SEE IF THIS LOOKS LIKE A REAL DATAB ENTRY.
; THE FIRST THREE BITS OF THE FIRST WORD SHOULD BE "1".
LDB T1,[POINT 3,0(TA),2] ;GET IDENTIFICATION BITS
CAIE T1,1 ;IS IT "1"?
PUSHJ P,TDATE1 ;NO, GIVE WARNING, BUT CONTINUE
;TYPE ANY SPECIAL THINGS ABOUT THIS ENTRY WE CAN FIND
; BEFORE PRINTING THE STANDARD STUFF.
MOVEI P1,OPBDAT ;GET OPTIONAL DATAB DATA ITEMS
PUSHJ P,TYPIFO ;TYPE OPTIONAL INFO
MOVEI P1,DATDAT ;DO THE DATAB DATA (STANDARD ITEMS)
PUSHJ P,TYPINF ;TYPE THE INFO
MOVEI P1,OPADAT ;GET MORE OPTIONAL ITEMS
PUSHJ P,TYPIFO ;TYPE THEM
LDB T1,DA.SUB ;IS ITEM SUBSCRIPTED?
JUMPN T1,TDAT8 ;YES, TYPE 8TH WORD
LDB T1,DA.EDT ;NO, IS IT EDITED?
JUMPE T1,TDATND ;IF NO, WE ARE DONE
TDAT8: MOVEI P1,OPADT1 ;TYPE SUBSCRIPT OPTIONAL DATA
PUSHJ P,TYPIFO
LDB T1,DA.EDT ;IS ITEM EDITED?
JUMPN T1,TDAT9 ;YES
LDB T1,DA.KEY ;NOT EDITED, BUT IS DOES IT HAVE KEY INFO?
JUMPE T1,TDATND ;NO
JRST TDAT10 ;JUMP OVER EDITED PRINTING STUFF
;PRINT EDITING INFORMATION
TDAT9: MOVEI P1,OPADT2 ;TYPE EDITING OPTIONAL DATA
PUSHJ P,TYPIFO
LDB T1,DA.KEY ;ANY KEY INFO?
JUMPE T1,TDATND ;NO, DONE
;PRINT KEY INFO
TDAT10: MOVEI P1,DA.RKL##(TA) ;THIRTEENTH THROUGH NTH WORDS.
MOVN T1,T1 ;NEGATIVE OF DA.KEY
HRLI P1,(T1)
TDATN: TYPE [ASCIZ/ -Key info-
/]
TDATN1: MOVE T2,(P1)
PUSHJ P,WRDOUT ;PRINT THE WORD
TYPE CRLF
AOBJN P1,TDATN1
TDATND: TYPE CRLF ;FINAL CRLF
POPJ P, ;DONE, RETURN
;DOESN'T LOOK LIKE A DATAB ENTRY.
TDATE1: TYPE [ASCIZ/%This doesn't appear to be the correct offset for
a real DATAB entry: The first three bits in the first word are not = 1.
/]
POPJ P, ;RETURN
IFN DBMS,<
;TYPE A DBDTAB ENTRY
TYPDBD: HRRZ T2,DBDNXT##
HRRZ T1,DBDLOC##
SUB T2,T1
CAMG T2,TA
JRST OUTSID
ADD TA,DBDLOC
MOVE T2,(TA) ;GET VALUE IN POSITION POINTED TO BY TA
PUSHJ P,TYPOCT ;TYPE THE OCTAL VALUE
POPJ P,
>; END DBMS
IFE DBMS,<
TYPDBD: TYPE [ASCIZ/%DBMS is not build into this version of the compiler,
no DBD table has been built.
/]
POPJ P, ;
>; END DBMS
;TYPE A DEBTAB ENTRY
TYPDEB: HRRZ T2,DEBNXT
HRRZ T1,DEBLOC
SUB T2,T1 ;GET SIZE OF TABLE
CAMG T2,TA ;OUTSIDE TABLE ?
JRST OUTSID ;YES, COMPLAIN
ADD TA,DEBLOC ;RELOCATE TO DEBTAB
MOVEI P1,DEBDAT
PUSHJ P,TYPINF ;TYPE STANDARD INFO
MOVEI P1,DEBODT
PUSHJ P,TYPIFO ;TYPE OPTIONAL DATA
POPJ P,
;TYPE A EOPTAB ENTRY
TYPEOP: HRRZ T2,EOPNXT
HRRZ T1,EOPLOC
SUB T2,T1
CAMG T2,TA
JRST OUTSID
ADD TA,EOPLOC ;RELOCATE TO EOPTAB
LDB T2,EO.IDO## ;GET BIT TO IDENTIFY IF OPERATOR
SKIPE T2 ;IS IT AN OPERATOR
JRST .+4 ;NO
MOVEI P1,EOPOD1
PUSHJ P,TYPINF
POPJ P,
;HERE IF NOT AN OPERAND
LDB T2,EO.IDL## ;GET BIT TO IDENTIFY IF LITERAL
SKIPE T2 ;IS IT A LITERAL
JRST .+6 ;YES
MOVEI P1,EOPOD2
PUSHJ P,TYPINF
MOVEI P1,EOPOD3
PUSHJ P,TYPIFO
POPJ P,
;HERE IF A LITERAL
MOVEI P1,EOPOD4
PUSHJ P,TYPINF
MOVEI P1,EOPOD5
PUSHJ P,TYPIFO
POPJ P,
;TYPE EXTAB ENTRY
TYPEXT: HRRZ T2,EXTNXT
HRRZ T1,EXTLOC
SUB T2,T1 ;FIND OUT HOW BIG EXTAB IS
CAMG T2,TA ;DID HE WANT AN ENTRY OUTSIDE TABLE
JRST OUTSID ;YES, COMPLAIN
;START OF A GOOD ENTRY
ADD TA,EXTLOC ;RELOCATE TO EXTAB LOC
LDB T1,[POINT 3,0(TA),2] ;GET IDENTIFICATION BITS
CAIE T1,5 ;IS IT 5 ?
PUSHJ P,TEXTE1 ;GIVE WARNING BUT CONTINUE
MOVEI P1,EXTDAT
PUSHJ P,TYPINF ;TYPE STANDARD INFORMATION
MOVEI P1,EXTODT
PUSHJ P,TYPIFO ;TYPE OPTIONAL DATA
POPJ P,
TEXTE1: TYPE [ASCIZ/%This doesn't appear to be the correct offset for
a real EXTAB entry: The first three bits in the first word are not = 5.
/]
POPJ P,
;TYPE A FILTAB ENTRY
TYPFIL: HRRZ T2,FILNXT
HRRZ T1,FILLOC
SUB T2,T1 ;FIND OUT HOW BIG FILTAB IS
CAMG T2,TA ;DID HE WANT AN ENTRY OUTSIDE TABLE?
JRST OUTSID ;YES, COMPLAIN
ADD TA,FILLOC ;RELOCATE TO FILE TABLE
LDB T1,[POINT 3,0(TA),2] ;GET IDENTIFICATION BITS
SKIPE T1 ;IS IT 0 ?
PUSHJ P,TFILE1 ;GIVE WARNING BUT CONTINUE
MOVEI P1,FILDAT ;GET THE FILE DATA
PUSHJ P,TYPINF ;TYPE INFO FOR FILTAB ENTRY
TYPE CRLF ;FINAL CRLF
POPJ P, ;RETURN
TFILE1: TYPE [ASCIZ/%This doesn't appear to be the correct offset for
a real FILTAB entry: The first three bits in the first word are not = 0.
/]
POPJ P,
;TYPE A FLOTAB ENTRY
TYPFLO: HRRZ T2,FLONXT
HRRZ T1,FLOLOC
SUB T2,T1
CAMG T2,TA
JRST OUTSID
ADD TA,FLOLOC ;RELOCATE TO FLOTAB
MOVEI P1,FLODAT
PUSHJ P,TYPINF
MOVEI P1,FLOOPD
PUSHJ P,TYPIFO
POPJ P,
;TYPE A HLDTAB ENTRY
TYPHLD: HRRZ T2,HLDNXT
HRRZ T1,HLDLOC
SUB T2,T1 ;GET SIZE OF TABLE
CAMG T2,TA ;OUTSIDE TABLE ?
JRST OUTSID ;YES, COMPLAIN
ADD TA,HLDLOC ;RELOCATE TO HLDTAB
MOVE T1,PHASEN ;GET PHASE TO DETERMINE WHAT FORMAT TO DISPLAY
CAIN T1,"D" ;PHASE D ?
JRST TYPHL1 ;YES
CAIN T1,"E" ;PHASE E ?
JRST TYPHL2 ;YES
MOVEI P1,HLDDA3
PUSHJ P,TYPINF ;TYPE INFORMATION IN STANDARD FORMAT
LDB TC,HL.QAL ;GET NUMBER OF QUALIFIERS
SKIPN TC ;ANY QUALIFIERS ?
POPJ P, ;NO, EXIT
LDB T3,^D100 ;LOAD MAXIMUM NUMBER OF TIMES TO LOOP
TYPHL0: LDB T2,HL.QNM## ;LOAD IN NAMTAB LINK TO QUALIFIER
TYPE [ASCIZ/Qualifer NAMTAB link: /]
PUSHJ P,NMLINK ;TYPE THE NAMTAB LINK ADDRESS
TYPE CRLF ;TYPE CRLF
ADDI TA,1 ;GET NEXT QUALIFIER
SOSLE T3 ;PAST MAXIMUM NUMBER OF DISPLAY ?
SOJG TC,TYPHL0 ;NO, CHECK IF FINISHED
POPJ P,
TYPHL1: MOVEI P1,HLDDA1
PUSHJ P,TYPINF ;TYPE INFORMATION IN PHASE D FORMAT
POPJ P,
TYPHL2: MOVEI P1,HLDDA2
PUSHJ P,TYPINF ;TYPE INFORMATION IN PHASE E FORMAT
LDB TC,HL.FLG ;GET FLAGS
TXNE TC,HE%RIN ;INTO ITEM ?
PUSHJ P,TYPHL3 ;YES
TXNE TC,HE%VLR ;VARIABLE LENGTH RECORD ?
PUSHJ P,TYPHL4 ;YES
TXNE TC,HE%DEB ;DEBUGGING CODE ?
PUSHJ P,TYPHL5 ;YES
POPJ P,
TYPHL3: TYPE [ASCIZ/NOT IMPLEMENTED YET/]
POPJ P,
TYPHL4: TYPE [ASCIZ/NOT IMPLEMENTED YET/]
POPJ P,
TYPHL5: TYPE [ASCIZ/NOT IMPLEMENTED YET/]
POPJ P,
;TYPE A LITTAB ENTRY
; THE FORMAT DEPENDS ON WHICH PHASE WE ARE AT (SEE TABLES.MAC)
TYPLIT: HRRZ T2,LITNXT
HRRZ T1,LITLOC
SUB T2,T1 ;GET SIZE OF LITTAB
CAMG T2,TA ;DID HE WANT AN ENTRY OUTSIDE TABLE ?
JRST OUTSID ;YES, COMPLAIN
MOVE T1,PHASEN ;GET PHASE
ADD TA,LITLOC ;RELOCATE TO LITERAL TABLE
LDB T1,[POINT 3,0(TA),2] ;GET ID BITS
CAIE T1,3
JRST TLITE1
CAIGE T1,"E" ;BEFORE PHASE E ?
JRST TYPLI1 ;YES
MOVEI P1,LITDA2
PUSHJ P,TYPINF ;TYPE LITTAB ENTRY USING FORMAT AFTER PHASE E
POPJ P,
TYPLI1: MOVEI P1,LITDA1
PUSHJ P,TYPINF ;TYPE STANDARD INFO FORMAT IS BEFORE PHASE E
MOVEI P1,LITODT
PUSHJ P,TYPIFO ;TYPE THE OPTIONAL DATA
POPJ P,
TLITE1: TYPE [ASCIZ/%This doesn't appear to be the correct offset for
a real LITTAB entry: The first three bits in the first word are not = 3.
/]
POPJ P,
;TYPE A MNETAB ENTRY
TYPMNE: HRRZ T2,MNENXT
HRRZ T1,MNELOC
SUB T2,T1
CAMG T2,TA
JRST OUTSID
ADD TA,MNELOC ;RELOCATE TO MNELOC
LDB T1,[POINT 3,0(TA),2] ;GET ID BITS
CAIE T1,7
JRST TMNEE1
MOVEI P1,MNEDAT
PUSHJ P,TYPINF
POPJ P,
TMNEE1: TYPE [ASCIZ/%This doesn't appear to be the correct offset for
a real MNEAB entry: The first three bits in the first word are not = 7.
/]
POPJ P,
;TYPE A NAMTAB ENTRY.
; SEE DESCRIPTION IN TABLES.MAC
TYPNAM: MOVE T1,PHASEN ;GET PHASE
CAILE T1,"D" ;IF THIS IS BEFORE CLEAND WE ARE OK.
JRST TYPNE0 ;NO, SORRY
HRRZ T2,NAMNXT
HRRZ T1,NAMLOC
SUB T2,T1 ;FIND OUT HOW BIG TABLE IS
CAMG T2,TA ;DID HE WANT AN ENTRY OUTSIDE TABLE?
JRST OUTSID ;YES, COMPLAIN
;CHECK TO MAKE SURE THAT THIS WORD STARTS A NAMTAB ENTRY.
; THE HIGH ORDER TWO BITS OF THE FIRST WORD OF THE ENTRY MUST BE 00.
ADD TA,NAMLOC ;MAKE ABSOLUTE ENTRY LOC.
LDB T1,[POINT 2,0(TA),1] ;GET HIGH ORDER TWO BITS
JUMPN T1,TYPNE1 ;NOT THE START OF THE ENTRY!
LDB T1,[POINT 1,0(TA),2] ;GET BIT 2 OF 1ST WORD
JUMPE T1,TYPNM1 ;JUMP IF NOT A COBOL RESERVED WORD
TYPE <[ASCIZ/ [Item is a COBOL reserved word, value = /]>
LDB T2,[POINT 15,0(TA),17] ;GET VALUE OF THE RESERVED WORD
PUSHJ P,VALUE ;TYPE IT
TYPE EBCRLF ;BRACKET, CRLF
TYPNM1: TYPE [ASCIZ/ Table link: /]
LDB T2,[POINT 18,0(TA),35]
PUSHJ P,ITMLNK ;TYPE IT
MOVEI P1,1(TA) ;POINT TO FIRST WORD OF NAME
HRLI P1,(POINT 6,) ;MAKE BP
TYPE [ASCIZ/ Name: /]
TYPNM2: ILDB T1,P1 ;GET CHARACTER
TRNN T1,60 ;HIGH ORDER TWO BITS 0?
JRST TYPNM3 ;YES, DONE
ADDI T1,40 ;MAKE ASCII CHARACTER
CAIN T1,":" ;COLON TRANSLATES TO "-"
MOVEI T1,"-"
CAIN T1,";" ;SEMI-COLON TRANSLATES TO "."
MOVEI T1,"."
IFN TOPS20, PBOUT% ;TYPE IT
IFE TOPS20, OUTCHR T1 ;TYPE IT
JRST TYPNM2 ;LOOP UNTIL DONE
TYPNM3: TYPE CRLF
POPJ P, ;DONE
TYPNE0: TYPE [ASCIZ/?NAMTAB was written out after PHASE D
/]
POPJ P, ;YOU LOSE
TYPNE1: TYPE [ASCIZ/?That offset is not the start of a NAMTAB entry:
The high-order two bits in the first word are not 00.
/]
POPJ P, ;SORRY
;TYPE A PRGTAB ENTRY
TYPPRG: HRRZ T2,PRGNXT
HRRZ T1,PRGLOC
SUB T2,T1
CAMG T2,TA
JRST OUTSID
ADD TA,PRGLOC ;RELOCATE TO PRGTAB
MOVEI P1,PRGDAT
PUSHJ P,TYPINF
MOVEI P1,PRGODT
PUSHJ P,TYPIFO
POPJ P,
;TYPE A PROTAB ENTRY
TYPPRO: HRRZ T2,PRONXT
HRRZ T1,PROLOC
SUB T2,T1 ;FIND OUT HOW BIG PROTAB IS
CAMG T2,TA ;DID HE WANT AN ENTRY OUTSIDE TABLE?
JRST OUTSID ;YES, COMPLAIN
ADD TA,PROLOC ;RELOCATE TO PROTAB
;SEE IF THIS LOOKS LIKE A REAL PROTAB ENTRY. IF NOT, TYPE WARNING
; AND PRINT THE INFORMATION ANYWAY.
LDB T1,[POINT 3,0(TA),2] ;GET TABLE TYPE CODE
CAIE T1,4 ;DOES THIS LOOK LIKE A PROTAB ENTRY?
PUSHJ P,TYPRE1 ;NO, TYPE WARNING FIRST
MOVEI T1,[ASCIZ/ [Section entry]
/]
LDB T4,PR.SEC## ;IS THIS A SECTION OR PARAGRAPH ENTRY?
;T4=0 IS SECTION, T4=1 IS PARAGRAPH
SKIPE T4 ;SKIP IF SECTION
MOVEI T1,[ASCIZ/ [Paragraph entry]
/]
IFN TOPS20, PSOUT% ;TYPE RESULT
IFE TOPS20, OUTSTR (T1) ;. .
JUMPE T4,TYPPRS ;TYPE PROTAB SECTION ENTRY
;TYPE PROTAB PARAGRAPH ENTRY
MOVEI P1,PRODAT ;START WITH COMMON MANDATORY THINGS
PUSHJ P,TYPINF ;TYPE USUAL INFO
MOVEI P1,PROPDT ;PARAGRAPH SPECIFIC DATA
PUSHJ P,TYPINF
MOVEI P1,PROODT ;COMMON OPTIONAL DATA
PUSHJ P,TYPIFO
; (No optional paragraph-only data yet)
; MOVEI P1,PROPOD ;PARAGRAPH OPTIONAL DATA
; PUSHJ P,TYPIFO
JRST TYPPRE ;DONE
;TYPE PROTAB SECTION ENTRY
TYPPRS: MOVEI P1,PRODAT ;START WITH ALL USUAL THINGS
PUSHJ P,TYPINF
MOVEI P1,PROSDT ;SECTION MANDATORY DATA
PUSHJ P,TYPINF
MOVEI P1,PROODT ;COMMON OPTIONAL DATA
PUSHJ P,TYPIFO
MOVEI P1,PROSOD ;SECTIONAL OPTIONAL DATA
PUSHJ P,TYPIFO
TYPPRE: TYPE CRLF ;FINAL CRLF
POPJ P, ;DONE, RETURN
TYPRE1: TYPE [ASCIZ/%This doesn't appear to be the correct offset for
a real PROTAB entry: The first three bits in the first word are not = 4.
/]
POPJ P, ;RETURN
;TYPE A RCOTAB ENTRY
TYPRCO: HRRZ T2,RCONXT
HRRZ T1,RCOLOC
SUB T2,T1 ;GET SIZE OF TABLE
CAMG T2,TA ;OUTSIDE TABLE ?
JRST OUTSID ;YES, COMPLAIN
ADD TA,RCOLOC ;RELOCATE TO RENTAB
MOVEI P1,RCODAT
PUSHJ P,TYPINF ;TYPE STANDARD INFORMATION
POPJ P,
;TYPE A RENTAB ENTRY
TYPREN: HRRZ T2,RENNXT
HRRZ T1,RENLOC
SUB T2,T1 ;GET SIZE OF TABLE
CAMG T2,TA ;OUTSIDE TABLE ?
JRST OUTSID ;YES, COMPLAIN
ADD TA,RENLOC ;RELOCATE TO RENTAB
MOVEI P1,RENDAT
PUSHJ P,TYPINF ;TYPE STANDARD INFORMATION
POPJ P,
;TYPE A RESTAB ENTRY
TYPRES: HRRZ T2,RESNXT
HRRZ T1,RESLOC
SUB T2,T1
CAMG T2,TA
JRST OUTSID
ADD TA,RESLOC ;RELOCATE TO RESTAB
MOVEI P1,RESDAT
PUSHJ P,TYPINF
MOVEI P1,RESODT
PUSHJ P,TYPIFO
POPJ P,
;TYPE A RPWTAB ENTRY
TYPRPW: HRRZ T2,RPWNXT
HRRZ T1,RPWLOC
SUB T2,T1 ;FIND OUT HOW BIG RPWTAB IS
CAMG T2,TA ;DID HE WANT AN ENTRY OUTSIDE TABLE?
JRST OUTSID ;YES, COMPLAIN
;START OF A GOOD ENTRY
ADD TA,RPWLOC ;RELOCATE TO REPORT WRITER TABLE
LDB T1,[POINT 3,0(TA),2] ;GET TABLE TYPE CODE
CAIE T1,4 ;IS THIS A GROUP ENTRY ?
JRST TYPRP1 ;NO, MUST BE AN RD ENTRY
MOVEI P1,RP1DAT
PUSHJ P,TYPINF ;TYPE GROUP INFORMATION
MOVEI P1,OP2DAT ;TYPE OPTIONAL GROUP DATA
PUSHJ P,TYPIFO
POPJ P,
TYPRP1: MOVEI P1,RPWDAT
PUSHJ P,TYPINF ;TYPE RD ENTRY INFORMATION
MOVEI P1,OP1DAT ;TYPE OPTIONAL RD DATA
PUSHJ P,TYPIFO
POPJ P,
;TYPE A SECTAB ENTRY
TYPSEC: HRRZ T2,SECNXT
HRRZ T1,SECLOC
SUB T2,T1
CAMG T2,TA
JRST OUTSID
ADD TA,SECLOC ;RELOCATE TO SECTAB
MOVEI P1,SECDAT
PUSHJ P,TYPINF
POPJ P,
;TYPE A TAGTAB ENTRY
TYPTAG: HRRZ T2,TAGNXT
HRRZ T1,TAGLOC
SUB T2,T1
CAMG T2,TA
JRST OUTSID
ADD TA,TAGLOC ;RELOCATE TO TAGTAB
MOVEI P1,TAGDAT
PUSHJ P,TYPINF
MOVEI P1,TAGOPT
PUSHJ P,TYPIFO
POPJ P,
;TYPE A TEMTAB ENTRY
TYPTEM: HRRZ T2,TEMNXT
HRRZ T1,TEMLOC
SUB T2,T1
CAMG T2,TA
JRST OUTSID
ADD TA,TEMLOC ;RELOCATE TO TEMTAB
MOVE T1,PHASEN
CAILE T1,"C"
JRST TYPTM1
;IN OR BEFORE PHASE C
TYPE [ASCIZ/ TEMTAB data may be one of two types of formats, /]
TYPE [ASCIZ/ if in RD format, data is: /]
MOVEI P1,TM1DAT
PUSHJ P,TYPINF
TYPE CRLF
TYPE [ASCIZ/ if in ID format, data is: /]
MOVEI P1,TM2DAT
PUSHJ P,TYPINF
POPJ P,
TYPTM1: MOVEI P1,TM3DAT
PUSHJ P,TYPINF
POPJ P,
;TYPE A USETAB ENTRY
TYPUSE: HRRZ T2,USENXT
HRRZ T1,USELOC
SUB T2,T1 ;GET SIZE OF TABLE
CAMG T2,TA ;OUTSIDE TABLE ?
JRST OUTSID ;YES, COMPLAIN
ADD TA,USELOC ;RELOCATE TO USETAB
MOVEI P1,USEDAT
PUSHJ P,TYPINF ;TYPE STANDARD INFO
MOVEI P1,USEODT
PUSHJ P,TYPIFO ;TYPE OPTIONAL DATA
POPJ P,
;TYPE A VALTAB ENTRY
TYPVAL: HRRZ T2,VALNXT
HRRZ T1,VALLOC
SUB T2,T1 ;GET SIZE OF VALTAB
CAMG T2,TA ;DID HE WANT ENTRY OUTSIDE TABLE ?
JRST OUTSID ;YES, COMPLAIN
ADD TA,VALLOC ;RELOCATE TO VALTAB
LDB T1,[POINT 3,0(TA),2] ;GET ID BITS
CAIE T1,6
JRST TVALE1
MOVEI P1,VALDAT
PUSHJ P,TYPINF ;TYPE STANDARD INFORMATION
TYPE [ASCIZ/The value is : /]
LDB T2,VA.SIZ ;GET SIZE OF LITERAL VALUE
MOVE T3,VA.LFC## ;POINT TO FIRST CHAR
LDB T1,T3
TYPVA1:
IFN TOPS20, PBOUT% ;TYPE IT
IFE TOPS20, OUTCHR T1 ;TYPE IT
SUBI T2,1
ILDB T1,T3 ;GET NEXT CHARACTER
SKIPE T2 ;FINISHED ?
JRST TYPVA1 ;NO
POPJ P,
TVALE1: TYPE [ASCIZ/%This doesn't appear to be the correct offset for
a real VALTAB entry: The first three bits in the first word are not = 6.
/]
POPJ P,
;TYPE A RPWTAB ENTRY IN UPON FORMAT
TYPUPN: HRRZ T2,RPWNXT
HRRZ T1,RPWLOC
SUB T2,T1
CAMG T2,TA
JRST OUTSID
ADD TA,RPWLOC ;RELOCATE TO RPWTAB
MOVEI P1,UPNDAT
PUSHJ P,TYPINF
POPJ P,
;HERE IF HE ASKED FOR AN ENTRY OUTSIDE TABLE - TYPE ERROR MESSAGE
;COME HERE WITH XXXNXT-XXXLOC IN T2.
OUTSID: JUMPE T2,TEMPTY ;JUMP IF TABLE IS EMPTY
TYPE [ASCIZ/?Offset too large - table only goes to /]
PUSHJ P,TYPOCT ;TYPE T2 IN OCTAL
TYPE CRLF
POPJ P, ;RETURN AFTER TYPING ERROR
TEMPTY: TYPE [ASCIZ/?Table is empty
/]
POPJ P, ;RETURN AFTER TYPING ERROR
SUBTTL GENERALIZED PRINTING ROUTINE
;ENTER WITH TA = XWD POINTING TO THE TABLE ENTRY.
; P1= ADDRESS OF THE INFORMATION USED TO PRINT THE TABLE.
TYPINF: HLRZ P2,(P1) ;GET # WORDS IN ENTRY
SUBI P2,1 ;MULTIPLE OF 2
MOVEI P3,1(P1) ;POINT TO 1ST 2-WORD ENTRY
TYPIN1: PUSHJ P,TYPITM ;TYPE ONE ITEM
SUBI P2,2 ;SUBTRACT
ADDI P3,2 ;BUMP POINTER TO NEXT
JUMPG P2,TYPIN1 ;LOOP IF MORE
POPJ P, ;DONE, RETURN
;OPTIONAL PRINT ROUTINE
;ENTER WITH TA = XWD POINTING TO THE TABLE ENTRY.
; P1= ADDRESS OF THE INFORMATION USED TO PRINT THE TABLE.
TYPIFO: HLRZ P2,(P1) ;GET # WORDS IN ENTRY
SUBI P2,1 ;MULTIPLE OF 3
MOVEI P3,1(P1) ;POINT TO 1ST 3-WORD ENTRY
TYPIF1: HLRZ T1,0(P3) ;GET BYTE POINTER ADDRESS
LDB T2,(T1) ;GET VALUE OF THE BYTE
HLRZ T1,2(P3) ;CALL ROUTINE TO SEE IF WE WANT IT
PUSHJ P,(T1)
JRST TYPIF2 ;NO
PUSHJ P,TYPITO ;YES, TYPE THE ITEM
TYPIF2: SUBI P2,3 ;SUBTRACT
ADDI P3,3 ;BUMP POINTER TO NEXT
JUMPG P2,TYPIF1 ;LOOP IF MORE
POPJ P, ;DONE, RETURN
;ENTER WITH P3= ADDRESS OF 2-WORD ITEM ENTRY
TYPITM: TYPE [ASCIZ/ /] ;TYPE A SPACE
HLRZ T1,1(P3) ;GET NAME OF BYTE POINTER
TYPE <(T1)> ;TYPE IT
TYPE [ASCIZ/ = /] ;SEPARATE FROM DESCRIPTION
HRRZ T3,0(P3) ;GET TYPE OF VALUE
CAIN T3,STATEM ;IS THIS A STATEMENT?
PUSHJ P,TYPI0S ;SETUP FOR STATEMENT PRINTING
HRRZ T1,1(P3) ;GET TEXT FOR ITEM
TYPE <(T1)> ;TYPE IT
HLRZ T1,0(P3) ;GET BYTE POINTER ADDRESS
LDB T2,(T1) ;GET VALUE OF THE BYTE
CAIN T3,STATEM ;IS THIS JUST A STATEMENT?
JRST TYPIT1 ;YES, SKIP PRINTING ":"
TYPE [ASCIZ/: /]
PUSHJ P,(T3) ;PRINT IT
TYPE CRLF ;CRLF TO END
POPJ P, ;DONE, RETURN
;SETUP TO PRINT A "STATEMENT"
TYPI0S: HLRZ T1,2(P3) ;GET ROUTINE WE TESTED WITH
CAIN T1,ISZERO
JRST TYPISZ ;TYPE "IS ZERO"
CAIN T1,NONZRO
JRST TYPISS ;TYPE "IS SET"
TYPISE: TYPE <[ASCIZ/ [/]>
POPJ P, ;RETURN
TYPISZ: TYPE <[ASCIZ/<is zero>/]>
JRST TYPISE
TYPISS: TYPE <[ASCIZ/<is set>/]>
JRST TYPISE
;END "STATEMENT"
TYPIT1: TYPE EBCRLF ;END-BRACKET, CRLF
POPJ P, ;RETURN
;ENTER WITH P3= ADDRESS OF 3-WORD OPTIONAL ITEM ENTRY
TYPITO: PUSHJ P,TYPITM ;DO SAME THING AS REGULAR ENTRY
HRRZ T1,2(P3) ;GET ROUTINE TO CALL WHEN DONE
SKIPE T1 ;ANY ROUTINE?
PUSHJ P,(T1) ;YES, CALL IT
POPJ P, ;RETURN
SUBTTL CONDITIONAL TEST ROUTINES
;SKIP IF ITEM IN T2 IS NON-ZERO.
NONZRO: SKIPE T2
AOS (P)
POPJ P,
;SKIP IF ITEM IN T2 IS ZERO
ISZERO: SKIPN T2
AOS (P)
POPJ P,
SUBTTL RANDOM PRINT ROUTINES
;ITEM IN T2 IS A NAMTAB LINK
NMLINK: JUMPE T2,VALUE ;JUMP IF 0 TO PRINT 0
TYPE [ASCIZ/NAMTAB+/]
PJRST TYPOCT ;TYPE T2 IN OCTAL AND RETURN
;ITEM IN T2 IS A RPWTAB LINK
RWLINK: JUMPE T2,VALUE ;JUMP IF 0 TO PRINT 0
TYPE [ASCIZ/RPWTAB+/]
PJRST TYPOCT ;TYPE T2 IN OCTAL AND RETURN
;ITEM IN T2 IS A PLAIN (OCTAL) VALUE
VALUE: PJRST TYPOCT ;TYPE T2 IN OCTAL
;ITEM IN T2 IS A PLAIN (DECIMAL) VALUE
DVALUE: PUSHJ P,TYPDEC ;TYPE T2 IN DECIMAL
TYPE [ASCIZ/./] ;TYPE "." TO SIGNIFY DECIMAL
POPJ P, ;RETURN
;ITEM IN T2 IS A CODE FOR ORGANIZATION
ORGTYP: CAIN T2,%ORG.S ;SEQUENTIAL ?
JRST OR1TYP ;YES
CAIN T2,%ORG.R ;RELATIVE ?
JRST OR2TYP ;YES
CAIN T2,%ORG.I ;INDEXED SEQUENTIAL ?
JRST OR3TYP ;YES
TYPE [ASCIZ/NOT SPECIFIED/]
POPJ PP,
OR1TYP: TYPE [ASCIZ/SEQUENTIAL/]
POPJ PP,
OR2TYP: TYPE [ASCIZ/RELATIVE/]
POPJ PP,
OR3TYP: TYPE [ASCIZ/INDEXED SEQUENTIAL/]
POPJ PP,
;ITEM IN T2 IS A CODE FOR LABEL TYPE
LABTYP: CAIN T2,%LBL.O ;OMITTED ?
JRST LA1TYP ;YES
CAIN T2,%LBL.S ;STANDARD ?
JRST LA2TYP ;YES
TYPE [ASCIZ/NOT SPECIFIED/]
POPJ PP,
LA1TYP: TYPE [ASCIZ/OMITTED/]
POPJ PP,
LA2TYP: TYPE [ASCIZ/STANDARD/]
POPJ PP,
;ITEM IN T2 IS A CODE FOR RECORDING DENSITY
RDTYP: CAIN T2,%RD.2 ;200 BPI ?
JRST RDTYP1 ;YES
CAIN T2,%RD.5 ;556 BPI ?
JRST RDTYP2 ;YES
CAIN T2,%RD.8 ;800 BPI ?
JRST RDTYP3 ;YES
CAIN T2,%RD.16 ;1600 BPI ?
JRST RDTYP4 ;YES
CAIN T2,%RD.62 ;6250 BPI ?
JRST RDTYP5 ;YES
TYPE [ASCIZ/NON DECLARED/]
POPJ PP,
RDTYP1: TYPE [ASCIZ/200 BPI/]
POPJ PP,
RDTYP2: TYPE [ASCIZ/556 BPI/]
POPJ PP,
RDTYP3: TYPE [ASCIZ/800 BPI/]
POPJ PP,
RDTYP4: TYPE [ASCIZ/1600 BPI/]
POPJ PP,
RDTYP5: TYPE [ASCIZ/6250 BPI/]
POPJ PP,
;ITEM IN T2 IS A CODE FOR RECORDING PARITY
RPTYP: CAIN T2,%RP.OD ;PARITY ODD ?
JRST RPTYP1 ;YES
CAIN T2,%RP.EV ;PARITY EVEN ?
JRST RPTYP2 ;YES
TYPE [ASCIZ/NOT DECLARED/]
POPJ PP,
RPTYP1: TYPE [ASCIZ/ODD/]
POPJ PP,
RPTYP2: TYPE [ASCIZ/EVEN/]
POPJ PP,
;ITEM IN T2 IS A CODE FOR NEXT GROUP OF LINE IS CLAUSE
LNCODE: CAIN T2,%RG.NP ;IS CODE FOR NEXT PAGE ?
JRST LNCOD1 ;YES
CAIN T2,%RG.LN ;IS CODE FOR INTEGER ?
JRST LNCOD2 ;YES
CAIN T2,%RG.PI ;IS CODE FOR PLUS INTEGER
JRST LNCOD3
POPJ P,
LNCOD1: TYPE [ASCIZ/IS NEXT PAGE/]
POPJ P,
LNCOD2: TYPE [ASCIZ/IS INTEGER/]
POPJ P,
LNCOD3: TYPE [ASCIZ/IS PLUS INTEGER/]
POPJ P, ;RETURN
;ITEM IS AN USE TYPE
USETYP: CAIN T2,%UT.IO ;I-O ERROR ?
JRST USETY1 ;YES
CAIN T2,%UT.OP ;OPEN ERROR ?
JRST USETY2 ;YES
CAIN T2,%UT.LB ;LABEL PROCEDURE ?
JRST USETY3 ;YES
CAIN T2,%UT.RP ;REPORT ITEM PROCEDURE ?
JRST USETY4 ;YES
CAIN T2,%UT.ES ;ERROR-STATUS ?
JRST USETY5 ;YES
CAIN T2,%UT.DB ;DEBUG PROCEDURE ?
JRST USETY6 ;YES
TYPE [ASCIZ/CODE DOES NOT APPEAR TO BE CORRECT/]
POPJ P,
USETY1: TYPE [ASCIZ/I-O ERROR/]
POPJ P,
USETY2: TYPE [ASCIZ/OPEN ERROR/]
POPJ P,
USETY3: TYPE [ASCIZ/LABEL PROCEDURE/]
POPJ P,
USETY4: TYPE [ASCIZ/REPORT ITEM PROCEDURE/]
POPJ P,
USETY5: TYPE [ASCIZ/ERROR-STATUS/]
POPJ P,
USETY6: TYPE [ASCIZ/DEBUG PROCEDURE/]
POPJ P,
;ITEM IS A HLDTAB FLAG
HLDFLG: TXNE T2,HE%RIN ;READ..INTO OR RETURN..INTO
PUSHJ P,HLDFL1 ;BIT ON, TYPE MESSAGE
TXNE T2,HE%VLR ;READ WITH VARIABLE LENGTH RECORD
PUSHJ P,HLDFL2 ;BIT ON, TYPE MESSAGE
TXNE T2,HE%DEB ;DEBUGGING CODE
PUSHJ P,HLDFL3 ;BIT ON, TYPE MESSAGE
POPJ P,
HLDFL1: TYPE [ASCIZ/READ..INTO OR RETURN.. INTO /]
POPJ P,
HLDFL2: TYPE [ASCIZ/READ WITH VARIABLE LENGTH RECORD /]
POPJ P,
HLDFL3: TYPE [ASCIZ/DEBUGGING CODE/]
POPJ P,
;ITEM IS A HLDTAB CODE
HLDCOD: CAIN T2,0 ;NOT DEFINED ?
JRST DVALUE ;TYPE VALUE AND RETURN
CAIN T2,%HL.AK ;ACTUAL KEY ?
JRST HLDC01 ;YES
CAIN T2,%HL.VI ;VALUE OF IDENTIFICATION
JRST HLDC02 ;YES
CAIN T2,%HL.VD ;VALUE OF DATE-WRITTEN
JRST HLDC03 ;YES
CAIN T2,%HL.VP ;VALUE OF PROJECT-PROGRAMMER
JRST HLDC04 ;YES
CAIN T2,%HL.LL ;LOW FILE LIMIT
JRST HLDC05 ;YES
CAIN T2,%HL.HL ;HIGH FILE LIMIT
JRST HLDC06 ;YES
CAIN T2,%HL.DP ;'DEPENDING' FOR OCCURS
JRST HLDC07 ;YES
CAIN T2,%HL.KY ;'ASCENDING KEY' FOR OCCURS
JRST HLDC08 ;YES
CAIN T2,%HL.SL ;SUM IDENTIFIER (LH)
JRST HLDC09 ;YES
CAIN T2,%HL.SR ;SUM IDENTIFIER (RH)
JRST HLDC10 ;YES
CAIN T2,%HL.UP ;UPON DATA-NAME
JRST HLDC11 ;YES
CAIN T2,%HL.SC ;BUILD A SUM CTR FOR DATAB ITEM WITH THIS LINK
JRST HLDC12 ;YES
CAIN T2,%HL.SY ;SYMBOLIC KEY
JRST HLDC13 ;YES
CAIN T2,%HL.RC ;RECORD KEY
JRST HLDC14 ;YES
CAIN T2,%HL.DY ;'DESCENDING KEY' FOR OCCURS
JRST HLDC15 ;YES
CAIN T2,%HL.IX ;INDEX FOR DATAB ITEM
JRST HLDC16 ;YES
CAIN T2,%HL.ER ;DATA NAME WHICH OCCURED IN FILE STATUS CLAUSE
JRST HLDC17 ;YES
CAIN T2,%HL.GI ;GROUP INDICATE ITEM WITH VALUE CLAUSE
JRST HLDC18 ;YES
CAIN T2,%HL.KA ;ALTERNATE RECORD KEY
JRST HLDC19 ;YES
CAIN T2,%HL.PR ;VALUE OF PROTECTION CODE
JRST HLDC20 ;YES
TYPE [ASCIZ/This does not appear to be a correct code for a HLDTAB entry/]
POPJ P,
HLDC01: TYPE [ASCIZ/ACTUAL KEY/]
POPJ P,
HLDC02: TYPE [ASCIZ/VALUE OF IDENTIFICATION/]
POPJ P,
HLDC03: TYPE [ASCIZ/VALUE OF DATE-WRITTEN/]
POPJ P,
HLDC04: TYPE [ASCIZ/VALUE OF PROJECT-PROGRAMMER/]
POPJ P,
HLDC05: TYPE [ASCIZ/LOW FILE-LIMIT/]
POPJ P,
HLDC06: TYPE [ASCIZ/HIGH FILE-LIMIT/]
POPJ P,
HLDC07: TYPE [ASCIZ/"DEPENDING" FOR OCCURS/]
POPJ P,
HLDC08: TYPE [ASCIZ/"KEY" FOR OCCURS/]
POPJ P,
HLDC09: TYPE [ASCIZ/"SUM" IDENTIFIER FOR RPWTAB (LH)/]
POPJ P,
HLDC10: TYPE [ASCIZ/"SUM" IDENTIFIER FOR RPWTAB (RH)/]
POPJ P,
HLDC11: TYPE [ASCIZ/"UPON" DATA-NAME FOR RPWTAB/]
POPJ P,
HLDC12: TYPE [ASCIZ/"SUM" COUNTER TO BE ALLOCATED/]
POPJ P,
HLDC13: TYPE [ASCIZ/SYMBOLIC KEY/]
POPJ P,
HLDC14: TYPE [ASCIZ/RECORD KEY/]
POPJ P,
HLDC15: TYPE [ASCIZ/DESCRIPTIVE KEY FOR OCCURS DATAB LINK/]
POPJ P,
HLDC16: TYPE [ASCIZ/INDEX FOR DATAB ITEM/]
POPJ P,
HLDC17: TYPE [ASCIZ/DATA NAME WHICH OCCURED IN FILE STATUS CLAUSE/]
POPJ P,
HLDC18: TYPE [ASCIZ/GROUP INDICATE ITEM WITH VALUE CLAUSE/]
POPJ P,
HLDC19: TYPE [ASCIZ/ALTERNATE RECORD KEY/]
POPJ P,
HLDC20: TYPE [ASCIZ/VALUE OF PROTECTION CODE/]
POPJ P,
;ITEM IS AN RPW TYPE
TYPCOD: CAIN T2,%RG.RH ;TYPE RH ?
JRST TYPCO1 ;YES
CAIN T2,%RG.PH ;TYPE PH ?
JRST TYPCO2 ;YES
CAIN T2,%RG.CH ;TYPE CH ?
JRST TYPCO3 ;YES
CAIN T2,%RG.DE ;TYPE DE ?
JRST TYPCO4
CAIN T2,%RG.CF ;TYPE CF ?
JRST TYPCO5
CAIN T2,%RG.PF ;TYPE PF ?
JRST TYPCO6
CAIN T2,%RG.RF ;TYPE RF ?
JRST TYPCO7
POPJ P,
TYPCO1: TYPE [ASCIZ/REPORT HEADING/]
POPJ P,
TYPCO2: TYPE [ASCIZ/PAGE HEADING/]
POPJ P,
TYPCO3: TYPE [ASCIZ/CONTROL HEADING/]
POPJ P,
TYPCO4: TYPE [ASCIZ/DETAIL/]
POPJ P,
TYPCO5: TYPE [ASCIZ/CONTROL FOOTING/]
POPJ P,
TYPCO6: TYPE [ASCIZ/PAGE FOOTING/]
POPJ P,
TYPCO7: TYPE [ASCIZ/REPORT FOOTING/]
POPJ P,
;ITEM IS ITEGER FOR EITHER SOURCE SUM OR VALUE
SSVCOD: CAIN T2,%RG.SR ;IS ITEM SOURCE
JRST SSVCO1
CAIN T2,%RG.SM ;IS ITEM SUM
JRST SSVCO2
CAIN T2,%RG.VL ;IS ITEM VALUE
JRST SSVCO3
POPJ P,
SSVCO1: TYPE [ASCIZ/SOURCE/]
POPJ P,
SSVCO2: TYPE [ASCIZ/SUM/]
POPJ P,
SSVCO3: TYPE [ASCIZ/VALUE/]
POPJ P,
;ITEM IN T2 IS A LEVEL NUMBER
LVLNUM: CAIN T2,LVL.77
MOVEI T2,^D77 ;GET DECIMAL 77
CAIN T2,LVL.66
MOVEI T2,^D66 ;OR 66
PJRST TYPDEC ;PRINT LEVEL NUMBER AND RETURN
;ITEM IN T2 IS IRREVELANT - WE JUST WANT TO MAKE A STATEMENT
STATEM: POPJ P, ;RETURN, TYPE NOTHING.
;ITEM IN T2 IS A USAGE
DUSAGE: CAILE T2,HI.US ;HIGHER USAGE THAN TABLE ALLOWS?
JRST VALUE ;YES, JUST TYPE THE NUMBER
TYPE @USAGA(T2) ;TYPE USAGE SYMBOLICALLY
POPJ P, ;RETURN
USAGA: [ASCIZ/--None assigned--/]
[ASCIZ/DISPLAY-6/]
[ASCIZ/DISPLAY-7/]
[ASCIZ/DISPLAY-9/]
[ASCIZ/1-WORD COMP/]
[ASCIZ/2-WORD COMP/]
[ASCIZ/COMP-1/]
[ASCIZ/INDEX/]
[ASCIZ/COMP-3/]
HI.US==.-USAGA-1 ;HIGHEST VALUE FOR USAGE IN TABLE
;ITEM IN T2 IS A CLASS
DCLASS: CAILE T2,HI.CL ;HIGHER CLASS THAN TABLE ALLOWS?
JRST VALUE ;YES, JUST TYPE THE NUMBER
TYPE @CLASA(T2) ;TYPE CLASS SYMBOLICALLY
POPJ P, ;RETURN
CLASA: [ASCIZ/ALPHANUMERIC/]
[ASCIZ/ALPHABETIC/]
[ASCIZ/NUMERIC/]
[ASCIZ/--Not specified--/]
HI.CL==.-CLASA-1 ;HIGHEST VALUE FOR CLASS IN TABLE
;ITEM IN T2 IS A DATAB LINK
DTLINK: TYPE [ASCIZ/DATAB+/]
PJRST TYPOCT ;TYPE T2 IN OCTAL
;ITEM IN T2 IS A FILTAB LINK
FILINK: TYPE [ASCIZ/FILTAB+/]
PJRST TYPOCT ;TYPE T2 IN OCTAL
;ITEM IN T2 IS AN ARBITRARY ITEM (USE ITEM TYPE CODE)
ITMLNK: PJRST TYPOCT ;FOR NOW
;ITEM IN T2 IS A RECORDING MODE
RCMODE: CAILE T2,HI.RM ;TOO BIG?
JRST VALUE ;YES, JUST TYPE VALUE
TYPE @RCMODA(T2) ;TYPE ASCII VALUE
POPJ P, ;RETURN
RCMODA: [ASCIZ/SIXBIT/] ;%RM.6B=0
[ASCIZ/BINARY/] ;%RM.BN=1
[ASCIZ/ASCII/] ;%RM.7B=2
[ASCIZ/EBCDIC/] ;%RM.EB=3
[ASCIZ/STANDARD (8-BIT) ASCII/] ;%RM.SA=4
[ASCIZ/5/] ;???
[ASCIZ/6/] ;???
[ASCIZ/--Not yet declared--/] ;%%RM=7
HI.RM==.-RCMODA-1 ;HIGHEST RECORDING MODE IN TABLE
;;ROUTINE TO TYPE CONTENTS OF T2
TYPDEC: SKIPA T3,[^D10]
TYPOCT: MOVEI T3,^D8
IFN TOPS20,<
MOVEI T1,.PRIOU ;TO TTY
NOUT% ;TYPE THE NUMBER
ERJMP LOSE ;PROBLEM WITH NOUT%
POPJ P, ;RETURN
>;END IFN TOPS20
IFE TOPS20,<
MOVE T1,T2 ;COPY #
TYPBAS: IDIV T1,T3
PUSH P,T2 ;SAVE REMAINDER
SKIPE T1 ;ALL DONE?
PUSHJ P,TYPBAS ;NO, LOOP
POP P,T1 ;RE-FETCH #
ADDI T1,"0" ;MAKE ASCIZ DIGIT
OUTCHR T1 ;TYPE IT
POPJ P, ;UNWIND
>;END IFE TOPS20
;ROUTINE TO TYPE A WORD OUT IN OCTAL FROM T2
WRDOUT: PUSH P,T2 ;SAVE FOR A SEC.
HLRZ T2,T2 ;GET LH
PUSHJ P,HLFOUT ;PRINT HALF
TYPE [ASCIZ/,,/]
POP P,T2
HRRZ T2,T2 ;GET RH
PJRST HLFOUT ;PRINT RIGHT HALF AND RETURN
;PRINT SIX OCTAL DIGITS FROM T2
HLFOUT: MOVEI T3,6 ;PRINT 6 DIGITS
HLFOU1: SETZ T1,
HRLZ T2,T2 ;GET READY TO SHIFT BYTES
LSHC T1,3 ;GET A DIGIT
ADDI T1,"0" ;MAKE ASCII
IFN TOPS20, PBOUT% ;TYPE IT
IFE TOPS20, OUTCHR T1 ;FROM T1
SOJG T3,HLFOU1 ;LOOP FOR 6 DIGITS
POPJ P, ;THEN RETURN
;HERE IS THE HELP MESSAGE
HLPMSG: TEXT <
DEB is built into the DEBUG version of the COBOL compiler to
assist in debugging the compiler.
Called from DDT by "PUSHJ 17,DEB$X".
Return to DDT by typing "EXIT".
Useful commands:
SHOW Show values of items or details of table entries,
symbolically.
SHOW commands:
ITEM nnnnnn Show value of item whose table address is nnnnnn (octal #).
..and the following keywords are followed by an octal table offset
where the entry starts, to try and type the entry symbolically:
AKTTAB ALTAB CDTAB CONTAB CPYTAB DATAB DEBTAB EOPTAB EXTAB
FILTAB FLOTAB HLDTAB LITTAB MNETAB NAMTAB PRGTAB PROTAB RENTAB
RESTAB RPCTAB RPWTAB SECTAB TAGTAB TEMTAB USETAB VALTAB
Further documentation about the compiler tables, is in TABLES.MAC.
RPCTAB is the same as the RPWTAB except that it prints the records as if
they where CONTROL entries.
>
CRLF: ASCIZ/
/
EBCRLF: ASCIZ/]
/
APROMP: BYTE (7)"D","E","B",76,0
END ;OF HANDAN.MAC