COMMENT ⊗   VALID 00010 PAGES VERSION 17-1(16)
RECORD PAGE   DESCRIPTION
 00001 00001
 00002 00002	HISTORY
 00004 00003	Comser Data -- Povtab, Dsplin stuff
 00006 00004	Strngc Supply Routines for Compiler Structures
 00008 00005	Compiler-Specific portion of Error UUO stuff
 00011 00006	 SERVICE ROUTINES TO MYERR
 00013 00007	MORE SERVICE ROUTINES FOR MYERR
 00016 00008	DSCR PRINT.
 00018 00009	Dsplin Routine for Displaying Input Line
 00021 00010	Interrupt Handler -- Intrpt, Povtrp
 00025 ENDMK
⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021  102100000020  ⊗;


COMMENT ⊗
VERSION 17-1(16) 12-8-73 BY JRL REMOVE SPECIAL STANFORD CHARACTERS(WHERE POSSIBLE)
VERSION 17-1(15) 11-17-73 
VERSION 17-1(14) 11-10-73 BY KVL %AI% ADD <ESC> I INTERRUPT TO RESET ERROR HANDLER
VERSION 17-1(13) 7-26-73 BY RHT **** VERSION 17 ****
VERSION 16-2(12) 6-29-73 BY JRL END RINGSORT WITH POPJ P,
VERSION 16-2(11) 3-13-73 BY JRL REMOVE REFERENCES TO GAG
VERSION 16-2(10) 7-3-72 BY DCS INSTALL VERSION 16
VERSION 15-2(9) 2-26-72 BY DCS <ESC> I ALWAYS BREAKS
VERSION 15-2(8) 2-6-72 BY DCS BUG #GM# RETURN ADDRESS BEING WIPED OUT IN POVTRP
VERSION 15-2(7) 2-5-72 BY DCS BUG #GJ# ADD LSTON LISTING CONTROL STUFF
VERSION 15-2(6) 2-1-72 BY DCS BUG #GH# <ESC>I CAUSES PARSER TO BREAK AFTER NEXT SCAN
VERSION 15-2(5) 12-26-71 BY DCS BUG #FU# REENABLE ACCESS TO FTDEBUG FROM ERR UUO
VERSION 15-2(4) 12-22-71 BY DCS BUG #FT# DSPLIN CLEANED UP
VERSION 15-2(3) 12-22-71 BY DCS BUG #FT# MYERR RETURNS BINLIN (SEQUENTIAL LINE #)
VERSION 15-2(2) 12-21-71 BY DCS BUG #FS# REMOVE COM2 REFS (ASSUME RUNTIM OR LIB)
VERSION 15-2(1) 12-2-71 BY DCS INSTALL VERSION NUMBER

⊗;
COMMENT ⊗Comser Data -- Povtab, Dsplin stuff⊗
	LSTON	(COMSER)

BEGIN COMSER		;SERVICE ROUTINES FOR COMPILER.

ZERODATA (COMSER VARIABLES)

COMMENT ⊗
POVTAB -- table of ASCIZ strings, one per AC, giving reasonable
    messages to be typed when PDL overflow occurs. 0 if none
    provided -- set up in POVSET from SAIL INIT -- changed 
    occasionally as needs change.  Used by POVTRP below
⊗
↑↑POVTAB: BLOCK  10

;PDLSV, PDLSV1 -- save AC's when PDL trapping
?PDLSV: 0
?PDLSV1:0

DATA (COMSER VARIABLES)

COMMENT ⊗
DSPLIN and MYERR variables
⊗
DLINBF:	BLOCK 53

ENDDBF←DLINBF+53

DATA(LOGGING VARIABLES)

MAKCDB(LOG,LOG,0,0,1)

ZERODATA( LOGGING VARIABLES)

↑..STR:0
↑..LOCA:0
↑%QUIET:	0
%MINUS:	0
%NUMBS:	0
%LOGGIN:0

ENDDATA
COMMENT ⊗Strngc Supply Routines for Compiler Structures⊗

;          SORT THE STRINGS IN SYMBOL TABLE

