perm filename PARSE[X,AIL]2 blob sn#076461 filedate 1973-12-09 generic text, type T, neo UTF8
COMMENT ⊗   VALID 00022 PAGES VERSION 17-1(12)
RECORD PAGE   DESCRIPTION
 00001 00001
 00003 00002	HISTORY
 00006 00003	Parser Description
 00011 00004	Parse Data
 00014 00005	Parser Routine -- Crank Up
 00017 00006			   Compare Loop
 00019 00007			   Pop to Temps, Do Execs
 00023 00008			   Restore Stack, Scan
 00028 00009	Timer Package
 00032 00010	
 00035 00011	
 00037 00012	Debugging Package -- Description
 00042 00013			      Variables
 00049 00014	  Stplin -- 	      Break on <crlf>
 00050 00015	  Dmyexc, etc. --    Main Control Loops
 00053 00016	  Dmy -- Inna, Inn --Display Subroutine
 00057 00017	
 00058 00018			      Read L/P
 00061 00019	Ddtg, Rego, Proxx -- Enter, Leave DDT, Proceed from Debug
 00063 00020	   Prinlin --	      Print Stack Entry Line
 00065 00021	
 00069 00022	Decfil, Ascfil, Prinsym
 00073 ENDMK
⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021  102100000014  ⊗;


COMMENT ⊗
VERSION 17-1(12) 12-6-73 BY JRL REMOVE STANFORD SPECIAL CHARACTERS
VERSION 17-1(11) 12-3-73 BY RHT TURN CALL INTO A CALL6 (P 16)
VERSION 17-1(10) 12-3-73 
VERSION 17-1(9) 11-14-73 BY jrl let debugging package know about lower case (1m etc)
VERSION 17-1(8) 11-10-73 BY KVL MOVE PRSYM HERE (FROM SOME TRUELY ODD PLACE)
VERSION 17-1(7) 11-10-73 
VERSION 17-1(6) 11-10-73 
VERSION 17-1(5) 11-10-73 
VERSION 17-1(4) 9-19-73 BY HJS ADD EVALREDFINE AND CVPS
VERSION 17-1(3) 8-27-73 BY JRL INCREASE SIZE OF DDFPDP FOR DEBUGGER
VERSION 17-1(2) 8-27-73 BY JRL FORCE DDFIND TO SAVE LPSA,TEMP,USER
VERSION 17-1(1) 7-26-73 BY RHT  JUST CHECKING
VERSION 17-1(0) 7-26-73 BY RHT **** VERSION 17 ****
VERSION 16-2(32) 8-25-72 BY KVL TO MAKE CERTAIN PARSE TOKENS AVAILABLE GLOBALLY
VERSION 16-2(31) 7-3-72 BY DCS MANY FIXES, INSTALL VERSION 16
VERSION 15-2(18-30) 6-13-72 RANDOMNESS
VERSION 15-2(17) 2-26-72 BY DCS ADD (PRO,EXC,SCN,LIN)CNT COUNTERS
VERSION 15-2(10) 2-21-72 BY HJS THE BRAVE NEW PARSER WORLD
VERSION 15-2(9) 2-10-72 BY DCS BUG #GR# DO MINOR THINGS TO FTDEBUGGER
VERSION 15-2(8) 2-5-72 BY DCS BUG #GJ# ADD LSTON LISTING CONTROL STUFF
VERSION 15-2(7) 2-1-72 BY DCS BUG #GH# 6M IS SCANNER BREAK, <ESC> I INTERRUPTS STATT CR
VERSION 15-2(6) 2-1-72 BY DCS BUG #GG# Lnnnnn is Lnnnnn/. in FTDEBUGger
VERSION 15-2(5) 2-1-72 BY DCS LPSTOP FROM USER TABLE TO COMPILER
VERSION 15-2(4) 12-26-71 BY DCS BUG #FU# REENABLE ACCESS TO FTDEBUGGER FROM ERR STUFF
VERSION 15-2(3) 12-22-71 BY DCS BUG #FT# GET PRINSYM OUT OF FTDEBUG (MYERR CALLS)
VERSION 15-2(2) 12-2-71 BY DCS INSTALL VERSION NUMBER
⊗;
COMMENT ⊗Parser Description⊗

	LSTON	(PARSE)
BIT2DATA (PARSE TOKEN CLASS/OPERATOR BITS)
	?CLSIDX←←11

	?OPER←←0⊗=18		;HIGH ORDER BIT FOR RESERVED WORD SYMBOL TABLE
	?CLASOP←←OPER+CLSIDX⊗=18	;SAME, BUT FOR CLASS MEMBERS
ENDDATA

BEGIN	PARSE
DSCR PARSE --- Sail's production interpreter.
DES
	This is the production interpreter for the SAIL
	language.  It is table driven, by tables organized
	as follows.  Each production is represented by an entry:

1.	(optional name in ascii -- if bit 35 is on,
		signal the debugging package)
2.	xwd [where to go if compare FAILS],[where if SUCCEEDS]
3.	--ID numbers, etc. stored in 12 bit bytes.
4.	address of production to "pushj" to (optional).


	The interpreter has 5 parts.  The five operations are
	performed in series.  The last four are executed
	only if the first one (the compares on the parse stack)
	succeeds.  The parts are:

	1. Compare the parse stack with the ID numbers stored
		in the 12 bit bytes.  The types of compares and
		depth are determined by bits in the byte--
		The operations performed are:

	<no bits>	compare ID number against stack
	bclass		Compare class of stack element to ID class
	bcare		Careful compare -- ignore class information.
	bdone		Done -- go on to part 2.

		If the compares fail before reaching the "done"
		indication, the interpreter transfers its attention
		to the production named in the "FAIL" location.

	2. Pop the parse stack elements which are involved in
		the current production.  
		The top element is put in PARLEF, the
		next in PARLEF+1, etc.  The generator stack
		entries are popped (in synchronism) into temporaries
		GENLEF, GENLEF+1, etc.
	3. Restore the stacks.  The bytes are examined
		as above, starting where step 3 left off.
		The stacks are not actually restored at this time.
		Instead, the right half temporaries PARRIG and GENRIG
		are composed from information in the bytes:

	btemp		Restore the temporary pointed to by the
			12 bit byte.
	<no bits>	Use the byte as immediate information for
			the parse stack. 
	bdone		Done -- go to step 4.

	4. Call the necessary executive routine.  The bytes
		are examined

	<no bits>	Executive routine.  Use 12 bit byte as index
			into EXCTAB.
	bclass		Executive routine appropriate to class.
			Pick up the parse stack temporary
			pointed to by the current 12 bit byte.  Pick up next
			byte and subtract from first (this gives us
			a RELATIVE base). Then get the next 12 bit byte, and
			use it as index into EXCTAB for the routine
			to call.
	bdone		Done -- go to step 5.


	5. Scan.  The byte is the number of times to call the 
			scanner.
	6. This last byte (the one which specified the number of scans)
		may also indicate a production pushj or popj.
		
	bclass		pushj to the location specified in the next
			full word in the production tables.
	bcare		popj.




	The interpreter is called by:

		PUSH P,[PRODGO]
		JRST PARSE




⊗;

DEFINE SUBR (X) <PUSHJ P,X>
COMMENT ⊗Parse Data⊗

;DECLARATIONS FOR ACCUMULATORS

ACDATA (PARSER)
	PP←←SP
	GP←←7
	PROD←←10
	PTR←←12


ZERODATA (PARSER VARIABLES)

?FTCOUNT←←0
IFN FTCOUNT <
?CARCNT: 0	;COUNT OF NUMBER OF CAREFUL COMPARES
?CLSCNT: 0	;COUNT OF NUMBER OF CLASS COMPARES
?REGCNT: 0	;COUNT OF NUMBER OF REGULAR COMPARES
>;IFN FTCOUNT

;SAVPAR, SAVPOP, SAVSEM, TEMCNT -- temporaries for the PARSER
↑SAVPAR: 0
↑SAVPOP: 0
↑SAVSEM: 0
?TEMCNT: 0


TABCONDATA (PARSER BIT TABLE)

; BIT TABLE FOR CLASS OPERATIONS -- GAIN SPEED OVER CALCULATING THEM
?BITAB:
	FOR I←0,=35 <
	1 ⊗ I >

DATA (PARSER PARSE TOKENS)

COMMENT ⊗
 These variables allow access to PARSE token numbers, for use by
