Trailing-Edge
-
PDP-10 Archives
-
BB-H506D-SM_1983
-
cobol/source/handan.mac
There are 21 other files named handan.mac in the archive. Click here to see a list.
; UPD ID= 3558 on 5/16/81 at 2:04 AM by NIXON
TITLE HANDAN - HANDY, DANDY DEBUGGING ROUTINES FOR THE COBOL COMPILER.
SUBTTL /DAW
;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, 1981 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 TOPS20 AND USES THE COMMAND JSYS.
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
HISEG
SALL
EXTERN PHASEN
EXTERN DEBC0,ATMBUF,TXTBUF
EXTERN FILLOC,DATLOC,CONLOC,LITLOC,PROLOC,EXTLOC,VALLOC,MNELOC
EXTERN FILNXT,DATNXT,CONNXT,LITNXT,PRONXT,EXTNXT,VALNXT,MNENXT
EXTERN TAGLOC,NAMLOC,TAGNXT,NAMNXT
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 CONTAB,SHOCON ;SHOW CONTAB
AA DATAB,SHODAT ;SHOW DATAB
AA EXTTAB,SHOEXT ;SHOW EXTTAB
AA FILTAB,SHOFIL ;SHOW FILTAB
AA ITEM,SHOITM ;SHOW ITEM (FROM TABLE)
AA LITTAB,SHOLIT ;SHOW LITTAB
AA MNETAB,SHOMNE ;SHOW MNETAB
AA NAMTAB,SHONAM ;SHOW NAMTAB
AA PROTAB,SHOPRO ;SHOW PROTAB
AA TAGTAB,SHOTAG ;SHOW TAGTAB
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
; JRST DECEOL ;AND GO STORE IT
;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
; JRST KEWERR
;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 FILTAB
SHOFIL: MOVEI T4,0 ;T4=0 FOR FILTAB TYPE
JRST SHOTBL
;SHOW DATAB
SHODAT: MOVEI T4,1 ;T4=1 FOR DATAB TYPE
JRST SHOTBL
;SHOW CONTAB
SHOCON: MOVEI T4,2 ;T4=2 FOR CONTAB TYPE
JRST SHOTBL
;SHOW LITTAB
SHOLIT: MOVEI T4,3 ;T4=3 FOR LITTAB TYPE
JRST SHOTBL
;SHOW PROTAB
SHOPRO: MOVEI T4,4 ;T4=4 FOR PROTAB TYPE
JRST SHOTBL
;SHOW EXTTAB
SHOEXT: MOVEI T4,5 ;T4=5 FOR EXTTAB TYPE
JRST SHOTBL
;SHOW VALTAB
SHOVAL: MOVEI T4,6 ;T4=6 FOR VALTAB TYPE
JRST SHOTBL
;SHOW MNETAB
SHOMNE: MOVEI T4,7 ;T4=7 FOR MNETAB TYPE
JRST SHOTBL
;SHOW TAGTAB
SHOTAG: MOVEI T4,10 ;T4=10 FOR TAGTAB TYPE
JRST SHOTBL
;SHOW NAMTAB
SHONAM: MOVEI T4,11 ;T4=11 FOR NAMTAB TYPE
JRST SHOTBL
;DISPATCH VECTOR
SHOTBB: TYPFIL ;0-FILTAB
TYPDAT ;1-DATAB
TYPCON ;2-CONTAB
TYPLIT ;3-LITTAB
TYPPRO ;4-PROTAB
TYPEXT ;5-EXTTAB
TYPVAL ;6-VALTAB
TYPMNE ;7-MNETAB
TYPTAG ;10-TAGTAB
TYPNAM ;11-NAMTAB
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
>
;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.DPR,DVALUE,<Number of decimal places>
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>
IFN ANS68,<
OPTBYT DA.LRC,NONZRO,0,STATEM,<Item appears in LABEL RECORDS clause>
>
IFN ANS74,<
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
;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.ERM,RCMODE,<EXTERNAL RECORDING MODE>
BYT FI.IRM,RCMODE,<INTERNAL RECORDING MODE>
FILLEN==.-FILDAT ;LENGTH INCLUDING HEADER
;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>
IFN ANS74,<
OPTBYT PR.DEB,NONZRO,0,VALUE,<Address of DEBUG USE PROCEDURE>
OPTBYT PR.SFI,NONZRO,0,VALUE,<Symbolic first address (i.e. tag #)>
>;END IFN ANS74
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
SUBTTL TYPE-OUT ROUTINES
;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
MOVEI P1,FILDAT ;GET THE FILE DATA
PUSHJ P,TYPINF ;TYPE INFO FOR FILTAB ENTRY
TYPE CRLF ;FINAL CRLF
POPJ P, ;RETURN
;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
;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
;TYPE A CONTAB ENTRY
TYPCON: ADD TA,CONLOC ;RELOCATE TO CONSTANT TABLE
TYPE [ASCIZ/(CONSTANT TABLE PRINTING NOT IMPLEMENTED YET)
/]
POPJ P,
;TYPE A LITTAB ENTRY
; THE FORMAT DEPENDS ON WHICH PHASE WE ARE AT (SEE TABLES.MAC)
TYPLIT: ADD TA,LITLOC ;RELOCATE TO LITERAL TABLE
TYPE [ASCIZ/(LITERAL TABLE PRINTING NOT IMPLEMENTED YET)
/]
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
; JRST TYPPRE ;DONE
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 EXTAB ENTRY
TYPEXT: ADD TA,EXTLOC ;RELOCATE TO EXTAB
TYPE [ASCIZ/(EXTTAB PRINTING NOT IMPLEMENTED YET)
/]
POPJ P,
TYPVAL: ADD TA,VALLOC ;RELOCATE TO VALTAB
TYPE [ASCIZ/(VALTAB PRINTING NOT IMPLEMENTED YET)
/]
POPJ P,
TYPMNE: ADD TA,MNELOC ;RELOCATE TO MNELOC
TYPE [ASCIZ/(MNETAB PRINTING NOT IMPLEMENTED YET)
/]
POPJ P,
TYPTAG: ADD TA,TAGLOC ;RELOCATE TO TAGTAB
TYPE [ASCIZ/(TAGTAB PRINTING NOT IMPLEMENTED YET)
/]
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
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 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 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 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:
DATAB
EXTTAB
FILTAB
LITTAB
MNETAB
NAMTAB
PROTAB
TAGTAB
VALTAB
>
CRLF: ASCIZ/
/
EBCRLF: ASCIZ/]
/
APROMP: BYTE (7)"D","E","B",76,0
END ;OF HANDAN.MAC