DSCR RINGSORT
CAL PUSHJ from STRINGC.
DES It passes off to the GC all of the Strings located in
  symbol table Semblks in the compiler. It does this by
  searching down the %RSTR ring (STRRNG).
⊗

T←←11

↑RINGSORT:
	HRRZ	T,STRRNG	;PTR TO LAST BLOCK IN STRING RING
	JUMPE	T,CPOPJ		;DONE WHEN 0, GO MARK VARIABLES
RGSLUP:	MOVEI	A,$PNAME(T)	;PTR TO STRING DESCRIPTOR
	PUSHJ	P,@-1(P)	;SORT IT INTO LISTS
	HLRZ	T,%RSTR(T)	;NEXT BLOCK
	JUMPN	T,RGSLUP	;CONTINUE UNLESS DONE
	POPJ	P,


;	   SORT STRINGS IN DEFINE STACK
DSCR DEFSRT
CAL PUSHJ from STRINGC
DES Passes off all Strings currently in the Define stack to be collected.
⊗;

↑DEFSRT:
	HRRZ	A,DFSTRT	;SORT STRINGS ON DEFINE STACK
	HRRZ	T,DEFPDP	;TERMINATION VALUE
	SUBI	A,1		;INIT
	JRST	SGDTST		;JUMP INTO THINGS

DEFMRK:	
	PUSHJ	P,@-1(P)	;SORT INTO STRUCTURE
SGDTST:
	ADDI	A,2		;AUTO-INCR DOESN'T GO FAR ENOUGH
	CAMGE	A,T		;DONE?
	JRST	DEFMRK		; NO
	POPJ	P,		; YES


	RINGSORT		;1 ROUTINE
	0
	LINK 4,.-1		;FOR STRING GARBAGE COLL.

	DEFSRT
	0
	LINK 4,.-1		;AND ANOTHER ROUTINE.


COMMENT ⊗Compiler-Specific portion of Error UUO stuff⊗

DSCR MYERR
DES Part of the second segment kludge -- so that the error
  handler can call some routines which are specific to the
  compiler. There routines are -- display the current line.
  -- call the editor on the current input file -- log error messages.
⊗;
↑↑MYERR:
	MOVE	13,SRCFIL	;FILE NAME NEEDED IN ANY CASE
	MOVE	14,SRCEXT
	MOVE	11,SRCPPN
	SKIPE	A,-1(P)		;GO TO EDITOR?
	 JRST 	NOE		;NOPE, DO DSPLIN & LOGGING STUFF
	MOVE	16,FPAGNO	;AS IS THIS
	SKIPN	15,ASCLIN
	MOVE	15,[ASCID/00000/]
	TRO	15,1		;FOR WFW
	SKIPA	12,BINLIN	;TV WILL WANT THIS NUMBER INSTEAD
GOHOHO:	SUB	SP,X44			;GET RID OF STRINGS
       	SUB	P,X22
	JRST	@2(P)

NOE:	HRRZM	A,..LOCA	;STORE NUMBERS
	MOVE	A,-2(SP)	;GET STRING
	HRRZM	A,..STR		;STORE IT TOO
	SKIPL	%RECOV
	 SETZM	%QUIET		;MAKE FATAL ERRORS PRINT
	PUSHJ	P,ERPRIN	;PRINT MSG, ETC.
	SKIPE	%ERGO		;AUTO CONTINUE?
	 JRST	HOME2
;;#PR# RHT FLUSH TYPE AHEAD (1 OF 2)
	PUUO	2,B		;INCHRS
	JRST	PROMPT		;NO TYPE AHEAD
	PUUO	11,0		;CLEAR BUFFER
	CAIN	B,12		;ONLY USE TYPE AHEAD IF WAS A LF
	JRST	CHRGOT		;HAVE GOT IT
;;#PR#
PROMPT:	PUUO	3,CRLF..
	MOVEI	A,"?"		;PRINT ? FOR IRRECOVERABLE ERRORS,
	SKIPGE	%RECOV		;CAN CONTINUE?
	MOVEI	A,"↑"		;SOMETHING PRINTABLE
	PUUO	1,A		;PRINT IT
NOPROM:
	PUUO	0,B		;GET RESPONSE CHAR