EXECS when they have to examine or change the PARSE stack -- for
example, TRAGO must search the PARSE stack to generate code
for leaving blocks, loops, etc.
⊗
↑%NSP: NSP
↑%NIP: NIP
↑%ASSDO:	NASSDO & 777
↑%DOL:		NDOL & 777
↑%NBEG:		RBEGIN & 777
↑%PDNO:		NPDNO & 777
↑%NFORC:	NFORCA & 777
↑%NPDEC:	NPDEC & 777
↑%OPC:		NOPC & 777		;OPCODE, SET BY SETSIZ (GENERATOR)
↑%WHILC:	NWHILC & 777
↑%CTRU1:	CLASOP+NCTRU1
↑%CFLS1:	CLASOP+NCFLS1
↑%EOFILE:	NEOFILE & 777
↑%BLKFRC:	NBLKFRC & 777
↑%NBLAT:	NBLAT & 777
↑%MPRO:		NMPRO & 777

↑%ILB:		TILB & 777
↑%ISV:		TISV & 777
↑%ARID:		NARID & 777
↑%PCALL:	NPCALL & 777
↑%FCALL:	NFCALL & 777
↑%S:		NS & 777
↑%ITV:		TITV & 777

ENDDATA

COMMENT ⊗Parser Routine -- Crank Up⊗

;DECLARATIONS OF CONTROL BITS IN PRODUCTION BYTES.

BITDATA (PARSER CONTROL)
BCLASS←←	4000		;CONTROL BITS IN 12 BIT BYTE.
BTEMP ←←	2000
BCARE ←←	2000		;MUST BE SAME AS BTEMP
BDONE ←←	1000		;DONE WITH THIS "PHASE"
BPRESUME ←←	 400

ENDDATA

↑CPRODGO:	Q117		; PRODUCTION TO START "OTHER" PARSER
↑PRODGO:	BB0		;PRODUCTION WITH WHICH TO START
↑PROCON:	IF0		; PRODUCTION TO START COND. ASSEMBLY
		WH0		; PRODUCTION TO START WHILEC
		CS0		; PRODUCTION TO START CASEC
		FR0		; PRODUCTION TO START FORC
		FL0		; PRODUCTION TO START FORLC
		DF0		; PRODUCTION TO START DEFINE
		IF5		; PRODUCTION TO START IFC WITH NO MACRO 
				;  EXPANSION IN THE FALSE PART 
		RDF		; PRODUCTION TO START REDEFINE 
		EDF		; PRODUCTION TO START EVALDEFINE 
		ASG		; PRODUCTION TO START ASSIGNC 
		NMC		; PRODUCTION TO START INHIBITION OF MACRO 
				;  EXPANSION 
		ERF		; PRODUCTION TO START EVALREDEFINE 


↑PARSE:				;THIS IS THE PARSER !
	MOVE	TEMP,PCSAV 	; GET PRODUCTION CONTROL STACK POINTER
; *** DCS CHANGED 11-30-71
PARSIT:	SKIPGE	PROD,(TEMP)	; GET PRODUCTION
	JRST	(PROD)		; PRODUCTION IS CODE, NOT INTERPRETED
				; CURRENTLY USED ONLY TO RETURN AFTER DONES
; *** DCS
	HRRZ	PROD,(PROD)	;PICK UP SUCCESS POINTER
	IFN FTDEBUG <SETZM DEBTEM>
	SKIPA	C,[XWD 0,-1]	;REGISTER FOR CLASS COMPARE TEST AND START

FAIL:	HLRZ	PROD,(PROD)	;GET FAILURE POINTER

PROGO:	IFN FTDEBUG <
;;#GH# DCS 2-1-72 (3-5) USE INTERRUPTS FOR ASYNCH BREAKS
	AOS	PROCNT		;COUNT NUMBER OF PRODUCTIONS LOOKED AT
↑PRODBK: JRST	DUMPRO		;CHECK FOR PRODUCTION BREAK OR INTERRUPT
>
POOG:	HRLZI	PTR,(<POINT 12,0>) ;INITIALIZE BYTE POINTER
	HRRI	PTR,1(PROD)	;MORE BYTE POINTER
	HRRZ	PP,PPSAV	;MOVE PARSE STACK POINTER INTO PP FOR USE
COMMENT ⊗		   Compare Loop⊗

COMP:	ILDB	A,PTR		;PICK UP FIRST BYTE
	TRNE	A,BCLASS!BCARE!BDONE	;REGULAR COMPARE?
	JRST	NOREG		;NO
IFN FTCOUNT, <AOS REGCNT>
	CAME	A,(PP)		;COMPARE BYTE TO STACK
	JUMPN	A,FAIL		;GO TO FAILURE PRODUCTION UNLESS "SIGMA"
	SOJA	PP,COMP		;LOOP

NOREG:	TRZE	A,BCLASS	;CLASS COMPARE?
	JRST	CLASSCOM	;YES
	TRZN	A,BCARE		;CAREFUL COMPARE?
	JRST	POPTEM		;DONE WITH COMPARES

CARE:	HRRZ	B,(PP)		;GET ONLY ID NUMBERS FROM STACK
IFN FTCOUNT,<AOS CARCNT>
	CAIE	B,(A)		;COMPARE TOKEN AGAINST BYTE
	JRST	FAIL		;BAD COMPARE
	SOJA	PP,COMP


CLASSCOM:	
	CAML	C,(PP)		;LOOK TO SEE IF CLASS INDEX IS ON
	JRST	FAIL		;NO -- STACK ENTRY WAS NOT CLASS MEMBER
	MOVEI	CLSIDX,CLSTAB	;PREPARE THE INDEX REGISTER FOR TDNE@
	TRZE	A,400		;ON IF CLASS NUMBER GREATER THAN 36.
	MOVEI	CLSIDX,CLSTAB+CLASSNO	;OTHER CLASS TABLE.
	MOVE	B,BITAB-1(A)	;MAGIC BIT FOR THIS CLASS NUMBER.
IFN FTCOUNT, < AOS CLSCNT >
	TDNE	B,@(PP)		;SEE IF CLSTAB HAS THE BIT ON
	SOJA	PP,COMP		;YES -- GO ON
	JRST	FAIL		;NO

COMMENT ⊗		   Pop to Temps, Do Execs⊗


;POP OFF TOP OF STACK INTO TEMPORARIES.  THIS IS TO KEEP STACKS
;(GENERATOR AND PARSE) IN SYNC, AND KEEP EXEC ROUTINES FROM
;CLOBBERING THEM.

POPTEM:	HRRZ	C,PPSAV		;COMPUTE NUMBER OF THINGS TO POP.
	SUBI	C,(PP)		;OK, READY TO GO.
IFN FTDEBUG,<MOVEM C,DEBTEM>
	MOVE	GP,GPSAV	;PICK UP STACK POINTERS
	MOVE	PP,PPSAV
	SETZM	B		;ZERO THE INITIAL COUNTER
POPA:	SOJL	C,RESTA		;DONE POPPING ?
	POP	GP,GENLEF(B)	;POP GENERATOR ENTRY
	POP	PP,PARLEF(B)
	AOJA	B,POPA		;NOT DONE YET
RESTA:	MOVEI	B,-BDONE(A)	;TAKE ACCOUNT OF BIT.
	MOVEM	B,TEMCNT	;COUNT OF RIGHT HALF TEMPORARIES.
RESTB:	ILDB	A,PTR		;GET NEXT BYTE FROM TABLE
	JUMPE	B,EXECA
	TRZE	A,BTEMP		;RESTORE FROM TEMPORARY ?
	JRST	RESTMP		;YES
	CAIGE	A,CLASSNO	;RESTORE WITH CLASS INDEX?
	TLO	A,CLSIDX	;YES
	MOVEM	A,PARRIG-1(B)	;STORE IN RIGHT HALF TEMPORARY
	MOVE	C,GENLEF-1(B)	;SEMANTICS ARE COPIED FOR SAKE OF
	MOVEM	C,GENRIG-1(B)	;CONVENIENCE FOR  T SG (rgt arrows) E SG
	SOJA	B,RESTB		;GO FOR MORE

RESTMP:	MOVE	C,PARLEF-1(A)	;GET THE TEMP. FROM THE LEFT STORAGE
	MOVEM	C,PARRIG-1(B)	;AREA AND PUT IT IN THE RIGHT ONE.
	MOVE	C,GENLEF-1(A)
	MOVEM	C,GENRIG-1(B)	;
	SOJA	B,RESTB		;LOOP UNTIL DONE.

