Google
 

Trailing-Edge - PDP-10 Archives - BB-H506E-SM - 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

	SEARCH	COPYRT
	SALL

;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1980, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE.

;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
	.COPYRIGHT		;Put COPYRIGHT statement in .REL file.

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