CHRGOT:	PUSHJ	P,DSPATC	;GO DO THE RIGHT THINGS
	JRST	HOME0		;GOT AN ACTIVATION LETTER
	SKIPE	%MINUS		;DONOT PROMPT IF WE RECEIVED A MINUS
	JRST	NOPROM
	JRST	PROMPT
;;#PR#
HOME0:	CAIN	B,15		;IF A CR
	PUUO	2,A		;GOBBLE THE LF
	JRST	HOME1		;NOT ONE THERE
	JRST	HOME1		;
;;#PR#
HOME2:	SKIPA	A,[0]
HOME1: 	HRRZ	A,B			;PUT LEFTOVER CHARACTER IN
	TLO	A,3			;DO NOT PRINT OR GIVE NUMBERS
	JRST	GOHOHO			; AND A BOTTLE OF RUM
; SERVICE ROUTINES TO MYERR
;Dspatc is also called from GEN in the routine that does REQUIRE ERROR!MODES.
;Dspatc skip returns if the contents of B was any of the error modes.
;It does a regular return if B was any of the activation responses.
;It skip returns if it doesn't recognize the character.
↑DSPATC:
	CAIL	B,"a"		;lower case?
	SUBI	B,40		;YES, CONVERT TO UPPER
	CAIN	B,"Q"
	  JRST SETQT
	CAIN	B,"N"
	  JRST SETNUM
	CAIN	B,"L"
	  JRST SETLOG
	CAIN	B,"F"
	  JRST SETFL
	CAIN	B,"-"
  	  JRST SETMN
	CAIN	B,"B"
	  JRST	DEBUGA

	CAIE	B,12		;LF
	CAIN	B,15		;CR
	  JRST	GOTRY
	CAIE	B,"X"
	CAIN	B,"S"
	  JRST	GOTRY
	CAIE	B,"T"
	CAIN	B,"E"
	  JRST	GOTRY
	CAIE	B,"B"
	CAIN	B,"D"
	  JRST	GOTRY
	CAIE	B,"A"
	CAIN	B,"C"
	  JRST	GOTRY
	PUUO	3,[ASCIZ /ERROR MODES ARE: Q(QUIET), L OR F (LOGGING), N (NUMBERS).
PRECEDE A MODE LETTER BY - TO RESET THE MODE. ACTION RESPONSES ARE: <CR>(CONTINUE),
<LF>(AUTO CONT), D(DDT), B(DEBUGGER), E(SOS), T(TV EDITOR), X (EXIT), S(RESTART)/]
GOFLY:	AOS	(P)			;SKIP RETURN (SETMN ROLLS ITS OWN)
GOTRY:	SETZM	%MINUS
	POPJ	P,

;MORE SERVICE ROUTINES FOR MYERR
SETMN:	SETOM	%MINUS
	AOS	(P)
	POPJ	P,

SETNUM:	SKIPE	%MINUS
	SOSA	%NUMBS
	AOSA	%NUMBS
	JRST	GOFLY			;GO AWAY, HE DOESNOT WANT NUMBERS
	JRST	DOOVER
	
SETQT:	SKIPN	%MINUS
	AOSA	%QUIET
	SOSA	%QUIET
	JRST	GOFLY			;GO AWAY - HE WANTS QUIET
DOOVER:	PUSH	P,%LOGGIN		;SAVE
	SETZM	%LOGGIN
	PUSHJ	P,ERPRIN  		;PRINT AGAIN - DON'T BOTHER GETTING %ERFLGS
	POP	P,%LOGGIN		;RESTORE
	JRST	GOFLY			

SETFL:	RELEASE	LOG,0
	SETZM	%LOGGIN
	SKIPE	%MINUS
         JRST	GOFLY			;THE END (WAS A -F)
	PUSH	P,TTYTYI		;SPECIAL INCHWL KLUGE
	SETOM 	TTYTYI			;
	HRLZI	14,'LOG'		;
	MOVEM	14,EXTEN		;
	PUSHJ	P,FILNAM		;I HOPE THIS DOESN'T CLOBBER NAME... TOO BAD
	POP	P,TTYTYI		;
	SKIPE	NOFILE
	  JRST	[PUUO 3,[ASCIZ/INVALID FILE NAME SYNTAX
/]
	  JRST	GOFLY]
	JRST	SETLF