;CALL ANY EXECUTIVE ROUTINES THAT ARE NEEDED.  THE TABLE
;EXCTAB, LISTING ALL ROUTINES, IS PUT TOGETHER BY THE
;PRODUCTION TABLE ASSEMBLER.

EXECA:	MOVE	TEMP,PCSAV	; GET PRODUCTION CONTROL STACK POINTER
	MOVEM	PROD,(TEMP)	; SAVE PRODUCTION POINTER
	MOVEM	PP,PPSAV	;SAVE PARSE STACK POINTER
	MOVEM	GP,GPSAV	;AND GENERATOR STACK POINTER

EXECB:	TRZE	A,BDONE		;DONE ?
	JRST	REST		; YES -- RESTORE STACKS.
	TRZE	A,BCLASS	;CLASS TYPE ROUTINE?
	JRST	EXCLS
	TRZE	A,BCARE		;INDEX SPECIFIED DIRECTLY?
	JRST	EXIND
EXGO:	PUSH	P,PTR
IFN FTDEBUG <
	AOS	EXCCNT		;COUNT # EXECS SEEN
;; #GH# (3) CONT
↑EXCBK: SKIPE	PTR,.DBG.	;ANY CHANCE OF BREAK?
	 JRST	 DMYEXC		; YES, CALL THE DEBUG PACKAGE	>
EXDO:	XCT	EXCTAB-1(A)	;CALL THE ROUTINE WITH GENCLS IN B	
EXDON:	POP	P,PTR		;RESTORE THE WORLD
	ILDB	A,PTR		;GET NEXT BYTE
	JRST	EXECB		;TRY AGAIN

EXCLS:	HRRZ	B,PARLEF-1(A)
	ILDB	A,PTR		;A NOW HAS AN INDEX UNTO THE CLASS
	SUB	B,A		;B HAS THE RELATIVE INDEX
	ILDB	A,PTR		;NOW INDEX TO ROUTINE
	JRST	EXGO		;GO DO THE ROUTINE
EXIND:	MOVE	B,A		;THE INDEX IS SPECIFIED EXPLICITLY
	ILDB	A,PTR
	JRST	EXGO		;GO DO IT
COMMENT ⊗		   Restore Stack, Scan⊗


;RESTORE THE STACKS FROM THE TEMPORARIES.
;CALL THE SCANNER THE RIGHT NUMBER OF TIMES, AND
;GO START ALL OVER AGAIN.

REST:	MOVE	GP,GPSAV
	MOVE	PP,PPSAV
	SKIPN	B,TEMCNT
	JRST	SCANA

RES1:	PUSH	PP,PARRIG-1(B)	;RESTORE PARSE ITEM.
	PUSH	GP,GENRIG-1(B)	;AND SEMANTIC ITEM.
	SOJN	B,RES1		;GO BACK FOR MORE.



SCAN1:	MOVEM	PP,PPSAV	;SAVE STACK POINTERS
	MOVEM	GP,GPSAV	;SAVE STACK POINTERS
SCANA:	MOVE	TEMP,PCSAV	;
	ADDI	PTR,1		; PTR POINTS TO PUSHJ ADDRESS
	PUSH	TEMP,PTR	; ASSUME PUSHJ
	TRNE	A,BCARE		; CHECK FOR A POPJ WHICH NEEDS TO RESTORE SCNNO.  
	TRNE	A,BPRESUME	;  SCNNO AND DOESN'T INVOLVE A PARSER SWITCH
	JRST 	SCAN2		; NO
	HLRE B,-2(TEMP)		; THIS IS THE CASE WHEN ONE HAS AN INTERRUPTED 
	JUMPLE	B,SCAN2		;  PRODUCTION (I.E. DEFINE) WHICH IS TO BE
	TRZ	A,BCARE+BCLASS	;   RESUMED.  JUMPLE BECAUSE OF [-1,RELSE]
	ADD	A,B		;  AT BOTTOM OF STACK.  RESTORE FLAGS.  POPJ
	SUB	TEMP,X22	;  PRIORITY OVER PUSHJ IF BOTH ARE SPECIFIED 
SCAN2:	MOVEM	A,SCNNO		; NUMBER OF SCANS TO DO
	MOVEM	TEMP,PCSAV 	; SAVE PRODUCTION CONTROL STACK POINTER
DPUSH:	TRNN	A,777		; ANY SCANS TO DO?
	JRST	DOIT		; NO, GO DO PUSH, POP, OR NOTHING
	TRZE	A,BPRESUME	; PARSER SWITCH?
	JRST[TRZE A,BCARE	; YES, POPJ?
	JRST[SUB TEMP,X22	; YES, SET PCSAV STRAIGHT
	MOVEM	TEMP,PCSAV	;
	MOVE	TEMP,SCWSV	; POP SCNWRD STACK
	SUB	TEMP,X11	;
	MOVEM	TEMP,SCWSV	;
	JRST	DPSHED]		;
DPSHED:	SKIPE	PRSCON		; DETERMINE WHICH PARSER ONE IS CURRENTLY IN AND
	SKIPA	TEMP,[CGPSAV-1]	;  GET THE ADDRESS TO SAVE ITS PARSER DESCRIPTOR.
	MOVEI	TEMP,SGPSAV-1	;  SAVE SEMANTIC STACK POINTER, PARSE STACK 
	PUSH	TEMP,GPSAV	;  POINTER, CONTROL STACK POINTER, AND A POINTER 
	PUSH	TEMP,PPSAV	;  TO THE SCNWRD STACK.
	PUSH	TEMP,PCSAV	;
	MOVE	TBITS2,SCNWRD	; SAVE SCNWRD
	MOVE	B,SCWSV		;
	MOVEM	TBITS2,(B)	;
	PUSH	TEMP,SCWSV	;
	SKIPE	PRSCON		; DETERMINE WHICH PARSER IS TO BE RESUMED AND GET 
	SKIPA	TEMP,[XWD -1,SSCWSV] ;  THE ADDRESS OF ITS PARSER DESCRIPTOR.
	HRROI	TEMP,CSCWSV	;
	POP	TEMP,SCWSV	; RESTORE SCNWRD AND SCNWRD STACK POINTER
	MOVE	B,SCWSV		;
	MOVE	TBITS2,(B)	;
	MOVEM	TBITS2,SCNWRD	;
	POP	TEMP,PCSAV	; RESTORE CONTROL STACK POINTER
	MOVE	B,PCSAV		;
	HLRZ	B,(B)		;
	MOVEM	B,SCNNO		; RESTORE NUMBER TO SCAN
	POP	TEMP,SP		; RESTORE PARSE STACK POINTER.  MUST BE IN AC AS 
	MOVEM	SP,PPSAV	;  WELL AS IN MEMORY.
	POP	TEMP,GPSAV	; RESTORE SEMANTIC STACK POINTER
	SETCMM	PRSCON		; SET PARSER IN CONTROL
	JRST	.+1]
	PUSHJ	P,SCANNER		; GO SCAN
;;#GH# (3-5) END
IFN FTDEBUG, <
	AOS	SCNCNT		; COUNT CALLS ON SCANNER
	SKIPGE	PTR,.DBG.	; PERHAPS WANT TO BREAK?
	 PUSHJ	 P,DUMSCN	;  YES, GO HANDLE
>;IF FTDEBUG
;;#GH# (3-5)
	SOS	A,SCNNO		; DECREMENT SCAN COUNT
	JRST	DPUSH		; AND LOOP
DOIT:	TRNE	A,BCLASS	; IF PUSHJ, THEN
	JRST	PARSE		; ALL DONE
	MOVE	TEMP,PCSAV 	; RESTORE PRODUCTION CONTROL STACK POINTER
	SUB	TEMP,X11	; PUSHJ ASSUMPTION WAS WRONG
	TRNE	A,BCARE		; POPJ?
	SUB	TEMP,X11	; YES, POP PRODUCTION CONTROL STACK
	MOVEM	TEMP,PCSAV 	; SAVE PRODUCTION CONTROL STACK POINTER
	JRST	PARSIT		; CONTINUE
COMMENT ⊗Timer Package⊗

IFN TIMER, <
BEGIN TIMER
COMMENT ⊗
	THIS IS A LITTLE TIMER THAT WORKS FOR SAIL.
	IF YOU START THE THING AT "TIMIT", THE COMPILER WILL
	BE INTERPRETED.  COUNTS OF THE GENERAL TYPE OF INSTRUCTION
	(IN INTAB) AND WHERE (IN THE BUCKETS DEFINED BY THE MACRO
	RR AT THE END) ARE KEPT.  USING THIS ROUTINE SLOWS COMPILATION
	DOWN BY A FACTOR OF ROUGHLY 25.

⊗
EXTERNAL JOBSA



;AC'S

ZZ ← 0 ;CRUCIAL IN NUMBERS.
AA ← 1 ;  DITTO.

↑TIMIT:			;START HERE
	SETZM	INTAB
	MOVE	ZZ,[XWD INTAB,INTAB+1]
	BLT	ZZ,INTAB+7
	MOVEI	ZZ,BKLEN		;NUMBER OF BUCKETS IN TABLE.
	MOVEI	AA,BKBEG		;FIRST BUCKET.
BKLOP:	SETZM	1(AA)			;COUNT OF INSTRUCTIONS IN BUCKET.
	ADDI	AA,2
	SOJG	ZZ,BKLOP		;LOOP......

	HRRZ	AA,JOBSA		;WHERE TO START !!
	MOVEM	AA,PPCNT
	MOVEM	AA,PEECEE		;MY PROGRAM COUNTER

SEARCH:	MOVEM	3,SAV3
	MOVEM	ZZ,ZZSAV		;GET SOME AC'S
	MOVEM	4,SAV4

	MOVEI	ZZ,BKLEN
	MOVEI	3,BKBEG			;PREPARE TO SEARCH BLOCK.
COMLUP:	HLRZ	4,(3)			;LOWER BOUND
	CAIGE	AA,(4)			;ABOVE IT
	JRST	NOFAIL
	HRRZ	4,(3)
	CAILE	AA,(4)			;AND UNDER IT.
	JRST	NOFAIL
	HRRZM	4,CURTOP
	HLRZ	4,(3)
	HRRZM	4,CURBOT
	MOVEI	3,1(3)			;PLACE WHERE COUNT IS
	MOVEM	3,CURPNT

ALLON:	MOVE	3,SAV3
	MOVE	4,SAV4
	MOVE	ZZ,ZZSAV
	JRST	STARUP			;GO GO GO

NOFAIL:	ADDI	3,2
	SOJG	ZZ,COMLUP		;LOOK SOME MORE
	JRST	ALLON			;IF YOU CAN'T FIND A NEW BUCKET, USE
					;OLD ONE.

DOIT:	MOVE	AA,AASAV
INST:	XCT	@PPCNT			;MOST INSTR'S EXECUTED HERE.
	JRST	NEXT			;DID NOT SKIP
	AOS	PEECEE
NEXT:	MOVEM	AA,AASAV
RECORD:	SETZM	XCTF			;EXECUTE GOING ?
	MOVE	AA,PEECEE		;PC ← MA
	MOVEM	AA,PPCNT
RECGO:	CAML	AA,CURBOT		;SEE IF EFFECTIVE ADDRESS IN THIS
	CAMLE	AA,CURTOP		;BUCKET ...
	JRST	SEARCH			;NOT IN THIS BUNCH.
STARUP:	CAMN	AA,PROGS		;BREAK POINT
TIMBRK:	JFCL				;PLACE TO PLANT A REAL DDT BREAKPOINT
	AOS	@CURPNT			;INDEX THE BUCKET COUNTER
	LDB	AA,[POINT 3,@PPCNT,2]	;INSTRUCTION
	SKIPN	XCTF
	AOS	PEECEE			;PC ← PC +1
	AOS	INTAB(AA)		;RECORD INSTRUCTION FREQUENCY
	JRST	@DISTAB(AA)

INTAB:	BLOCK 10
DISTAB:	UUOINST				;DISPATCH TABLE
	DOIT
	SPECL
	JUMPS
	DOIT
	DOIT
	DOIT
	DOIT


UUOINST:
	LDB	AA,[POINT 9,@PPCNT,8]
	CAIE	AA,41			;INIT ?
	JRST	DOIT
	ERR	<INIT'S ARE NOT USED IN SAIL>

JUMPS:	LDB	AA,[POINT 6,@PPCNT,5]	;INTERPRET JUMPS
	CAIN	AA,32
	JRST	JUMPXX
	CAIE	AA,34
	CAIN	AA,36
	SKIPA
	JRST	DOIT
JUMPXX:	MOVE	AA,@PPCNT
	TLZ	AA,37
	HLLM	AA,JMPINS		;SAVE IT.
	MOVE	AA,AASAV
JMPINS:	JRST	TRA			;GO TO TRA IF IT TAKES.
	JRST	NEXT			;DID NOT TAKE.
TRA:	MOVEM	AA,AASAV
	MOVEM	ZZ,ZZSAV
TRAIT:	
	MOVE	ZZ,@PPCNT
	MOVEI	ZZ,@ZZ			;DEPENDS ON ZZ BEINO ZERO.
	MOVEM	ZZ,PEECEE		;NEW VALUE
	MOVE	AA,ZZ
	MOVE	ZZ,ZZSAV
	JRST	RECORDIT

SPECL:	LDB	AA,[POINT 9,@PPCNT,8]
	TRCE	AA,30
	TRNN	AA,40
	JRST	DOIT
	TRCN	AA,30
	JRST	DOIT
	TRNN	AA,10
	JRST	DPUSHJ			;OP CODES 260 - 267
	CAIE	AA,256			;XCT
	JRST	[CAILE	AA,251
		 JRST	JUMPXX
		 JRST	DOIT]
	SETOM	XCTF			;START EXECUTE CYCLE
	MOVEM	ZZ,ZZSAV
	MOVE	ZZ,@PPCNT
	MOVE	AA,AASAV
	MOVEI	ZZ,@ZZ			;EFFECTIVE ADDRESS....
	MOVEM	ZZ,PPCNT
	MOVE	AA,ZZ
	MOVE	ZZ,ZZSAV
	JRST	RECGO


DPUSHJ:	MOVEM	ZZ,ZZSAV
	ANDI	AA,7
	JRST    @.+1(AA)

	PUSHJ1
	DOIT
	DOIT
	POPJ1
	JSR1
	JSP1
	JSA1
	JRA1

PUSHJ1:	MOVE	ZZ,PEECEE
	LDB	AA,[POINT 4,@PPCNT,12]
	DPB	AA,[POINT 4,.+3,12]
	EXCH	ZZ,ZZSAV
	MOVE	AA,AASAV
	PUSH	ZZSAV
	JRST	TRA

POPJ1:	LDB	AA,[POINT 4,@PPCNT,12]
	DPB	AA,[POINT 4,.+2,12]
	MOVE	AA,AASAV
	POP	PEECEE
	MOVEM	AA,AASAV
	HRRZS	AA,PEECEE
	JRST	RECORDIT

JSR1:	MOVE	ZZ,@PPCNT
	MOVE	AA,AASAV
	MOVEI	ZZ,@ZZ
	MOVE	AA,PEECEE
	MOVEM	AA,@ZZ
	AOS	AA,ZZ
	MOVEM	AA,PEECEE
	MOVE	ZZ,ZZSAV
	JRST	RECORDIT

JSP1:	LDB	AA,[POINT 4,@PPCNT,12]
	MOVE	ZZ,PEECEE
	MOVEM	ZZ,ZZSAV(AA)	;RECORD IN BOTH PLACES.
	MOVEM	ZZ,(AA)
	JRST	TRAIT

JSA1:	JRA1:
	ERR	<NOT IMPLEMENTED>

PPCNT:	0
CURTOP:	0
CURBOT:	0
ZZSAV:	0
AASAV:	0
BLOCK 20
SAV3:	0
SAV4:	0
XCTF:	0
PEECEE:	0
CURPNT:	0
PROGS:	0




BKLEN	←=12
BKBEG:	
DEFINE RR (BEGINNING,ENDD) < XWD BEGINNING,ENDD
			0