SETLOG:	RELEASE	LOG,0			;ALWAYS START WITH CLEAN SLATE
	SETZM	%LOGGIN
	SKIPE	%MINUS
	 JRST	GOFLY			;WAS A -L
	HRLZI	TEMP,'LOG'		;DEFAULT EXTENSION
	MOVEM	TEMP,EXTEN
	MOVE	TEMP,SRCPPN		;REDUNDANCY FOR REQUIRE...ERROR!MODES BENEFIT
	MOVEM	TEMP,PPN
	MOVE 	TEMP,SRCFIL
	MOVEM	TEMP,NAME
SETLF:	HRLZI	TEMP,'DSK'
	MOVEM	TEMP,LOGDEV		;
	MOVEI	SBITS2,LOGCDB		;READY TO OPEN LOG FILE
	PUSHJ	P,OPNUP			;OPEN SEZ ME!
	  JRST  [PUUO 	3,[ASCIZ /ERROR LOGGER: OPEN FAILURE
/]
		JRST GOFLY]
	  JRST  [PUUO 	3,[ASCIZ /ERROR LOGGER: ENTER FAILURE
/]
		JRST GOFLY]
	SETOM	%LOGGIN
	PUSH	P,%QUIET		;SAVE FLAGS
 	SETOM	%QUIET			;MAKE IT NOT PRINT
	PUSHJ	P,ERPRIN  		;PRINT AGAIN
	POP	P,%QUIET		;RESTORE FLAGS
	JRST	GOFLY

DEBUGA: 
IFN FTDEBUG <PUSHJ	P,INNA		;GO TO COMPILER DEBUGGER
>; FTDEBUG
	JRST	GOFLY
DSCR PRINT.
PAR A points to some asciz
SID none
DES prints the string given it, and logs it out if the
guy is enabled for that.
⊗

↑↑PRINT.:
	SKIPN	%QUIET
	 PUUO 	3,(A)		;PRINT THE MSG
	SKIPN	%LOGGIN	
	 POPJ	P,
	PUSH	P,B
	HRLI	A,(<POINT 7,0>)	;BYTE POINTER
 GG..:	ILDB	B,A		;GET BYTE
	JUMPE	B,MPOPJ		;END OF LINE
	SOSG	LOGCNT
	OUTPUT	LOG,
	IDPB	B,LOGPNT
	JRST	GG..
MPOPJ:	POP	P,B
      	POPJ	P,		;SUPER-DUPER ERROR RECOVERY, HUH?


ERPRIN:	
	MOVE	A,..STR		;GET MSG - ITS ALREADY ASCIZ!
	PUSHJ	P,PRINT.	;PRINT IT!
	PUSHJ	P,DSPLIN	;PRINT CURRENT LINE AND SUCH
	SKIPN	%NUMBS		;WANT NUMBERS?
	POPJ	P,
	MOVEI	A,[ASCIZ /CALLED FROM /]
	PUSHJ	P,PRINT.
	MOVE	B,..LOCA	;THE LOCATION
	SUBI	B,1
	PUSH	P,C
	PUSHJ	P,PRNT.
	POP	P,C
	MOVEI	A,CRLF..
	PUSHJ	P,PRINT.
	POPJ	P,

PRNT.:	IDIVI	B,10		;FAMOUS DEC RECURSIVE NUMBER PRINTER.
	IORI	C,"0"
	HRLM	C,(P)
	SKIPE	B
	PUSHJ	P,PRNT.
	HLRZ	C,(P)
	ROT	C,-7
	MOVEI	A,C
	PUSHJ	P,PRINT.
	POPJ	P,		

CRLF..: ASCIZ /
/
COMMENT ⊗Dsplin Routine for Displaying Input Line⊗

DSCR DSPLIN
PAR Line specs from compiler,
CAL PUSHJ
RES Types out current input line on tty, may log if that is on.
SID changes A,B,C,TEMP
⊗

↑DSPLIN: 
	SETZM	DLINBF
	MOVE	TEMP,[XWD DLINBF,DLINBF+1]
	BLT	TEMP,ENDDBF-1	;MAKE ALL DISPLAY BUFFER ASCID
	PUSH	P,PNEXTC	;SAVE BECAUSE MIGHT GRONK
	SKIPN	LSTCHR
	JRST	NOBAK
	REPEAT 4,<IBP PNEXTC
>
	SOS	PNEXTC
NOBAK:	PUSH	P,12		;SAVE TEMPORARILY
	PUSH	P,B
	MOVE	12,[POINT 7,DLINBF] ;OUTPUT POINTER, PRINSYM WANTS HERE
	MOVE	A,SRCFIL	;PRINT FILE NAME
	PUSHJ	P,PRINSYM	;WITH THIS ROUT
	MOVE	TEMP,12		;OUTPUT HERE FROM NOW ON
	POP	P,B
	POP	P,12
	MOVE	D,FPAGNO
	SETZM	BKR		;DENOTE 0 AS BREAK CHAR
	MOVE	A,[POINT 7,[ASCII /, PAGE /]]
	PUSHJ	P,ASCFIL	;TELL HIM WHAT IT IS
	PUSHJ	P,DECFIL	;STUFF PAGE NUM IN BUFFER
	MOVE	A,[POINT 7,[<BYTE (7) 15,12>]] ;MAKE SPACE
	PUSHJ	P,ASCFIL
	SETOM	BKR		;BREAK ON 0, 177, OR 12
	MOVE	A,[POINT 7,ASCLIN] ;PREPARE TO OUTPUT LINE NO.
	SKIPE	(A)
	PUSHJ	P,ASCFIL	;DO IT
	MOVE	A,[POINT 7,[ASCII /   /]]
	PUSHJ	P,ASCFIL
	MOVE	C,SCNWRD	;GET LIST CONTROL BITS
	TLNN	C,4000		;IN A MACRO?
	JRST	NOMAC		;NO
	HRRZ	C,DFSTRT
	MOVE	C,2(C)		;PNEXTC AT THAT TIME
	MOVEM	C,FILBP		;ARROW CONTROL
	MOVE	A,IPLINE	;WHERE IT ALL BEGAN
	PUSHJ	P,ASCFIL	;DO THE LINE
	SETZM	BKR		;TEMP
	MOVE	A,[POINT 7,[BYTE (7) 15,12,12]]
	PUSHJ	P,ASCFIL	;GO TO NEXT LINE
	SETOM	BKR
	MOVE	A,[POINT 7,[ASCIZ /        /]]
	SKIPE	ASCLIN		;IF PUT OUT LINE BEFORE,
	PUSHJ	P,ASCFIL	;MATCH IT
NOMAC:	MOVE	C,PNEXTC	;SAME FOR CURRENT LINE
	MOVEM	C,FILBP
	MOVE	A,PLINE
	PUSHJ	P,ASCFIL
	MOVEI	A,0
	IDPB	A,TEMP		;MAKE INTO ASCIZ
	SETZM	FILBP		;PRECAUTION
;;%AI% 11/10/73 KVL STANDARDIZE ERROR PRINTING
	MOVEI	A,DLINBF	;PRINT (AND/OR LOG) MESSAGE
	PUSHJ	P,PRINT.
;; %AI%
POPOP:	POP	P,PNEXTC	;GET REAL ONE BACK
	POPJ	P,

↑.CORERR:ERR	<NO CORE AVAILABLE>
COMMENT ⊗Interrupt Handler -- Intrpt, Povtrp⊗

DSCR POVTRP
CAL SYSTEM INTERRUPT
PAR JOBTPC is 1 past bad instr.
RES POVTAB(offending AC) is inspected for a string address.
  If it is there, the string is TTYOUTed as an error, indicating
  to the user which PDL oved. This is a fatal error message.
  Continuation is in general quite futile.
⊗
;;%AY% -- REWORK TO USE THE RUNTIME ROUTINES