>

	RR	LARGER,PRODGO	;COMMAND SCANNER & INITIALIZATION
	RR	PARSE,<POPTEM-1>;PRODUCTION SEARCHER
	RR	POPTEM,TIMIT-1	;STACK POPPER & EXEC ROUTINE CALLER
	RR	BKBEG,<SCAN-1>	;DEBUGGING ROUTINES
	RR	SCAN,<ENTER-1>	;SCANNER ...
	RR	ENTER,<GENINI-1>;SYMBOL TABLE LOOKUP & ENTER
	RR	GENINI,<LEPINI-1>;HIGH LEVEL ARITHMETIC GENERATORS
	RR	LEPINI,<CONV-1>;HIGH LEVEL LEAP GENERATORS
	RR	CONV,RINGSORT-1	;LOW LEVEL GENERATORS
	RR	RINGSORT,PATCH	;CORE MANAGEMENT, STRING GARBAGE COLLECTOR
	RR	400000,777777	;CORE MANAGEMENT, STRING GARBAGE COLLECTOR
	BLOCK =2






BEND
>
>;TEMPORARY END OF IFN FTDEBUG
SUBTTL	Debug package.
COMMENT ⊗Debugging Package -- Description

Here begins the debugging package.
These routines provide parse/semantic information at selected points
 during a compilation.  This display can be obtained when:
 1. A production is about to be tried
 2. An Exec routine is about to be called
 3. A token has just been scanned
 4. A selected line has been reached (or on every line)
 5. <esc>I is typed (Stanford only) -- after next Token scan

Information displayed is:
 1. The current file, page, and line number.
 2. The current input line, with a line-feed inserted to indicate
    the position of the Scanner.
 3. The current macro being expanded, if any, same format.
 4. The reason for the break.
 5. The top few elements of the parse/semantics stacks, including:
   a) @ if the token is a member of some class
   b) The symbolic name of the token in the parse stack (e.g., TLPRN)
   c) The address of any Semblk associated with that token.
   d) Two Fields, the TBITS word from that Semblk, in octal.
   e) The left-half SBITS word in octal.
   f) The ACNO field, in octal.
   g) A few characters from the name (string value) of the entity, if any.

The break routine then prints "#" and waits for directives, which may be:

 B	Breakpoint operation.  Must be followed by "s" (set) or "r"
	(remove) then the production name, followed by a space.
 xxM	Set Mode.  Must be preceded by a number  xx :
        1. Break only when execs are about to be called.
        2. Break only on <esc>I or line break or production breakpoint.
        3. Break on all productions and execs.
        4. Break as specified in current breakpoint mode, but don't pause
	   for directives -- terminated by <esc>I break or line break
	5  Continuously display the line being scanned (Stanford III only)
	6  Break after each call on SCANNER (no automatic stack display).
 C	Count the free storage cells.
 nnP	Proceed.  If nn is present, no actual breaks will occur until nn
	opportunities to do so (of any kind, excluding <esc>I) have 
	presented themselves. PROCNT, EXCCNT, SCNCNT, LINCNT are counts of
	the number of productions, execs, etc., seen so far.
 D	Go to DDT or RAID -- operates by setting a breakpoint if using RAID,
	return with <ctrl>P.  In DDT, return by REGO$G.  Returns to debug
	loop, types "#", awaits command.
 L	Stop on selected line -- followed by line/page, compiler will stop
	just after reading specified line, but before processing it.  If /page
	is omitted, current one is implied.  Other commands may follow this
	one on the line, but a <crlf> is required to activate the commands.
	If the file has no SOS line numbers, use the ordinality of the line
	in the current page.
 xxS	Show the xx'th stack entry (0 is top) in the above format.
 T	Terminate and return to error handler (if you came from there).

This whole section of code is merely a convenience, and not really part of
 the guts of the compiler.  Most of the routines were written to satisfy
 real debugging needs as the compiler was being developed.
⊗
COMMENT ⊗		      Variables⊗

ZERODATA (PARSE DEBUGGER VARIABLES)

COMMENT ⊗
PRODUCTION/EXEC BREAK CONTROL VARIABLES

.DBG. -- This value is set by the /M switch in the command line,
    or by the M parameter in the Debugging Scanner.  Its values,
    corresponding "M" codes, and functions are ---
  0 --  /2M --  Do not break on anything but "asynchronous break"
		(user types CR to break in)
  >0 -- /3M --  Break when EXEC routine to be executed
  <0 -- /1M --  Break when any production matches, or on EXEC
	/5M and /6M cut .DBG. out of the loop.
⊗
↑↑.DBG.: 0

;;#GH# DCS 2-1-72 (4-5) ADD 6M SCANNER BREAK, INTERRUPT FOR ASYNCH BREAKS
?SCNBRK: 0	;TEMP USED IN DMY TO INDICATE SCANNER BREAK

↑↑SCBCNT: 0	;USED IN DMY AS REPEAT COUNT FOR ANY BREAK
↑↑PROCNT: 0	;NUMBER OF TIMES THROUGH THE PRODUCTION DEBUGGER (DPY OR NOT)
↑↑EXCCNT: 0	;NUMBER OF TIMES THROUGH THE EXEC DEBUGGER
↑↑SCNCNT: 0	;NUMBER OF TIMES THROUGH THE SCAN BREAK ROUTINE
↑↑LINCNT: 0	;NUMBER OF LINE BREAKS

;BREAKP -- set if DMY is being executed because of a production
;    breakpoint -- see DSCR for debug routines for more details
?BREAKP: 0

;EXC -- set before DMY is called -- 0 if PRODUCTION Break,
;    -1 if EXEC break (unless SCNBRK set, then irrelevant)
?EXC:	 0