;;#GH# DCS 2-1-72 (5-5) <ESC>I CAUSES PARSER TO BREAK AFTER NEXT SCAN
↑INTRPT:
NOEXPO <
;; RHT 2-12-73 INTMOD NOW DOES THE DISPATCH (%AY%)
;;	MOVE	TEMP,JOBCNI	;REASON
;;	TLNN	TEMP,INTTTI	;<ESC> I?
;;	 JRST	 POVDO		; NO, PDL OV
;; %AI% 11/10/73 KVL <ESC> I RESETS THE ERROR HANDLER
↑ITTYDO:
	SETZM	%QUIET
	SETZM	%ERGO		;MAKE THE NEXT ERROR VISIBLE
IFN FTDEBUG, <
	MOVE	TEMP,[XWD 400000,377777];INTERRUPT INDICATION
	SETZM	MULTP		;NOT IN MULTIPLE-PROCEED,
	MOVEM	  TEMP,.DBG.	;  IT IS GOING TO STOP
>;IFN FTDEBUG
	CALL6	DISMIS		; OR ELSE COULD JUST RETURN
↑POVDO:
EXTERNAL XJBTPC
	MOVE	LPSA,GOGTAB	;
	MOVE	TEMP,XJBTPC	;REAL TRAP LOCN
	MOVEM	TEMP,UUO1(LPSA)	;"RETURN"
	CALL6	(UWAIT)		;GET OUT OF MONITOR MODE, GET ACS
	CALL6	(DEBREAK)	;"JRST" .+1

>;NOEXPO
;;#GH# (5-5)
EXPO <
;; IN THIS CASE, MUST SIMULATE A DEBREAK.
↑POVDO:
	MOVE	LPSA,GOGTAB	;
	MOVE	TEMP,JOBTPC	;REAL TRAP LOCN
	MOVEM	TEMP,UUO1(LPSA)	;"RETURN"
	MOVEI	TEMP,POVTRP	;WHERE GO TO
	MOVEM	TEMP,JOBTPC	;
	POPJ	P,		;THIS "DISMISSES" US
>;EXPO
;;%AY% 
↑POVTRP: MOVEM	TEMP,PDLSV	;SAVE ACS
	MOVEM	LPSA,PDLSV1
;;#GM# DCS 2-6-72 (1-1) WAS WIPING OUT TEMP WITH MOVEW
	MOVE	LPSA,GOGTAB	;NOW RECORD WHERE IT HAPPENED FOR ERR MSG
;;%AY%	MOVEW	UUO1(LPSA),JOBTPC -- USED TO BE
	MOVE	TEMP,UUO1(LPSA)	;CAREFULLY SET UP ABOVE
	MOVEM	TEMP,JOBTPC	;SO CODE BELOW WORKS (A REAL HACK)
;;#GM# (1-1) TEMP STILL HOLDS JOBTPC
	LDB	TEMP,[POINT 4,-1(TEMP),12] ;HOW DID IT HAPPEN?
	ADDI	TEMP,17		;ADJUSTMENT
	ANDI	TEMP,17
	ROT	TEMP,-1		;GET INDEX TO HALF-WORDS, LOW BIT TO SIGN
	HRRZ	LPSA,POVTAB(TEMP) ;ASSUME ODD -- RIGHT HAND
	JUMPL	TEMP,.+2	;CORRECT
	HLRZ	LPSA,POVTAB(TEMP);EVEN -- WRONG
	JUMPN	LPSA,.+2	;WAS THERE A CLUE?
	MOVEI	LPSA,[ASCIZ /UNKNOWN STACK/]
	ERRPRI	<PUSH-DOWN OVERFLOW -- >	;TELL HIM SOME
	MOVE	TEMP,PDLSV
	EXCH	LPSA,PDLSV1		;RESTORE ACS
	ERR.	@PDLSV1			;TELL HIM MORE
	JRST	2,@JOBTPC		;IF HE SOMEHOW CONTINUES
BEND

	USE	ZVBLS
↑ZZZ←←.
	USE	VBLS
↑VVV←←.
	USE
↑↑ZHI:	ZZZ
↑↑VHI:	VVV
BEND	SAIL		;WOW
	PATCH:	BLOCK 50
	VAR
	XLIST
	END	START