;MULTP -- set if user is not to be given control after input
;    line, stack, etc. are displayed (subject to INTERRUPT, of
;    course (/4M mode)
↑↑MULTP: 0

;PLINSW -- set if input line is to be displayed at every possible
;   moment  (/5M mode)
↑↑PLINSW: 0

COMMENT ⊗
OTHER DEBUGGER VARIABLES, RICH AND POOR

IFN FTDEBUG < ;JUST CONDIT THE BIG ONES
ACSAV -- block for saving ACs when doing DMY
⊗
?ACSAV:	BLOCK	20
>

;; #GH# (4) REMOVE ASYNTMP
?ASAV:	0	;SAVE AC A SOMETIMES

COMMENT ⊗
BKR -- specifies break character for ASCFIL routine -- see for
    details (used to allow ASCII strings to be considered as
    single entities at one time, for shipping around,  later
    as groups of characters, to be interspersed with other data
    e.g., setting up title lines, printing display line, etc.
⊗
↑↑BKR:	0


?CHAR:	 0	;TEMP FOR DEBUGGER SCANNER

IFN FTDEBUG <
COMMENT ⊗
DDFBUF, DDFPDL, DDRES
  Variables for implementing the DDFIND routine -- called from
  RAID or DDT to find the Semantics currently corresponding
  to a name.
⊗
?DDFBUF: BLOCK	6	;FOR INPUT OF ID
?DDFPDL: BLOCK	13	;SPECIAL PDP
↑↑DDRES: 0		;RESULT IF FOUND
;DDFPDP -- SEE ALSO, BELOW
>

?DEBTEM: 0		;A TEMP

COMMENT ⊗
EXROUTIN -- A call to the desired EXEC is placed here before
   going into the debugging business -- at an appropriate 
   point, after the stack has been displayed, and the user
   has had a chance to respond (he can look at EXROUTIN, among
   other things), this is XCTed -- not used if not debugging
⊗
↑↑EXROUTIN: 0

;FILBP -- PNEXTC transferred here when macro expansion is entered.
;   Used to print arrow on input line display (see ASCFIL)
↑↑FILBP: 0	;CONSIDER PUTTING THIS ELSEWHERE

?HIRAN:  0	;RANDOM TEMP

?LSTPSW: 0	;FLAG INDICATING LINE # BREAK TO DMY

?NEG:	 0	;RANDOM FLAG FOR NUMBER INPUTTER IN DEBUG SCANNER

?SENC:	 0	;RANDOM TEMP

?SETB:	 0	;RANDOM TEMP

?STLINE: 0	;LINE # (ASCII) ON WHICH TO CAUSE LINE BREAK
↑↑STPAGE: 0	;PAGE # (BINARY) ON WHICH TO CAUSE LINE BREAK

DATA (PARSE DEBUGGER VARIABLES)

IFN FTDEBUG <
COMMENT ⊗
HEADINGS FOR DEBUG OUTPUT (DESCRIBES REASON FOR BREAK, ETC.)
⊗

;; #GH# (4) USED TO BE ASYNBUF
↑↑SCNBUF: ASCIZ	"SCANNER BREAK
"

↑↑HBUF:	ASCIZ	"PRODUCTION IS                    "

↑↑HDBUF: ASCIZ	"LINE BREAK
"

↑↑XBUF:	ASCIZ	"EXEC ROUTINE                     "


?DDFPDP: IOWD	12,DDFPDL	;PDP FOR DDFPDL (SEE DDRES)

;OBUF -- Output buffer for TTYUUO'S to type stack info
OBUF:	ASCII/                                                           /
	BLOCK	10

;;#GR# DCS 2-8-72 (2-3) MINOR FTDEBUG FIXES
↑PRSBP:	0			;-1 IF BP SET AT BRKHER (FOR D COMMAND)
;;#GR# (2)

>
ENDDATA
COMMENT ⊗  Stplin -- 	      Break on <crlf>⊗

IFN FTDEBUG, <	;RESUME CONDITIONAL ASSEMBLY
↑STPLIN:PUSH	P,A
	SETOM	LSTPSW	;DO NOT PRINT HEADER FOR STACK
	MOVE	A,STPAGE	;WANTS TO STOP ON THIS PAGE NUM
	JUMPE	A,STPTHS	;EACH PAGE?
	CAME	A,FPAGNO	;HAS IT COME BY YET?
	 JRST	 LSTPJ		; (THERE WILL BE FILE REDUNDANCY)
	MOVE	A,STLINE	;RIGHT PAGE, IS IT THE
	CAME	A,ASCLIN	; DESIRED LINE?
	JRST	LSTPJ		;NO
STPTHS:	SOSLE	SCBCNT		;STOP YET?
	 JRST	 LSTPJ		;NOPE
	SETZM EXC		;CLEAR USELESS PARAMS
	SETZM DEBTEM
	PUSHJ P,DMY
LSTPJ:	SETZM	LSTPSW		;RESET
	POP	P,A
	POPJ	P,
COMMENT ⊗  Dmyexc, etc. --    Main Control Loops⊗

EXTERNAL	JOBDDT
;; #GH# (4) .DBG.= -1,,-1 OR 0,,-1 FOR EXEC BREAK,
;; #GH#            -1,,-1 FOR PRODUCTION BREAK,
;; #GH#             400000,,-1 FOR SCANNER BREAK,
;; #GH#		    400000,,377777 FOR <ESC>I BREAK

DMYEXC:JUMPGE	PTR,DOXC	;ALWAYS BREAK IF GTR. 0 (NOT SCAN OR ASYN BREAK)
	TLNN	PTR,200000	;SCAN BREK?
	 JRST	 EXDO		;YES, IGNORE .DBG. COMPLETELY
DOXC:	SOSLE	SCBCNT		;SHOW IT YET?
	 JRST	 EXDO		;NO
	PUSH	P,EXCTAB-1(A)	;THE EXEC ROUTINE
	POP	P,EXROUTIN
	SETOM	EXC
	MOVEM	A,ASAV
	PUSHJ	P,DMY
	XCT	EXROUTIN		;DO IT IF NECESSARY.
	JRST	EXDON


DUMPRO:	MOVE	A,-1(PROD)	;PICK UP PRODUCTION NAME
	SETZM	BREAKP
	SETZM	EXC
	MOVEM	A,ASAV
	SKIPL	PTR,.DBG.	;A STANDARD BREAK?
	 JRST	 CHKBKP		; NO, CHECK PRODUCTION BREAKPOINT
	TLNN	PTR,200000	;PERHAPS A SCANNER BREAK?
	 JRST	 POOG		; YES, IGNORE
	JRST	YESPRO		;GO DISPLAY
CHKBKP:	TRNN	A,1		;A BREAKPOINT ?
	JRST	POOG		;NO
	SETOM BREAKP		;YES
YESPRO: SOSLE	SCBCNT		;TIME TO QUIT?
	 JRST	 POOG		;NO, AND AFTER ALL THAT, TOO!
	PUSHJ	P,DMY
	JRST	POOG

DUMSCN:
NOEXPO <
	TRNE	PTR,400000	;WAS IT AN <ESC>I INTERRUPT?
	 JRST	 NOINTR		; NO
	 SETZM	 .DBG.		; YES, DON'T LET IT HAPPEN AGAIN
	 SETZM	MULTP
	JRST	INTR
>;NOEXPO
NOINTR:	TLNN	PTR,200000	;IS IT A SCAN BREAK?
	SOSLE	SCBCNT		;AND HAVE WE DONE ENOUGH OF THEM?
	 POPJ	 P,		; NO, PRODUCTION OR KEEP UP -- NEXT TIME

INTR:	SETOM	SCNBRK
	PUSHJ	P,DMY
	SETZM	SCNBRK
	POPJ	P,		;DO IT
COMMENT ⊗  Dmy -- Inna, Inn --Display Subroutine⊗

DMY:	MOVEM	0,ACSAV
	MOVE	0,[XWD 1,ACSAV+1]
	BLT	0,ACSAV+16	;SAVE ALL ACCUMULATORS

	PUSHJ	P,DSPLIN	;DISPLAY IF POSSIBLE

	SETZM	CHAR		;CHARACTER COUNTER
	MOVEI	A,HDBUF
	SKIPE	LSTPSW		;LINE NUMBER BREAK?
	 JRST	 PRTHED		;YES, PRINT SIMPLE HEADING
;; #GH# (4)
	MOVEI	A,SCNBUF
	SKIPE	SCNBRK
	 JRST	 PRTHED
;;#GH# (4-5) END
	MOVE	PTR,[POINT 7,HBUF+3]
	SKIPE	EXC		;CALLED FROM EXECUTIVE HANDLER?
	HRRI	PTR,XBUF+3	;YES
	MOVE	A,ASAV		;GET SIXBIT OR PTR TO IT BACK
	SKIPE	EXC
	MOVE	A,EXCNAM(A)	;GET EX NAME

	PUSHJ	P,PRNSM		;PRINT THE SYMBOL
	PUSHJ	P,CRLF
	MOVEI	A,HBUF
	SKIPE	EXC
	MOVEI	A,XBUF
PRTHED:	
	CALL6	(A,DDTOUT)	;USED TO BE A CALL 
	SKIPE	SCNBRK		;DON'T VOLUNTEER STACK ON SCANNER
	 JRST	 GO.ON		; BREAK
	MOVEI	A,0
	MOVE	B,DEBTEM
	ADDM	B,GPSAV
	ADDM	B,PPSAV
P6:	PUSH	P,A
	PUSH	P,B
	SETZM	CHAR
	PUSHJ	P,PRINLIN
	POP	P,B
	POP	P,A
	SOS	A
	SOJE	B,P6A
	SKIPE	EXC
	JRST	.+4
	CAME	A,[-3]
	JRST	P6
	JRST	P6A
	MOVN	C,A
	CAME	C,DEBTEM
	JRST	P6


P6A:	MOVN	B,DEBTEM
	ADDM	B,PPSAV
	ADDM	B,GPSAV
GO.ON:	SKIPN	LSTPSW		;STOP ON LINE BREAK ALWAYS
	SKIPN	MULTP		;IN MULTIPLE PROCEED?
	JRST	INNA		;NO
	SKIPN	BREAKP
	JRST	PRO		;PROCEED IF NO BREAKPOINT.
;;#GR# DCS 2-8-72 (3-3) MINOR FTDEBUG MODS
↑↑INNA:	SETZB C,NEG
	INSKIP	A		;ANY CHARS WAITING?
	 OUTCHR ["#"]		;NO, TYPE WAITING MESSAGE
INN:	TTCALL	A		;GET A CHAR FROM USER
; let debugger know about lower case
	CAIE	A,"p"		
	CAIN	A,"P"
	JRST	PROXX		;PROCEED
	CAIE	A,"d"
	CAIN	A,"D"		;GO TO DDT
	JRST	DDTG
	CAIE	A,"b"
	CAIN	A,"B"	;BREAKPOINT
	JRST	BP1
	CAIE	A,"t"
	CAIN	A,"T"
	 POPJ	 P,		;RETURN TO ERROR HANDLER
	CAIE	A,"s"
	CAIN	A,"S"		;STACK EXAMINE.
	JRST	STA
	CAIE	A,"m"
	CAIN 	A,"M"		;MODE
	JRST	MOD1
	CAIE	A,"c"
	CAIN	A,"C"		;COUNT
	JRST	SCNT
	CAIE	A,"l"
	CAIN	A,"L"		;PAGE AND LINE BREAK SPECS?
	 JRST	 LINSTOP	; YES
NOEXPO <
	CAIE	A,"q"
	CAIN	A,"Q"		;SET A BREAKPOINT?
	 JRST	 SETONE		; YES
	CAIE	A,"r"
	CAIN	A,"R"		;REMOVE A BREAKPOINT?
	 JRST	 REMONE		; YES
>;NOEXPO
	CAIE	A,"-"
	JRST	[CAIG A,"9"
		CAIGE A,"0"
		JRST INN
		IMULI C,=10
		ADDI C,-"0"(A)
		JRST INN]
	SETOM	NEG
	JRST	INN

STA:	
	SKIPL	NEG
	MOVNS	C		;WE WERE TOLD TO COMPLEMENT IT
	MOVE	A,C
	ADD	A,DEBTEM	;TO GET INREASONABLE RANGE.
	PUSHJ	P,PRINLIN
	JRST	INNA

BP1:	TTCALL	A
	CAIE	A,"s"
	CAIN	A,"S"		;SET?
	SETOM	SETB
	CAIE	A,"r"
	CAIN	A,"R"
	SETZM	SETB
	SETZB	B,SENC
	MOVE	C,[POINT 6,B]
BPX:	TTCALL	A
	SUBI	A,40		;CONVERT TO SIXBIT
	SKIPN	SENC
	JUMPE	A,BPX
	IDPB	A,C
	SETOM	SENC
	JUMPN	A,BPX
	MOVEM	B,HIRAN

	MOVEI	A,BB0-1		;START HERE
FLOP:	CAIN	A,IPROC		;END HERE
	JRST	NOFND
	MOVE	C,(A)
	TRZ	C,1		;TRUN OFF DEBUG BIT.
	CAMN	C,B
	JRST	YESFND
	AOJA	A,FLOP
COMMENT ⊗		      Read L/P⊗

LINSTOP: ;GET LINE/PAGE NUMBERS
	TTCALL	14,0		;WAIT FOR ACTIVATOR
	SETZM	STLINE
;;#GG# DCS 2-1-72 (1-2) ASSUME CURRENT PAGE
	MOVEW	STPAGE,FPAGNO	;ASSUME CURRENT PAGE
;;#GG#
	MOVE	TEMP,[POINT 7,STLINE]
	MOVEI	B,5		;MAX USABLE COUNT
LSLP10:	TTCALL	A		;GET A CHAR
	CAIL	A,"0"
	CAILE	A,"9"		;IS IT A DIGIT?
	JRST	LSLP10		;NO
	SKIPA			;YES
LSLP1:	TTCALL	A		;GET A CHAR
	CAIL	A,"0"
	CAILE	A,"9"		;DIGIT?
	 JRST	 LSLP2		;NO, DONE
	SOJL	B,LSLP1		;FORGET AFTER 5
	IDPB	A,TEMP		;PUT IT AWAY
	JRST	LSLP1		;LOOP
LSLP2:	MOVE	B,STLINE	;GET RESULT
LSLP3:	TRNE	B,376		;LOW ORDER 0?
	 AOJA	 B,LSLP4	;NO, ALL OK
	LSH	B,-7
	TLO	B,"0"⊗(=18-7)	;YES, PUT IN ZEROES
	JRST	LSLP3		;LOOP UNTIL ALL ASCII CHARS
LSLP4:	MOVEM	B,STLINE	;RESTORE IT
	CAIE	A,"/"		;PAGE # SPECIFIED?
	 JRST	 INNA		;NO
	MOVEI	B,0		;YES, GET PAGE #
LSLP6:	TTCALL	A		;GET A CHAR
	CAIL	A,"0"
	CAILE	A,"9"		;DIGIT?
	 JRST	 LSLP5		; YES, DONE
	IMULI	B,=10
	ADDI	B,-"0"(A)	;COLLECT NUMBER
	JRST	LSLP6		;LOOP
LSLP5:	MOVEM	B,STPAGE
	JRST	INNA		;DONE
;;#GG# DCS 2-1-72 (2-2)
CCPP:	SKIPGE	TEMP,STPAGE	;USE PAGE 1 IF NO PAGE YET
	MOVEI	TEMP,1
	MOVEM	TEMP,STPAGE
;;#GG#

NOFND:	TERPRI	<NOT FOUND>
	JRST	INNA

YESFND:	SKIPE	SETB
	TRO	C,1
	MOVEM	C,(A)		;PUT IT BACK.
	JRST	INNA

MOD1:	
	JUMPL	C,INNA
	CAIG	C,6
;DCS 9-21-71
	PUSHJ	P,STMD		;(SEE COMMAND SCANNER)
	JRST	INNA


NOEXPO <
SETONE:	SKIPE	EXC		;IF CALLED FROM EXEC HANDLER,
	 PUSHJ	P,SETBKP	; SET A BREAKPOINT
	JRST	INNA		;NEXT COMMAND

REMONE:	SKIPE	EXC
	 PUSHJ	P,REMBKP	;REMOVE IF FOUND
	JRST	INNA		;FORGET IT IF NOT
>;NOEXPO



SCNT:	SETZM	C
	SKIPA	LPSA,BLFREE
SLOPP:	RIGHT	,%TBUCK,ALDD
	AOJA	C,SLOPP
ALDD:	OCTPNT	C
	JRST	INNA
;Ddtg, Rego, Proxx -- Enter, Leave DDT, Proceed from Debug
;; #GR# (3)

DDTG:	SKIPN	A,JOBDDT
	 JRST	 INNA		;NO DDT
	TLNE	A,40		;RAID VERSION 1?
	 JRST	 PRODD		; YES, CAUSE A BREAKPOINT
	EXCH	A,(P)		;NEW ADDRESS.
	HRRZM	A,REGO		;WHERE TO CONTINUE
	JRST	PRO		;CONTINUE

PROXX:	TTCALL	11,		;CLEAR INPUT BUFFER BEFORE PROCEEDING
	MOVEM	C,SCBCNT	;REPEAT FACTOR FOR SCANNER BREAK
PRO:	MOVE	0,[XWD ACSAV+1,1]
	BLT	0,16
	MOVE	0,ACSAV
	POPJ	P,		;DONE
↑↑REGO:	JRST	.


PRODD:	MOVE	A,-6(A)		;ADR OF $I
	MOVEM	A,PRSBP		;STORE OUT OF ACS
	MOVE	0,[XWD ACSAV+1,1];GET 'EM BACK TEMPORARILY
	BLT	0,16
	MOVE	0,ACSAV
↑↑BRKHER:JSR	@PRSBP		;BREAK HERE
	JRST	INNA		;AWAY WE GO

;;#GR# (3)
COMMENT ⊗   Prinlin --	      Print Stack Entry Line⊗

;ROUTINE TO PUT TOGETHER A LINE ABOUT THE STACK ENTRY
;WHOSE INDEX IS IN REGISTER "A"

PRINLIN:MOVEM	A,ASAV
	MOVE	B,PPSAV
	ADDI	B,(A)
	MOVE	B,(B)		;STACK ENTRY
	MOVEI	C,"@"
	CAIG	B,400000
	MOVEI	C," "
	DPB	C,[POINT 7,OBUF,27]	;CLASS TYPE?
	MOVE	A,SYMNAM (B)	;PRINT NAME
	MOVE	PTR,[POINT 7,OBUF+1]
	PUSHJ	P,PRNSM
	MOVE	PTR,[POINT 7,OBUF+2,27]
	MOVE	B,GPSAV
	ADD	B,ASAV
	MOVE	A,(B)
	PUSH	P,A	;GENERATOR ENTRY
	PUSHJ	P,NUM
	PUSHJ	P,SPOUT
	MOVE	D,(P)	;IS THERE AN ENTRY?
	CAMGE	D,LPSTOP
	CAMGE	D,LPSBOT

PING:	JRST	CRLF0	
	HLRZ	A,$TBITS(D)
	PUSHJ	P,NUM
	PUSHJ	P,SPOUT
	HRRZ	A,$TBITS(D)	;TBITS
	PUSHJ	P,NUM
	PUSHJ	P,SPOUT
	HLRZ	A,$SBITS(D)
	PUSHJ	P,NUM

	PUSHJ	P,SPOUT
	HRRZ	A,$ACNO(D)
	PUSHJ	P,NUM
	PUSHJ	P,SPOUT
	HRRZ	A,$PNAME(D)	;COUNT
	JUMPE	A,CRLF0		;NO PRINT NAME
	CAILE	A,15
	MOVEI	A,15
	HLRZ	TEMP,$PNAME+1(D)
	CAIE	TEMP,(<POINT 7,0>)
	JRST	CRLF0
	MOVE	D,$PNAME+1(D)
SRFF:	ILDB	TEMP,D
	IDPB	TEMP,PTR
	SOJG	A,SRFF


	
CRLF0:	POP	P,A
	TRZ	C,177
	IDPB	C,PTR
	TTCALL	3,OBUF		;PRINT THE LINE
	TERPRI			;TERMINATE IT
	POPJ	P,

CRLF:	MOVEI	C,15
	IDPB	C,PTR
	MOVEI	C,12
	IDPB	C,PTR
	TRZ	C,177
	IDPB	C,PTR
	POPJ	P,

SPOUT:	MOVEI	TEMP," "
	IDPB	TEMP,PTR
	POPJ	P,
Comment ⊗ DDFIND -- find symbol for USER.
	Called from DDT or RAID by typing DDFIND$G  ⊗

↑DDFIND: EXCH	P,DDFPDP		;IN CASE RAID IS DISHONEST
	PUSHJ	P,SAVE		;IN GOGOL.IOSER
;; JRL- DDFIND SHOULDN'T DESTROY TEMP,LPSA, OR USER EITHER
	PUSH	P,TEMP
	PUSH	P,LPSA
	PUSH	P,USER
;;
	SETZM	DDFBUF
	MOVE	TEMP,[XWD DDFBUF,DDFBUF+1] ;CLEAR BUFFER
	BLT	TEMP,DDFBUF+5
	MOVEI	A,0		;COLLECT COUNT
	PUSH	P,PNAME
	PUSH	P,PNAME+1
	MOVE	B,[POINT 7,DDFBUF]
	MOVEM	B,PNAME+1	;FIRST BYTE OF PNAME
	
DDF1:	TTCALL	TEMP		;GET A CHARACTER
	CAIN	TEMP,15		;TERMINATES
	 JRST	 DDFDUN
	IDPB	TEMP,B		;YES
	AOJA	A,DDF1		;GET IT ALL
DDFDUN:	HRRZM	A,PNAME		;COUNT
	PUSH	P,HPNT
	PUSH	P,NEWSYM
	MOVE	LPSA,SYMTAB
	PUSHJ	P,SHASH
	SKIPE	A,NEWSYM
	TERPRI	<FOUND IT -- RESULTS IN DDRES>
	SKIPN	A
	TERPRI	<NOT FOUND>
	MOVEM	A,DDRES
	POP	P,NEWSYM
	POP	P,HPNT
	POP	P,PNAME+1
	POP	P,PNAME
;; -RESTORE WHAT WE SAVED
	POP	P,USER
	POP	P,LPSA
	POP	P,TEMP
;;
	MOVEI	LPSA,0
	MOVEI	TEMP,.+3
	MOVEM	TEMP,UUO1(USER)
	JRST	RESTR
	EXCH	P,DDFPDP
	POPJ	P,		;SINCE HE CALLED IT WITH PUSHJ P,



NUM:	MOVNI	C,6
	ROT	A,=18
PEP2:	SETZM	B
	ROTC	A,3
	ADDI	B,"0"
	IDPB	B,PTR
	AOS	CHAR
	AOJN	C,PEP2
	POPJ	P,


SIXBT:	MOVNI	C,3
P3:	SETZM	B
	ROTC	A,6
	ADDI	B,40
	IDPB	B,PTR
	AOS	CHAR
	AOJN	C,P3
	POPJ	P,

NOEXPO <
EXTERNAL JOBDDT
↑SETBKP:
	PUSH	P,A
	HRRZ	TEMP,EXROUTINE	;PNTS TO ADDR TO BE BREAKPOINTED
	SKIPE	A,JOBDDT		;IS DDT LOADED?
	 JSR	 TEMP,@-1(A)		; YES, SET THE BREAKPOINT
; THERE IS A DISPATCH TO A BREAKPOINT-SETTING ROUTINE HERE IN RAID ONLY
APOPJ:	POP	P,A
	POPJ	P,

↑REMBKP:
	PUSH	P,A
	HRRZ	TEMP,EXROUTINE
	SKIPE	A,JOBDDT		;DDT (RAID) LOADED?
	 JSR	 TEMP,@-2(A)		; YES, REMOVE BREAKPOINT
	JRST	APOPJ
>;NOEXPO
↑PRNSM:	PUSHJ	P,PRINSYM		;PRINT THE SYMBOL
	MOVEI	B," "			;FINISH OUT WITH SPACES
	JUMPGE	C,PRSP1
LLX:	IDPB	B,PTR
	AOS	CHAR
	AOJN	C,LLX
	POPJ	P,
>			;end of IFN FTDEBUG conditional assmby.
COMMENT ⊗Decfil, Ascfil, Prinsym⊗

DSCR DECFIL
CAL PUSHJ from text-line creators
PAR D is number to be converted to ASCII
 TEMP is ASCII bp to output
RES ASCII for D (with sign, if neg) is deposited via TEMP
SID D, D+1 destroyed, TEMP updated
⊗
↑DECFIL:	; PUT A POSITIVE NUMBER IN ASCII IN BUFFER
		; POINTED TO BY TEMP

	JUMPGE	D,POSFIL	;MIGHT BE NEGATIVE
	MOVEI	D+1,"-"
	IDPB	D+1,TEMP
	MOVMS	D		;ISN'T NOW

POSFIL:	IDIVI	D,=10
	HRLM	D+1,(P)	;IT'S RECURSIVE PRINTER TIME AGAIN
	SKIPE	D
	PUSHJ	P,POSFIL
	HLRZ	D,(P)
	IORI	D,"0"
	IDPB	D,TEMP
	POPJ	P,

DSCR ASCFIL
CAL PUSHJ from routines which create text lines
PAR A is input BP
 BKR is break char
 TEMP is output BP
 FILBP (in compiler) is bp to a char which is to be indicated
  by an arrow. (via DPY instrs if NOEXPO, LF otherwise).
RES Text is moved from A's area to TEMP's, stopping when
  an input char = BKR (or if BKR<0, when char terminates line).
 If A ever = FILBP, stuff is done to produce the arrow or line
  feed (assumes that when this happens, output is going to DPY).
SID B is destroyed, A and TEMP are updated.
⊗
↑ASCFIL:CAME	A,FILBP
	 JRST	 NOARROW		;NOT YET (OR NOT AGAIN)
	MOVEI	B,12
	IDPB	B,TEMP		;NO, USE LINE FEED TO
NOARROW:
	ILDB	B,A
	SKIPGE	BKR
	JRST	[JUMPE	B,YPOPJ   ;IN THIS MODE, WANT TO
		 CAIE	B,177	  ;STOP ON 0, 12, OR 177
		 CAIN	B,12
		 POPJ	P,
		 JRST	FDIPB]
	CAMN	B,BKR		;DONE?
YPOPJ:	 POPJ	P,
FDIPB:	IDPB	B,TEMP		;NO -- STORE THIS ONE
	JRST	ASCFIL

; SIXBIT INPUT IN A
; USES B,C
; OUTPUT TO PTR'S BYTE POINTER
; MODIFIES CHAR
↑↑PRINSYM:	
	MOVNI	C,6	;COUNT
PRSP1:	SETZM	B
	ROTC	A,6
	JUMPE	B,PRSP2
	ADDI	B,40		;CONVERT TO ASCII
	IDPB	B,PTR
	AOS	CHAR
	AOJN	C,PRSP1
PRSP2:	POPJ	P,
	XALL

↑PRSYM:	PUSH	P,C			;KVL SEZ: THIS MUST BE FOR USE WITH DDT
	HRRZ 	C,$PNAME(LPSA)		;PRINT SYMBOL IN LPSA
	MOVE	A,$PNAME+1(LPSA)
	JRST	PRTST
PRLOP:	ILDB	B,A			;GET CHAR
	PUUO	1,B			;PRINT IT
PRTST:	SOJGE	C,PRLOP
	POP	P,C
	POPJ	P,

SUBTTL Production Tables.