Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	SEARCH	FORPRM
	TV	FORERR	ERROR HANDLER,7(3260)

;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1981, 1983

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.

;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.

;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

COMMENT \

***** Begin Revision History *****

1100	CKS	13-Jun-79
	New

1403	DAW	6-Apr-81
	Get rid of magic JOBDAT numbers that prevents users
	from loading FOROTS at places other than 400K.

1437	DAW	17-Apr-81
	Change FILOP error code 12 from "No such device" to "Can't OPEN
	device"-- open of LPT could cause this.

1464	DAW	21-May-81
	Put all "ERR" and "IOERR" messages in this file.

1473	CKS	21-May-81
	Many error message fixes.

1504	BL	1-Jun-81	Q10-06141
	Prevent TRACEBACK default call from displaying itself.

1532	DAW	14-Jul-81
	OPEN rewrite: Base level 1

1533	DAW	14-Jul-81
	Errors that were supposed to print input record didn't.
	Also they would mess up the error message text for ERRSNS.

1537	DAW	16-Jul-81
	More work on OPEN for TOPS-20.

1560	DAW	28-Jul-81
	OPEN rewrite: Base level 2

1573	DAW	31-Jul-81
	Eliminate typing random CRLF's when ERR= branch taken.

1603	DAW	12-Aug-81
	Don't type statement name more than once if many IOERR's
	are done.

1611	DAW	17-Aug-81
	"%integer overflow" bombed out pgm instead of continuing..

1624	DAW	21-Aug-81
	"?Illegal record number" got record number from wrong ac.

1625	DAW	21-Aug-81
	Get rid of "DF".

1630	JLC	24-Aug-81
	Illegal magtape OP's now illegal.

1642	JLC	27-Aug-81
	Replace %FILOP calls with FILOPs.

1645	DAW	28-Aug-81
	Get to column 1 before errors on TOPS-10.

1651	DAW	31-Aug-81
	Do TRMOP. function to wait for output done before getting HPOS.
	 (Fix to 1645).

1652	DAW	1-Sep-81
	Make "IOE" a "?" error.

1656	DAW	2-Sep-81
	Get rid of magic numbers.

1661	BL	4-Sep-81
	Fix incorrect info coming from TRACE; & illegal instruction return.

1662	DAW	4-SEP-81
	%CALU; user error handling routine.

1665	DAW	8-Sep-81
	D.TTY hack.

1706	DAW	11-Sep-81
	Lots of changes to error messages, codes, etc.

1725	DAW	18-Sep-81
	Better error reporting in OPEN args & dialog strings.

1737	DAW	23-Sep-81
	Fix "RBR" error.

1753	DAW	29-Sep-81
	IOERR's and LERR's to type the PC.

1760	JLC	5-Oct-81
	Print 2 decimal places for time typouts.

1762	DAW	6-Oct-81	Q10-06581
	Don't print format with error in wrong place.

1763	DAW	7-Oct-81
	Fatal error "?Can't write to LINED file".

1766	DAW	7-Oct-81
	Don't type PC flags as part of the PC.

1773	DAW	8-Oct-81
	Change "CMU" to "IEM" - internal error in mem. management.

1774	DAW	8-Oct-81
	Change message for FILOP. code 52 to "Device is assigned by
	another job".

2003	BL	14-Oct-81	Q10-06574
	Change data type "0" from "U" to "I".

2013	DAW	19-Oct-81
	Fix TRACE to store "..." at end of string, not into a literal.

2022	DAW	22-Oct-81
	Better error message for TOPS-20 when the JFNs run out.

2031	DAW	27-Oct-81
	Fix smashing of AC if no symbols loaded.

***** Begin Version 7 *****

3035	JLC	5-Feb-82
	Add error messages for new binary code. Combine
	error message for ordinary I/O and ENCODE/DECODE.

3037	JLC	11-Feb-82
	Add new error msg for dump mode IO list too long.
	Removed non-fatal error messages for magtape.

3056	JLC	23-Mar-82
	Separated error messages from FORERR into FORMSG.MAC.
	Fixed error buffer typeout so it doesn't trash the FOROTS
	data area if the record is very long. Make TRACE work
	in extended sections.

3122	JLC	28-May-82
	Rework of error entry. Moved %IOERR into FORERR. Rework
	of calling user program.

3125	JLC	3-May-82
	Moved the error character to the beginning of the error macros.

3136	JLC	26-Jun-82
	Separated the 2nd error number from the type code in the
	trap subroutine block.

3140	JLC	2-Jul-82
	Get proper PC for $P in extended sections.

3141	JLC	2-Jul-82
	Fix to edit 3140.

3147	AHM	8-Jul-82
	Fix GETPC so that it doesn't  die trying to evaluate the  jump
	address of PUSHJs and overlay calls.  Merely setting the  sign
	bit on  a  word  that  has  bit  1  set  (such  as  the  PUSHJ
	instruction) resulted in a type 3 indirect word that causes an
	ill mem ref.  Bit 0 must be set and bit 1 must be cleared.

3151	AHM	13-Jul-82
	Add a whole new ADRCHK for Tops-20 that decides whether or not
	a PC  is  believable  by  checking whether  it  refers  to  an
	existing section.  Also, preserve section numbers in GETPC.

3155	AHM	19-Jul-82
	Remove a  lot of  code that  discards section  numbers  around
	ADDPCM, TRACEL and SYMSRH.  Also, make ADRCHK punt on  section
	numbers that are greater than 37.

3161	JLC	16-Aug-82
	Added $R, to print out a record number from CREC(D).

3162	AHM	23-Aug-82
	Make the  Tops-20  ADRCHK  light  FH%EPR  when  running  in  a
	non-zero section so that addresses getting checked don't  have
	section 0 interpreted as "our section".

3165	JLC	28-Aug-82
	Fix error record typout by rewriting it.

3166	JLC	31-Aug-82
	Eliminate ER2PTR ref, fix SYMSRH so it doesn't need XHLLI,
	which isn't defined on the -10.

3172	JLC	2-Sep-82
	Fix code at NERR1 to get proper PDP to use for NOSYM. Fix
	NOSYM so it wasn't fooled by T2 pointing to MAIN. if no
	stuff on stack.

3175	JLC	8-Sep-82
	Fix $I to get the error bits from the right place.

3176	JLC	9-Sep-82
	Installed disk quota exceeded trap.

3200	JLC	24-Sep-82
	Save ACs in 3 separate local areas instead of on the stack,
	to avoid problems with global stacks. Fix I/O within I/O,
	that is, used A.UNIT instead of UNUM(U) to type the unit
	number in the fatal message.

3201	JLC	4-Oct-82
	Add kluge to prevent tracing arg lists of MTHCPX routines which
	don't have an arglist.

3202	JLC	26-Oct-82
	Fix AC save routines so they don't use the stack, so that
	non-zero section stacks are TRACEable.

3216	JLC	16-Nov-82
	Restore the ERSTKP on ERR= and IOSTAT=.

3217	PLB	17-Nov-82
	Change ADRCHK to check %FSECT to get FOROTS section.

3225	JLC	24-Nov-82
	Type nulls in records and FORMATs as spaces. Fix TRACE for
	calls from APR traps.

3231	JLC	14-Dec-82
	Fix GETPC for multiple sections of code, allow indexed PUSHJs
	and indexed and indirected XMOVEIs.

3240	JLC	20-Dec-82
	Fix TRACE called from a user program - was using last stored
	trace stack.

3250	JLC	7-Jan-83
	Use SVEACS for TRACE instead of %SAVAC, so user can trace
	from ERRSET subroutine on I/O warnings.

3252	JLC	12-Jan-83
	Fix RENAME error msg reporting, by making $F get an argument,
	supplied in the error msg macro.

3253	JLC	14-Jan-83
	Fix TRACE so it saves and restores the GETPC return PC.

3260	JLC	17-Jan-83
	Fix library error reporting with no symbols so that positive
	PC offsets get out. Fix TRACE not to print PCs on every line
	if it is the ERRSET routine.

***** End Revision History *****

\

	ENTRY	%ERINI,%TRACX,%IOERR,%OTSER,%TRPER
	EXTERN	%UDBAD,%RNAMD,%RNAMU,%FSECT,I.BAT,%PC1,%ABORT,I.XSIR
	EXTERN	%SETAV,%FREBL,%EOREC,%HALT,%SAVAC,%CIPOS
	EXTERN	E.NAM
	EXTERN	%SAVE1,%SAVE2,%SAVE3,AU.ACS
	EXTERN	%ERRCT,%ERRLM,%ERRSB,%ERRSZ,%ERRBK,%NAMLN
	EXTERN	%POPJ,%POPJ1
	EXTERN	%STADD
	EXTERN	%RIPOS,%SIPOS,%IBYTE
	EXTERN	FMT.BP,FMT.BG,FMT.SZ,USR.SZ
	EXTERN	A.END,A.ERR,A.IOS,%CUNIT
	EXTERN	%FSECT	;FOROTS section,,0
IF10,<
	EXTERN	%NCHRR	;# chars parsed in string
	EXTERN	%SRCBP	;Current BP to source string containing error.
	EXTERN	%MSLVL
>;END IF10

	INTERN	%ERNM1,%ERNM2,%UNFXD,%FIXED,%ERTYP,%ERPDP,%ERRPC,%ERCHR
	INTERN	%DFERR,%ERNAM,%LERN1,%LERN2,%TRPDP


	SEGMENT	CODE

IF10,<
%DFERR:	$SNH		;NO DISK-FULL HANDLER NEEDED ON TOPS-10
>

IF20,<
;DISK FULL ERROR HANDLER
;GETS HERE VIA THE SOFWARE INTERRUPT SYSTEM IF THE USER HAS NOT
;STOLEN THE CHANNEL FROM FOROTS. TREATED LIKE ANY OTHER I/O ERROR,
;EXCEPT THAT IF THE PROCESS IS INTERACTIVE, IT DOES A HALTF% TO
;LET THE USER EXPUNGE OR OTHERWISE CLEAN UP THE DISK, AND THEN,
;IF CONTINUED, WILL DEBRK% TO CONTINUE THE PROCESS. IF THE PROCESS
;IS BATCH, WE JUST JUMP OFF TO %ABORT TO CLOSE ALL FILES.
;FOR THE ERR= AND IOSTAT= CASE, IT IS COMPLICATED BY THE FACT
;THAT WE MUST DO A DEBRK%, BUT WE DO NOT WANT TO CONTINUE
;THE PROCESS AT THE INTERRUPTED LOCATION, SO WE MUST SUBSTITUTE
;THE ERR= OR (FOR IOSTAT WITH OLDER .REL FILES) THE RETURN ADDRESS
;FROM THE FOROTS CALL FOR THE INTERRUPT ADDRESS.
%DFERR:	SKIPE	I.BAT		;BATCH JOB?
	 JRST	SETDBK		;YES. DEBREAK AND HANDLE ERR= OR ABORT
	SKIPN	A.ERR		;ERR= OR IOSTAT= SPECIFIED?
	 SKIPE	A.IOS
	  JRST	SETDBK		;YES. SET DEBREAK ADDRESS TO ERROR HANDLER
	$ECALL	DQE		;NO. PRINT DISK QUOTA EXCEEDED MESSAGE
	$ECALL	ETC		;TELL USER TO EXPUNGE AND CONTINUE
	HALTF%			;HALT THE PROCESS
	DEBRK%			;CONTINUE THE PROCESS IF CONTINUED

SETDBK:	PUSH	P,T1		;SAVE T1 VERY TEMPORARILY
	XMOVEI	T1,DFDBK	;SET DEBREAK ADDRESS HERE
	SKIPN	I.XSIR		;USING EXTENDED PSI TABLE?
	 JRST	STDBS0		;NO
	MOVEM	T1,%PC1+1
	POP	P,T1		;RESTORE T1
	DEBRK%

STDBS0:	HRRM	T1,%PC1		;STORE PC
	POP	P,T1		;RESTORE T1
	DEBRK%			;AND DEBREAK

DFDBK:	$ECALL	DQE,%ABORT	;AND PRINT ERROR MESSAGE AND DIE
> ;END IF20

;HERE FROM ERROR MACROS
;
;CALLS:
;
;	$ERR	(CHR,COD,N1,N2,MSG,ARGS,FLGS)	;FOROTS ERROR OR PROMPT LINE
;	$IOERR	(CHR,COD,N1,N2,MSG,ARGS,FLGS)	;I/O ERROR
;	$LERR	(CHR,COD,N1,N2,MSG,ARGS,FLGS)	;MATHLIB ERROR
;	$FERR	(CHR,COD,N1,N2,MSG,ARGS,FLGS)	;FORLIB ERROR
;	$TERR	(CHR,COD,N1,N2,MSG,ARGS,FLGS)	;APR TRAP CALL
;
;CHR	INITIAL CHAR FOR ERROR MESSAGE ([, %, ?)
;	IF [, MESSAGE IS TERMINATED WITH ]
;	IF ?, TYPEAHEAD CLEARED AFTER MESSAGE
;	IF NULL, 3-CHAR PREFIX ISN'T TYPED
;	IF $, FIRST ARG IS INITIAL CHAR
;COD	3-CHARACTER PREFIX
;N1	ERROR CLASS NUMBER
;N2	2ND ERROR NUMBER
;MSG	TEXT OF ERROR MESSAGE
;	$ INDICATES AN ARG TO BE SUBSTITUTED INTO THE MESSAGE
;	THE CHAR AFTER THE $ GIVES THE FORMAT OF THE SUBSTITUTION
;ARGS	LIST OF ARGUMENT ADDRESSES, ONE-TO-ONE CORRESPONDENCE WITH $S
;	IN MESSAGE TEXT
;FLGS	ERROR FLAGS
;
;THE ERROR MACROS GENERATE 1 WORD IN LINE, SO CAN BE SKIPPED OVER.
;THEY DO NOT ALTER ANY ACS.

%ERINI:	XMOVEI	T1,ERRSTK	;SETUP ERROR STACK
	MOVEM	T1,ERSTKP
	POPJ	P,

%IOERR:	POP	P,IOERP		;SAVE ARG POINTER
	PUSHJ	P,SVEACS	;SAVE THE ACS ON THE ERROR STACK
	MOVE	P2,IOERP	;GET ARG POINTER
	MOVEM	P2,%ERPTR	;SAVE FOR COMMON ROUTINES
	MOVE	T2,%NUM1(P2)	;GET ERROR CLASS NUMBER
	MOVEM	T2,%ERNM1	;SAVE ERROR CLASS NUMBER
	MOVEM	T2,%LERN1	;ALSO SAVE IT SEMI-PERMANENTLY
	MOVE	T2,%NUM2(P2)	;GET 2ND ERROR NUMBER
	MOVEM	T2,%ERNM2	;SAVE 2ND ERROR NUMBER
	MOVEM	T2,%LERN2	;ALSO SAVE IT SEMI-PERMANENTLY
	XMOVEI	T1,%ARGS-1(P2)	;GET ARGUMENT POINTER
	MOVEM	T1,ARGPTR	;SAVE IT
	MOVE	T1,%CHR(P2)	;GET CHARACTER
	CAIN	T1,"$"		;CHARACTER IN ARGUMENT?
	 PUSHJ	P,GETARG	;YES. GET IT
	MOVEM	T1,%ERCHR	;SAVE IT FOR MESSAGE

;Iff this is a "?" error, do the ERR= or END= stuff

	CAIE	T1,"?"		;"?" says take ERR= if we can.
	 JRST	NERR1		;Not fatal, just go type message

;Fatal error. Clear %UDBAD
; This is so all the IOLST. calls that follow an IO call that gets
; a fatal error will not screw up things any more.


	SKIPGE	%ERNM2		;EOF?
	 SKIPN	T1,A.END	;Yes, use END= address not ERR=
				;But if no END= specified, use ERR=
	MOVE	T1,A.ERR	;Get ERR= Address
	JUMPE	T1,NERR		;IF ANY

;Take END= or ERR= branch.
;Address of where to go is in T1.
;T2 contains the error number

	MOVE	P,AU.ACS	;GET ADDR OF USER'S ACS
	MOVE	P,P(P)		;GET THE OLD STACK
	MOVEM	T1,(P)		;Store return address
	ADJSP	P,1		;WE NEED OUR ACS BACK
	PUSHJ	P,%EMSGT	;Get error message text for ERSNS.
	PUSHJ	P,DEALCB	;Deallocate RENAMD, RENAMU if necessary
	PUSHJ	P,FXTRET	;FIXUP STUFF TO RETURN
	MOVE	T2,%ERNM2	;GET 2ND ERROR NUMBER
	SKIPE	T1,A.IOS	;Any IOSTAT=?
	 MOVEM	T2,(T1)		;Yes, store it
	MOVNI	T1,20		;ADJUST ERROR STACK POINTER
	ADDM	T1,ERSTKP	;TOSS THE SAVED FOROTS ACS
	POPJ	P,		;RETURN TO USER PROGRAM

;No END= or ERR= specified

NERR:	SKIPN	A.IOS		;How about IOSTAT=?
	 JRST	NERR1		;No

;Return to next statement in the program.

	PUSHJ	P,%EMSGT	;Get error message text for ERRSNS.
	PUSHJ	P,DEALCB	;Deallocate RENAMD, RENAMU if necessary
	PUSHJ	P,FXTRET	;Fixup stuff to return
	MOVE	P,AU.ACS	;GET ADDR OF USER'S ACS
	MOVE	P,P(P)		;RESET STACK
	ADJSP	P,1		; Fix so we get our acs back
	MOVE	T2,%ERNM2	;GET 2ND ERROR NUMBER
	MOVEM	T2,@A.IOS	;STORE IN IOSTAT VARIABLE
	MOVNI	T1,20		;ADJUST ERROR STACK POINTER
	ADDM	T1,ERSTKP	;TOSS THE SAVED FOROTS ACS
	POPJ	P,		;Return to next statement in pgm.

;Routine to fixup stuff to return from IO error.

FXTRET:	SKIPN	%UDBAD		;ANY DDB ALLOCATED?
	 POPJ	P,		;No. Don't deallocate
	TXNE	F,F%DCU		;Deallocate "D" and "U"?
	 PUSHJ	P,FXTRTD	;Yes, do that
FXTRT1:	PJRST	%SETAV		;Set associate-variable and return

;Deallocate "U" and "D" before returning.

FXTRTD:	MOVEI	T1,(U)		;Get address of "U"
	PUSHJ	P,%FREBLK	;Free it
	MOVEI	T1,(D)		;Get address of "D"
	PJRST	%FREBLK		;Free it and return

;Deallocate %RNAMD, %RNAMU if necessary
; having this routine here greatly simplifies error handling in CLOSE.

DEALCB:	SKIPN	T1,%RNAMD
	 POPJ	P,		;Not necessary
	PUSHJ	P,%FREBLK
	MOVE	T1,%RNAMU
	PJRST	%FREBLK		;Deallocate and return

;Print out the error.

NERR1:	MOVE	P1,AU.ACS	;GET ADDR OF USER'S ACS
	MOVE	P1,P(P1)	;GET USER'S STACK PNTR
	MOVEM	P1,%TRPDP	;SAVE FOR TRACE
	PUSHJ	P,GETPC		;GET CALLER, CALLED ADDR
	MOVEM	P1,%ERPDP	;SAVE NEXT STACK IN CASE NO SYMBOLS
	MOVEM	T1,%ERRPC	;SAVE PC OF CALL

	SETZM	MSGPC		;ASSUME NO PC DESIRED IN MESSAGE
	PUSHJ	P,%CHKEL	;CHECK IF WE SHOULD PRINT MESSAGE
	 JRST	CALRET		;DON'T
	SKIPE	%NAMLN		;NAME LINE ALREADY OUT?
	 JRST	NOPFL		;YES, SKIP I/O NAME LINE

	MOVE	T1,%ERRPC	;GET ERROR PC
	MOVEM	T1,MSGPC	;SAVE IT FOR MESSAGE

	XMOVEI	T2,E.NAM+%EOFF	;POINT TO MESSAGE DESIRED
	MOVEM	T2,%ERPTR	;SAVE POINTER
	PUSHJ	P,FOREC		;OUTPUT IT
	SETZM	MSGPC		;NO PC PRINTOUT ON SUBSEQUENT LINES
	MOVE	T1,IOERP	;GET ORIGINAL POINTER BACK
	MOVEM	T1,%ERPTR	;SAVE POINTER
	SETOM	%NAMLN		;SET FLAG SO WE DON'T GET NAME LINE AGAIN
NOPFL:	PUSHJ	P,FOREC		;OUTPUT THE MESSAGE
	PJRST	CALRET		;CALL USER ROUTINE, RESTORE ACS, RETURN

%TRPER:	POP	P,%ERPTR	;GET ERROR BLOCK POINTER
	PUSHJ	P,SVEACS	;SAVE THE ACS ON THE ERROR STACK
	MOVE	T1,%ERPDP	;GET USER'S PDP
	MOVEM	T1,%TRPDP	;SAVE FOR TRACE
	MOVE	T1,%ERRPC	;GET ERROR PC
	MOVEM	T1,MSGPC	;SAVE FOR MESSAGE
	MOVE	T1,%ERPTR	;GET ERROR BLOCK POINTER
	MOVE	T2,%NUM1(T1)	;GET ERROR CLASS NUMBER
	MOVEM	T2,%ERNM1	;SAVE ERROR CLASS NUMBER
	MOVE	T2,%NUM2(T1)	;GET 2ND ERROR NUMBER
	MOVEM	T2,%ERNM2	;SAVE 2ND ERROR NUMBER
	PUSHJ	P,%CHKEL	;CHECK IF WE WANT MESSAGE
	 JRST	CALRET		;WE DON'T
	PUSHJ	P,FOREC		;OUTPUT THE MESSAGE
	PJRST	CALRET		;CALL USER ROUTINE, RESTORE ACS, RETURN

%OTSER:	POP	P,%ERPTR	;GET ERROR BLOCK POINTER
	MOVEM	P,%ERPDP	;SAVE CALLER ADDR FOR MSG
	PUSHJ	P,SVEACS	;SAVE ACS
	MOVE	T1,AU.ACS	;GET ADDR OF USER'S ACS
	MOVE	T1,P(T1)	;GET USER'S STACK PNTR
	MOVEM	T1,%TRPDP	;SAVE FOR TRACE
	MOVE	T1,%ERPTR	;GET ERROR BLOCK POINTER
	MOVE	T2,%NUM1(T1)	;GET ERROR CLASS NUMBER
	MOVEM	T2,%ERNM1	;SAVE ERROR CLASS NUMBER
	MOVE	T2,%NUM2(T1)	;GET 2ND ERROR NUMBER
	MOVEM	T2,%ERNM2	;SAVE 2ND ERROR NUMBER
	SETZM	%ERRPC		;NO PC TO GIVE
	SETZM	MSGPC		;DON'T PRINT PC IN GENERAL
	PUSHJ	P,%CHKEL	;CHECK IF WE WANT MESSAGE
	 JRST	CALRET		;WE DON'T
	PUSHJ	P,FOREC		;OUTPUT MESSAGE
	PJRST	CALRET		;RESTORE ACS, RETURN

	FENTRY	(MTHER,FORER)
	POP	P,%ERPTR	;SAVE ERROR BLOCK POINTER
	MOVEM	P,%TRPDP	;SAVE PDP FOR TRACE
	PUSHJ	P,SVEACS	;SAVE ACS ON STACK
	MOVE	T1,%ERPTR	;GET ERROR BLOCK POINTER
	MOVE	T2,%NUM1(T1)	;GET ERROR CLASS NUMBER
	MOVEM	T2,%ERNM1	;SAVE ERROR CLASS NUMBER
	MOVE	T2,%NUM2(T1)	;GET 2ND ERROR NUMBER
	MOVEM	T2,%ERNM2	;SAVE 2ND ERROR NUMBER
	MOVE	P1,%TRPDP	;GET ERROR STACK PNTR AGAIN
	PUSHJ	P,GETPC		;GET CALLER ADDR
	MOVEM	T1,%ERRPC	;SAVE IT
	MOVEM	T1,MSGPC	;SAVE FOR MESSAGE
	MOVE	T1,-1(T2)	;GET NAME OF LIBRARY ROUTINE
	MOVEM	T1,%ERNAM	;SAVE FOR MESSAGE
	MOVEM	P1,%ERPDP	;SAVE USER'S STACK PNTR
	PUSHJ	P,%CHKEL	;CHECK IF WE WANT MESSAGE
	 JRST	CALRET		;WE DON'T
	PUSHJ	P,FOREC		;OUTPUT MESSAGE

CALRET:	PUSHJ	P,ECALU		;CALL USER SUBROUTINE
	PUSHJ	P,ECALB		;CALL DEBUGGER BREAK IF ANY
	MOVNI	T1,20		;DROP THE ERROR STACK POINTER
	ADDM	T1,ERSTKP	;A BLOCK OF ACS
	HRLZ	16,ERSTKP	;RESTORE ACS
	BLT	16,16
	POPJ	P,

FOREC:	MOVE	P2,%ERPTR	;POINT TO ERROR BLOCK
	PUSHJ	P,EMSGT0	;Get error message text
	SKIPE	MSGPC		;PC TO PRINT?
	 PUSHJ	P,ADDPCM	;YES. Add PC to message text.
	PUSHJ	P,EMSGT1	;Append null to string so can output msg.

	MOVEI	T1,ERRBUF	;POINT TO MESSAGE
	HRLI	T1,(POINT 7)
	PUSHJ	P,%EOREC	;TYPE MESSAGE

	MOVE	T1,%FLGS(P2)	;GET FLAGS
	TXNE	T1,I%REC	;TYPE RECORD WITH ARROW UNDER IT IF REQUESTED
	 JRST	RECTYP
	TXNE	T1,I%REC1	;TYPE RECORD WITH ARROW MOVED back 1
	 JRST	RCTYB1
	TXNE	T1,I%FMT	;TYPE FORMAT WITH ARROW UNDER IT
	 JRST	FMTTYP
IF10,<
	TXNE	T1,I%TCH	;Type character string in error?
	 JRST	CHSTYP
>;END IF10
	MOVE	T1,INICHR	;GET THE INITIAL CHAR AGAIN
	CAIN	T1,"@"		;WAS IT REALLY BAD?
	 JRST	%HALT		;YES. STOP EVERYTHING
	POPJ	P,

%CHKEL:	MOVE	T1,%ERPTR	;GET ERROR BLOCK POINTER
	MOVE	T2,%NUM1(T1)	;GET 1ST ERROR NUMBER
	JUMPL	T2,%POPJ1	;IF NEGATIVE, DON'T CHECK LIMITS
	CAIL	T2,%ERRSZ	;WITHIN ERROR TABLE?
	 JRST	%POPJ1		;NO. DON'T CHECK ANYTHING
	AOS	%ERRCT(T2)	;INCREMENT LIBRARY ERROR COUNT
	MOVE	T3,%CHR(T1)	;GET INITIAL CHARACTER
	CAIN	T3,"?"		;FATAL ERROR?
	 JRST	%POPJ1		;YES. DON'T CHECK LIMITS
	MOVE	T3,%ERRCT(T2)	;GET # ERRORS SO FAR
	CAMG	T3,%ERRLM(T2)	;PAST LIMIT?
	 AOS	(P)		;NO. SKIP RETURN
	POPJ	P,

ECALB:	SKIPN	P1,%ERRBK	;GET BREAK ADDR
	 POPJ	P,		;NONE
	MOVE	T1,%ERNM1	;GET ERROR CLASS #
	MOVEM	T1,%EARG1	;SAVE IT
	MOVE	T1,%ERRPC	;GET PC
	MOVEM	T1,%EARG2	;SAVE IT
	MOVE	T1,%ERNM2	;GET 2ND ERROR NUMBER
	MOVEM	T1,%EARG3	;SAVE IT
	XMOVEI	L,%EARGL	;POINT TO ARGLST
	PJRST	(P1)		;** Call user routine **

ECALU:	SKIPGE	T1,%ERNM1	;GET ERROR CLASS, NO SUBR IF NEGATIVE
	 POPJ	P,
	CAIGE	T1,%ERRSZ	;WITHIN TABLE?
	 SKIPN	P1,%ERRSB(T1)	;YES. ANY USER TRAP ROUTINE SPECIFIED?
	  POPJ	P,		;NO. RETURN
	MOVEM	T1,%EARG1	;SAVE IT
	MOVE	T1,%ERRPC	;GET PC
	MOVEM	T1,%EARG2	;SAVE IT
	MOVE	T1,%ERNM2	;GET 2ND ERROR NUMBER
	MOVEM	T1,%EARG3	;SAVE IT

DOCALU:	XMOVEI	L,%EARGL	;POINT TO ARGLST
	PJRST	(P1)		;** Call user routine **

	-4,,0
%EARGL:	IFIW	TP%INT,%EARG1
	IFIW	TP%INT,%EARG2
	IFIW	TP%INT,%EARG3
	IFIW	TP%INT,%ERTYP
	IFIW	TP%UDF,%UNFXD
	IFIW	TP%UDF,%FIXED

SEGMENT	DATA

ERSTKP:	BLOCK	1		;ERROR AC STACK POINTER
ERRSTK:	BLOCK	60		;ERROR AC STACK
MSGPC:	BLOCK	1		;PC FOR MESSAGE
AERACS:	BLOCK	1		;ADDRESS OF SAVED ACS
IOERP:	BLOCK	1		;IOERR PNTR SAVE LOC

;ARGS FOR USER ROUTINE
%EARG1:	BLOCK	1		;ERROR CLASS NUMBER
%EARG2:	BLOCK	1		;PC
%EARG3:	BLOCK	1		;ERROR 2ND NUMBER
%ERTYP:	BLOCK	1		;VARIABLE TYPE
%UNFXD:	BLOCK	4		;UNFIXED RESULT
%FIXED:	BLOCK	4		;FIXED RESULT

%LERN1:	BLOCK	1		;ERROR CLASS NUMBER, NOT CLEARED
%LERN2:	BLOCK	1		;2ND ERROR NUMBER, NOT CLEARED
%ERNM1:	BLOCK	1		;ERROR CLASS NUMBER
%ERNM2:	BLOCK	1		;2ND ERROR NUMBER
%ERNAM:	BLOCK	1		;ROUTINE NAME FOR MESSAGE
%ERRPC:	BLOCK	1		;PC TO TYPE
%ERPTR:	BLOCK	1		;POINTER TO ERROR BLOCK
%ERPDP:	BLOCK	1		;STACK POINTER FOR GETPC, NOSYM
%ERCHR:	BLOCK	1		;ERROR CHAR FOR I/O ERRORS
%TRPDP:	BLOCK	1		;PDP FOR TRACE

	SEGMENT	CODE

;Routine to save the acs
;Call:	PUSHJ	P,SVEACS
;	<return here>
SVEACS:	DMOVEM	0,@ERSTKP	;SAVE 0 AND 1
	MOVE	1,ERSTKP	;GET BASE OF SAVED ACS
	MOVEM	1,AERACS	;SAVE FOR MSG
	MOVEI	0,(1)		;SETUP FOR BLT
	ADD	0,[2,,2]	;SAVE 2-17
	BLT	0,17(1)
	MOVEI	0,20		;AND ADJUST THE ERROR STACK
	ADDM	0,ERSTKP
	POPJ	P,

;%EMSGT - Get error message text in ERRBUF.
; This routine just sets it up, it does not type it.
; (In case of taking the ERR= branch you don't want to!).
;Input:
;P2 points to error arg block.

%EMSGT:	PUSHJ	P,EMSGT0	;Get message text with no null

;Enter here to append null to error string

EMSGT1:	MOVE	T1,INICHR	;GET INITIAL CHAR AGAIN
	CAIE	T1,"["		;OPEN BRACKET?
	 JRST	EMSNUL		;NO. GO INSERT NULL
	MOVEI	T1,"]"		;YES, TYPE CLOSING BRACKET
	PUSHJ	P,EPUTCH
EMSNUL:	SETZ	T1,		;And store a null
	IDPB	T1,ERRPTR
	POPJ	P,		;Return

EMSGT0:	MOVE	P3,%MSG(P2)	;MAKE POINTER TO INPUT ERROR STRING

	MOVE	T1,[POINT 7,ERRBUF] ;SET POINTER TO START OF OUTPUT ERR STRING
	MOVEM	T1,ERRPTR
	MOVEI	T1,5*LERRBF-1	;SET COUNT (LEAVE SPACE FOR A NULL)
	MOVEM	T1,ERRCNT

	XMOVEI	T1,%ARGS-1(P2)	;GET ARG POINTER
	MOVEM	T1,ARGPTR

	MOVE	T1,%CHR(P2)	;GET INITIAL CHAR
	CAIN	T1,"$"		;INDIRECT CHAR?
	  PUSHJ	P,GETARG	;YES, GET PREFIX CHAR
	MOVEM	T1,INICHR	;SAVE IT
	CAIN	T1,"@"		;IS IT REALLY BAD?
	 MOVEI	T1,"?"		;YES. SUBSTITUTE A QUERY
	PUSHJ	P,TYPEQM	;Type it.

ENXTCH:	ILDB	T1,P3		;GET NEXT CHAR FROM MSG
	JUMPE	T1,%POPJ	;END. WE'RE DONE
	CAIE	T1,"$"		;SPECIAL CHAR?
	  JRST	ECHR		;NO, JUST NORMAL TEXT CHAR

	SETZ	T2,		;CLEAR ARG
ERARGL:	ILDB	T1,P3		;GET CHAR AFTER $
	CAIL	T1,"0"		;DIGIT?
	CAILE	T1,"9"
	  JRST	ERRCMD		;NO, GO EXECUTE COMMAND CHAR
	IMULI	T2,^D10		;ADD DIGIT INTO ARGUMENT
	ADDI	T2,-"0"(T1)
	JRST	ERARGL		;GO FINISH ARG

ERRCMD:	MOVEM	T2,ERRARG	;SAVE ARGUMENT TO COMMAND
	MOVSI	T2,-LERRTB	;GET AOBJN POINTER TO ERR TABLE
ERTBLP:	HLRZ	T3,ERRTAB(T2)	;GET CHAR
	CAIE	T1,(T3)		;MATCH?
	  AOBJN	T2,ERTBLP	;NO, KEEP LOOKING
	JUMPGE	T2,ENXTCH	;NOT FOUND, IGNORE
	HRRZ	T2,ERRTAB(T2)	;GET ROUTINE ADDRESS
	PUSHJ	P,(T2)		;CALL ROUTINE
	JRST	ENXTCH		;LOOP

ECHR:	PUSHJ	P,EPUTCH	;PUT CHAR IN OUTPUT STRING
	JRST	ENXTCH		;LOOP

;TABLE OF SPECIAL CHAR ACTIONS IN MESSAGES

ERRTAB:	XWD	"$",$$		;TYPE $
	XWD	"[",$LAB	;TYPE LEFT ANGLE BRACKET
	XWD	"O",$O		;OCTAL NUMBER
	XWD	"D",$D		;DECIMAL NUMBER
	XWD	"A",$A		;ASCIZ STRING
	XWD	"C",$C		;ASCII CHAR, RIGHT-JUSTIFIED
	XWD	"S",$S		;SIXBIT WORD
	XWD	"R",$R		;RECORD NUMBER
	XWD	"L",$L		;TYPE VALUE AS SYMBOL+OFFSET
	XWD	"N",$N		;NAME OF ROUTINE (SIXBIT) FROM %ERNAM [NO ARG]
	XWD	"X",$X		;XWD FORMAT, OCTAL
	XWD	"5",$5		;RADIX50 WORD
	XWD	"T",$T		;SPACES TO GET TO COL N
IF20,<	XWD	"J",$J >	;JSYS ERROR MESSAGE [NO ARG]
	XWD	"Y",$Y		;MS TIME AS HH:MM:SS.SS
	XWD	"P",$P		;ERROR PC, OCTAL [NO ARG]
IF10,<	XWD	"E",$E >	;LOOKUP/ENTER/RENAME ERROR STRING
IF10,<	XWD	"I",$I >	;IO ERROR BITS CONVERTED TO ASCII [USES (D)]
	XWD	"F",$F		;FILESPEC FROM DDB [NO ARG, USES (D)]
IF10,<	XWD	"Z",$Z >	;SIXBIZ OR ASCIZ STRING
IF20,<	XWD	"Z",$A >	;SIXBIZ OR ASCIZ STRING
	XWD	"U",$U		;UNIT NUMBER, DON'T TYPE IF NEGATIVE [NO ARG]

LERRTB==.-ERRTAB


$LAB:	SKIPA	T1,["<"]	;TYPE LEFT ANGLE BRACKET   [BALANCING >]
$$:	MOVEI	T1,"$"		;TYPE $
	PJRST	EPUTCH

$U:	MOVE	T1,%CUNIT	;GET UNIT #
	JUMPL	T1,%POPJ	;DON'T PRINT NEGATIVE UNITS
	PUSH	P,T1		;SAVE THE UNIT NUMBER
	MOVEI	T1,[ASCIZ /unit /]
	PUSHJ	P,ASCTYP
	POP	P,T1		;GET THE UNIT NUMBER AGAIN
	MOVEI	T3,^D10		;RADIX 10
	PJRST	NUMLP		;OUTPUT IT

$R:	MOVE	T1,CREC(D)	;GET CURRENT RECORD NUMBER
	JRST	DPOS		;GO PRINT IT

$D:	PUSHJ	P,GETARG	;GET NUMBER TO TYPE
DNOUT:	JUMPGE	T1,DPOS		;ALL OK IF IT'S POSITIVE
	PUSH	P,T1		;NEGATIVE, TYPE MINUS SIGN
	MOVEI	T1,"-"
	PUSHJ	P,EPUTCH
	POP	P,T1
	MOVM	T1,T1
DPOS:	MOVEI	T3,^D10		;RADIX 10
	JRST	NUMLP

$C:	PUSHJ	P,GETARG
	CAIL	T1," "
	  PJRST	EPUTCH
	PUSH	P,T1
	MOVEI	T1,"^"
	PUSHJ	P,EPUTCH
	POP	P,T1
	ADDI	T1,100
	PJRST	EPUTCH

$N:	MOVE	T2,%ERNAM
NOPLP:	JUMPE	T2,%POPJ	;DONE IF ONLY SPACES LEFT
	SETZ	T1,		;CLEAR CHAR
	LSHC	T1,6		;GET CHAR
	ADDI	T1,40		;CONVERT TO ASCII
	CAIE	T1,"."		;PRINT IF NOT DOT
	 PUSHJ	P,EPUTCH	;OUTPUT CHAR
	JRST	NOPLP

$S:	PUSHJ	P,GETARG
SIXTYP:	MOVE	T2,T1
S1:	JUMPE	T2,%POPJ
	SETZ	T1,
	LSHC	T1,6
	ADDI	T1,40
	PUSHJ	P,EPUTCH
	JRST	S1

$X:	PUSHJ	P,GETARG
XWDTYP:	PUSH	P,T1
	HLRZ	T1,T1
	PUSHJ	P,OCTTYP
	MOVEI	T1,","
	PUSHJ	P,EPUTCH
	POP	P,T1
	MOVEI	T1,(T1)
	PJRST	OCTTYP

$OFFS:	PUSHJ	P,GETARG	;GET ARG
OFFTYP:	JUMPE	T1,%POPJ	;DON'T TYPE 0
	PUSH	P,T1		;SAVE IT
	CAIGE	T1,0		;POSITIVE?
	  SKIPA	T1,["-"]	;NO
	MOVEI	T1,"+"		;YES
	PUSHJ	P,EPUTCH	;TYPE SIGN
	POP	P,T1
	MOVM	T1,T1
	JRST	OCTTYP		;TYPE OCTAL NUMBER

$O:	SKIPE	ERRARG		;$1O MEANS TYPE SIGN FIRST
	  JRST	$OFFS
	PUSHJ	P,GETARG	;GET ARG IN T1
OCTTYP:	MOVEI	T3,^D8
NUMLP:	LSHC	T1,-^D35
	LSH	T2,-1
	DIVI	T1,(T3)
	JUMPE	T1,.+4
	PUSH	P,T2
	PUSHJ	P,NUMLP
	POP	P,T2
	MOVEI	T1,"0"(T2)
	PJRST	EPUTCH


$P:	MOVE	T1,%ERPDP	;GET PDP OF ERROR.
	MOVE	T1,(T1)		;GET THE CALLER ADDR+1
	SUBI	T1,1		;GET ADDR OF CALL
	SKIPN	%FSECT		;NON-ZERO SECTION?
	 MOVEI	T1,(T1)		;NO. EXCLUDE FLAGS
	PJRST	OCTTYP		;TYPE IT IN OCTAL

$Y:	PUSHJ	P,GETARG	;GET TIME IN MS
	ADDI	T1,5		;ROUND TO HUNDREDTHS
	IDIVI	T1,^D10
	IDIVI	T1,^D100	;GET SECONDS AND HUNDREDTHS
	PUSH	P,T2		;SAVE HUNDREDTHS
	PUSHJ	P,XTIME		;TYPE HH:MM:SS
	MOVEI	T1,"."		;TYPE	      .S
	PUSHJ	P,EPUTCH
	POP	P,T1		;GET HUNDREDTHS
	IDIVI	T1,^D10		;BREAK INTO 2 DIGITS
	ADDI	T1,"0"		;MAKE ASCII
	PUSHJ	P,EPUTCH	;OUTPUT IT
	MOVEI	T1,"0"(T2)	;MAKE 2ND DIGIT ASCII
	PJRST	EPUTCH		;TYPE IT

XTIME:	IDIVI	T1,^D60		;GET BASE-60 DIGIT
	JUMPE	T1,TIMEX	;IF LAST ONE, DONE
	PUSH	P,T2		;SAVE A DIGIT
	PUSHJ	P,XTIME		;TYPE REST OF NUMBER
	MOVEI	T1,":"		;TYPE COLON
	PUSHJ	P,EPUTCH
	POP	P,T2		;GET DIGIT BACK
	IDIVI	T2,^D10		;GET 2 DECIMAL DIGITS
	MOVEI	T1,"0"(T2)	;TYPE 2-DIGIT NUMBER
	PUSHJ	P,EPUTCH
	MOVEI	T1,"0"(T3)
	PJRST	EPUTCH

TIMEX:	IDIVI	T2,^D10		;GET HIGH-ORDER DIGITS
	MOVEI	T1,"0"(T2)
	CAIE	T1,"0"
	  PUSHJ	P,EPUTCH
	MOVEI	T1,"0"(T3)
	PJRST	EPUTCH

$L:	PUSHJ	P,GETARG	;GET PC TO CONVERT
	MOVEM	T1,ORGADR	;SAVE IT
	PUSHJ	P,SYMCNV	;CONVERT TO LABEL + OFFSET
	SKIPN	T1,SYMNAM	;GET SYMBOL NAME
	 JRST	MODCNV		;NONE. PRINT MODULE + OFFSET
	PUSHJ	P,R50TYP	;TYPE IT
	MOVE	T1,SYMOFF	;GET OFFSET FROM SYMBOL
	PJRST	OFFTYP		;TYPE IT

MODCNV:	MOVE	P1,%ERPDP	;GET USER'S PDP
	SETZM	EADDR
NSYM0:	PUSHJ	P,GETPC		;GET A PC FROM STACK
	JUMPE	P1,NSYM1	;NONE LEFT, DONE
	CAML	T2,EADDR	;BETTER THAN PREVIOUS BEST APPROXIMATION?
	CAMLE	T2,ORGADR	;YES, BUT NOT PAST ARG PC?
	  JRST	NSYM0		;NO, SKIP IT
	MOVEM	T2,EADDR	;SAVE ROUTINE ADDRESS
	JRST	NSYM0		;LOOK THROUGH WHOLE STACK

NSYM1:	SKIPN	P1,EADDR	;GET ROUTINE ADDRESS
	  SKIPA	P1,%STADD	;NONE FOUND, USE MAIN START ADDRESS
	SKIPA	T1,-1(P1)	;GET ROUTINE NAME
	  MOVE	T1,['MAIN. ']	;OR MAIN PROGRAM NAME

	PUSHJ	P,SIXTYP	;TYPE IT
	MOVE	T1,ORGADR	;GET ARG PC
	SUB	T1,P1		;SUBTRACT ROUTINE ADDRESS
	PJRST	OFFTYP		;TYPE OFFSET

;Routine called to append the PC to the error message.

ADDPCM:	MOVEI	T1,[ASCIZ/ at /]
	PUSHJ	P,ASCTYP
	MOVE	T1,MSGPC	;[3155] Get PC
	MOVEM	T1,ORGADR	;SAVE FOR CONVERSION
	PUSHJ	P,SYMCNV	;CONVERT TO LABEL+OFFSET
	SKIPN	T1,SYMNAM	;GET SYMBOL NAME
	 JRST	NOSYM		;NONE. TRY SEARCHING MODULE NAMES
	PUSHJ	P,R50TYP	;TYPE RADIX50 SYMBOL
	MOVE	T1,SYMOFF	;GET OFFSET FROM SYMBOL
	PUSHJ	P,OFFTYP	;TYPE IT AS SIGNED OCTAL

	MOVEI	T1,[ASCIZ / in /] ;TYPE NOISE WORD FOR MODULE NAME
	PUSHJ	P,ASCTYP
	MOVE	T1,SYMMOD	;GET MODULE NAME
	PUSHJ	P,R50TYP	;TYPE IT TOO

PCTYP:	MOVEI	T1,[ASCIZ / (PC /] ;FINISH UP WITH THE OCTAL ADDRESS
	PUSHJ	P,ASCTYP
	HLRZ	T1,MSGPC	;GET SECTION #
	JUMPE	T1,PCTYP0
	PUSHJ	P,OCTTYP	;Type section #
	MOVEI	T1,","
	PUSHJ	P,EPUTCH
	PUSHJ	P,EPUTCH	;",,"
PCTYP0:	HRRZ	T1,MSGPC	;GET LOCAL ADDR
	PUSHJ	P,OCTTYP
	MOVEI	T1,")"
	PJRST	EPUTCH

NOSYM:	MOVE	P1,%ERPDP	;GET USER'S PDP
	PUSHJ	P,GETPC		;GET A PC FROM STACK
	JUMPE	P1,USMAIN	;NONE. USE MAIN.

	MOVE	P1,T2		;GET ROUTINE ADDR
	MOVE	T1,-1(P1)	;GET ROUTINE NAME
	JRST	NSTYPE		;GO TYPE THEM

USMAIN:	MOVE	P1,%STADD	;NONE FOUND, USE MAIN START ADDRESS
	MOVE	T1,['MAIN. ']	;OR MAIN PROGRAM NAME

NSTYPE:	PUSHJ	P,SIXTYP	;TYPE IT
	MOVE	T1,ORGADR	;GET ARG PC
	SUB	T1,P1		;SUBTRACT ROUTINE ADDRESS
	PUSHJ	P,OFFTYP	;TYPE OFFSET
	PJRST	PCTYP		;GO TYPE PC IN OCTAL

$5:	PUSHJ	P,GETARG	;GET ARG IN T1
	JUMPE	T1,%POPJ
	PUSH	P,T1
	MOVEI	T1," "
	PUSHJ	P,EPUTCH
	POP	P,T1
R50TYP:
R50LP:	IDIVI	T1,50
	JUMPE	T1,.+4
	PUSH	P,T2
	PUSHJ	P,R50LP
	POP	P,T2

	JUMPE	T2,%POPJ
	MOVEI	T1,<"0"-R50(0)>(T2)
	CAILE	T1,"9"
	  ADDI	T1,"A"-R50(A)-"0"+R50(0)
	CAILE	T1,"Z"
	  SUBI	T1,-<"$"-R50($)-"A"+R50(A)>
	CAIN	T1,"$"-1
	  MOVEI	T1,"."
	JRST	EPUTCH


EPUTCH:	AOS	COLCNT		;KEEP TRACK OF WHAT COL WE'RE ON
	SOSL	ERRCNT		;DECREMENT COUNT OF CHARS LEFT
	  IDPB	T1,ERRPTR	;SPACE LEFT, STORE CHAR
	POPJ	P,


;GETARG - GETS THE NEXT ARG ON THE ARGUMENT LIST.
;DOES NOT SUPPORT INDEXING OR INDIRECTION
GETARG:	AOS	T1,ARGPTR	;GET CURRENT POINTER
	MOVE	T1,(T1)		;GET ARG ADDR
	CAIG	T1,17		;IS ARG IN AC?
	 JRST	ACARG		;YES. GO GET IT
	HLL	T1,ARGPTR	;ADD SECTION # OF CALLER
	MOVE	T1,(T1)		;GET ACTUAL ARG
	POPJ	P,

ACARG:	ADD	T1,AERACS	;POINT TO SAVED AC
	MOVE	T1,(T1)		;GET ACTUAL ARG
	POPJ	P,

IF10,<
	XLIST
	LIT
	LIST

$E:	PUSHJ	P,GETARG	;GET ERR CODE
	CAIL	T1,0		;NEGATIVE?
	CAILE	T1,LERMAX	;OR TOO BIG?
	  JRST	LERUNK		;YES, TYPE GENERAL-PURPOSE MSG

	ADDM	T1,%ERNM2	;Fix error number
	IDIVI	T1,4		;GET STRING OFFSET
	LDB	T1,LERTBL(T2)
	CAIN	T1,777		;NO MSG FOR THIS ERROR?
	  JRST	LERUNK		;YES, GO TYPE G.P. MSG
	MOVEI	T1,LERMSG(T1)	;GET STRING ADDRESS
	PJRST	ASCTYP		;GO TYPE IT

LERUNK:	MOVEI	T1,[ASCIZ /Unknown FILOP error, code /]
	PUSHJ	P,ASCTYP
	MOVE	T1,@ARGPTR	;GET ERROR CODE BACK
	PJRST	OCTTYP		;TYPE IT


LERTBL:	POINT	9,LERPTR(T1),8
	POINT	9,LERPTR(T1),17
	POINT	9,LERPTR(T1),26
	POINT	9,LERPTR(T1),35

DEFINE X (STRG) <
 XOFFS==[ASCIZ \STRG\]-LERMSG
 XXX (XOFFS)
>

DEFINE XX (STRG) <
 XXX (-1)
>

DEFINE XXX (OFFS) <
 XXXWD==XXXWD + <OFFS&777>_<XXXCT*9>
 XXXCT==XXXCT-1
 IFL XXXCT,<
	EXP XXXWD
  XXXWD==0
  XXXCT==3
 >
>
	XXXWD==0
	XXXCT==3

LERPTR:	X	No such file			;0
	X	No such directory		;1
	X	Protection failure		;2
	X	File is being modified		;3
	X	File already exists		;4
	XX	Illegal sequence of UUOs	;5
	X	RIB error			;6
	XX	Bad format .SAV file		;7
	XX	Insufficient memory		;10
	X	Device is not available		;11
	X	Can't OPEN device		;12
	XX	Illegal UUO			;13
	X	Device full			;14
	X	Device is write locked		;15
	X	Insufficient monitor table space ;16
	XX	Can't allocate contiguous space ;17
	XX	Requested block not free	;20
	X	Can't write a directory		;21
	X	Directory is not empty		;22
	X	No such directory		;23
	X	Search list empty		;24
	X	SFDs nested too deep		;25
	X	All structures have NOCREATE set ;26
	XX	Segment not in swap space	;27
	X	Can't update file		;30
	XX	Page overlap			;31
	XX	Not logged in			;32
	X	Locks still set			;33
	XX	Bad format .EXE file		;34
	XX	Extension must be .EXE		;35
	XX	.EXE directory too big		;36
	X	Network full			;37
	X	Task not available		;40
	X	No such node			;41
	X	SFD in use			;42
	X	File has an NDR lock		;43
	X	Monitor use count overflow	;44
	X	Can't rename SFD downward	;45
	XX	Channel not open		;46
	X	Device is down			;47
	X	Device is restricted		;50
	X	Device must be mounted		;51
	X	Device is assigned to another job ;52
	XX	Illegal data mode		;53
	XX	Unknown OPEN bits		;54
	X	Device is not available		;55
	X	Funny space full		;56
	X	Too many open units		;57
	XX	Unknown function code		;60
	XX	Illegal channel number		;61
	XX	Illegal channel number		;62

LERMAX==62					;MAX STRING IN TABLE

IFN XXXCT-3,<EXP XXXWD>

LERMSG:	;LIT

	XLIST
	LIT
	LIST

;STILL IF10

;TYPE IO ERROR MESSAGE

$I:	PUSHJ	P,%SAVE3	;SAVE P ACS

	MOVEI	T1,[ASCIZ /IO error /]
	PUSHJ	P,ASCTYP
	PUSHJ	P,GETARG	;GET BITS
	HRLZ	P1,T1		;SAVE THEM, IN LH
	PUSHJ	P,OCTTYP	;TYPE THEM IN OCTAL

	MOVE	D,AERACS	;GET ADDRESS OF SAVED ACS
	MOVE	D,D(D)		;GET DDB POINTER
	TLZ	P1,-1-IO.ERR-IO.EOF-IO.EOT ;CLEAR BORING BITS
	LOAD	T4,DVTYP(D)	;GET DEVTYP
	CAIN	T4,.TYMTA	;MTA?
	  TLZ	P1,IO.EOT	;NO, EOT ISN'T REALLY EOT, SO IS BORING
	LOAD	T1,INDX(D)	;GET DEV INDEX
	CAIN	T1,DI.DSK	;DISK?
	  MOVEI	T4,.TYDSK	;YES, SPOOLED DEV OR REAL DISK

	MOVEI	P3,IBUF-1	;POINT TO BUFFER FOR MSGS
	JRST	IOENXT		;GO DO FIRST BIT

IOELP:	ANDCM	P1,[EXP 1B0,1B1,1B2,1B3,1B4,1B5,1B6,1B7](P2) ;CLEAR BIT
	DPB	P2,[POINT 3,T4,29] ;STORE ERROR CODE WITH DEVTYP

	MOVEI	T3,(T4)		;COPY ERR BIT & DEV TYP
IOELP1:	MOVE	T2,[-LITAB,,ITAB] ;POINT TO TABLE
IOELP2:	LDB	T1,[POINT 9,(T2),9] ;GET ERR BIT & DEVTYP
	CAIE	T1,(T3)		;MATCH?
	  AOBJN	T2,IOELP2	;NO, KEEP LOOKING
	JUMPL	T2,IOEEND	;JUMP IF WE FOUND IT
	ORI	T3,.TYXXX	;USE DEFAULT IF NOT FOUND
	JRST	IOELP1

IOEEND:	MOVE	T2,(T2)		;GET MESSAGE POINTER
	PUSH	P3,T2		;SAVE MESSAGE FOR THIS BIT

IOENXT:	JFFO	P1,IOELP	;DO NEXT BIT
	PUSH	P3,[0]		;FLAG END OF LIST

	MOVEI	P1,IBUF
	SKIPA	T1,[[ASCIZ / (/]] ;FIRST MSG GETS PAREN
MSGLP:	MOVEI	T1,[ASCIZ /, /]	;OTHERS GET COMMAS
	SKIPN	P2,(P1)		;GET A MSG
	  JRST	MSGEND		;NONE LEFT
	PUSHJ	P,ASCTYP	;TYPE PAREN OR COMMA
	CAIL	P2,0		;ROUTINE TO CALL?
	  PUSHJ	P,(P2)		;YES, CALL IT
	SKIPE	T1,P2		;POINT TO STRING
	  PUSHJ	P,ASCTYP	;TYPE IT
	AOJA	P1,MSGLP	;LOOP OVER ALL MSGS

MSGEND:	MOVEI	T1,")"		;TYPE CLOSE PAREN
	SKIPE	IBUF
	  PUSHJ	P,EPUTCH

	HLLZ	T2,CHAN(D)	;CLEAR ERROR BITS
	HRRI	T2,.FOSET
	MOVE	T3,@ARGPTR	;GET BITS BACK
	ANDI	T3,-1-IO.ERR	;CLEAR ERR BITS, LEAVE EOF AND EOT
	MOVE	T1,[2,,T2]	;SET LENGTH, ADDRESS
	FILOP.	T1,		;DO FILOP
	  JFCL

	POPJ	P,

;STILL IF10

.TYXXX==77			;FAKE DEVTYP FOR DEFAULT DEVICE

DEFINE X (DEV,ERR,FATAL<0>,MSG) <
	BYTE (1)1(3)^L<IO.'ERR,,0>(6).TY'DEV(1)FATAL(7)0(18)[ASCIZ \MSG\]
>
DEFINE XS (DEV,ERR,FATAL<0>,SUB) <
	BYTE (1)0(3)^L<IO.'ERR,,0>(6).TY'DEV(1)FATAL(7)0(18)SUB
>

ITAB:	X CDP,BKT,,card too large
	X CDR,IMP,,nonbinary card
	X CDR,DTE,,checksum error
	X MTA,IMP,1,write locked
	X MTA,DTE,,parity error
	X MTA,BKT,,record exceeds BLOCKSIZE
	X MTA,EOT,1,EOT
	X PTR,IMP,,block incomplete
	X PTR,DTE,,checksum error
	X PTY,BKT,,char lost
	X TTY,IMP,1,not assigned
	X TTY,DER,1,^C typed
	X TTY,DTE,,echo check
	X TTY,BKT,,char lost
	XS DSK,IMP,1,DSKIMP	;write locked or RIB error
	X DSK,DTE,,parity error
	XS DSK,BKT,1,DSKBKT	;str full or quota exceeded
	X DTA,IMP,1,write locked
	X DTA,DTE,,parity error
	X DTA,BKT,1,tape full
	X XXX,IMP,1,improper mode (whatever that means)
	XS XXX,DER,,XXXDER	;device error
	X XXX,DTE,,data error
	X XXX,BKT,,block too large
	X XXX,EOF,,end of file
	X XXX,EOT,,EOT		;SNH

LITAB==.-ITAB


	SEGMENT	DATA
IBUF:	BLOCK	6		;ONE MESSAGE EACH FOR 5 POSSIBLE BITS
DCBLK:	BLOCK	1+.DCFCT	;ARG BLOCK FOR DSKCHR
	SEGMENT	CODE

;STILL IF10

DSKBKT:	SKIPN	T1,RDEV(D)	;GET STR FILE IS ON
	  JRST	DSKFUL		;CAN'T, JUST SAY DISK FULL
	MOVEM	T1,DCBLK	;SAVE FOR DSKCHR

	MOVE	T1,[1+.DCFCT,,DCBLK] ;SET UP FOR DSKCHR
	DSKCHR	T1,UU.PHY	;FIND SPACE REMAINING
	  JRST	DSKFUL

	MOVE	P2,[X (DSK,BKT,1,quota or storage exceeded)]
	SKIPG	DCBLK+.DCUFT	;CHECK BLOCKS LEFT IN QUOTA
	  MOVE	P2,[X (DSK,BKT,1,quota exceeded)]
	SKIPG	DCBLK+.DCFCT	;CHECK BLOCKS LEFT ON STR
DSKFUL:	  MOVE	P2,[X (DSK,BKT,1,structure full)]

	POPJ	P,


DSKIMP:	SKIPN	T1,RDEV(D)	;GET STR NAME
	  JRST	DSKWL		;CAN'T
	MOVEM	T1,DCBLK	;SAVE FOR DSKCHR

	MOVE	T1,[1,,DCBLK]	;SET FOR DSKCHR
	DSKCHR	T1,UU.PHY	;FIND WRITE-LOCK STATUS
	  JRST	DSKWL

	TXNE	T1,DC.HWP+DC.SWP ;CHECK WRITE PROTECTION
	  JRST	DSKWL		;  IT'S WRITE-LOCK
	MOVE	T1,LKPB+.RBSTS(D) ;GET RIB STATUS WORD
	MOVE	P2,[X (DSK,IMP,1,checksum error)]
	TXNN	T1,RP.FCE	;CHECKSUM ERROR?
	  MOVE	P2,[X (DSK,IMP,1,RIB error)] ;NO
	POPJ	P,

DSKWL:	MOVE	P2,[X (DSK,IMP,1,write locked)]
	
	POPJ	P,


XXXDER:	SETZ	P2,		;CLEAR OUTPUT MSG, WE'LL DO THE TYPING
	MOVEI	T1,[ASCIZ /device error/]
	PUSHJ	P,ASCTYP

	LDB	T1,[POINTR CHAN(D),FO.CHN] ;GET CHANNEL NUMBER
	DEVSTS	T1,		;GET CONI AT LAST INTERRUPT
	  POPJ	P,		;CAN'T

	PUSH	P,T1		;TYPE IT
	MOVEI	T1,[ASCIZ /, CONI /]
	PUSHJ	P,ASCTYP
	POP	P,T1
	PJRST	OCTTYP

;STILL IF10

;TYPE FILESPEC FROM DDB POINTED TO BY D

$F:	PUSHJ	P,GETARG	;GET UDB ADDRESS
	JUMPE	T1,%POPJ	;IF ZERO, NOTHING TO PRINT
	SKIPN	D,DDBAD(T1)	;GET DDB POINTER
	 POPJ	P,		;NONE. DON'T PRINT TRASH
	SKIPN	DEV(D)		;DEVICE
	 POPJ	P,		;NO DEVICE, NO INFO AT ALL
	MOVE	T1,DEV(D)	;GET DEVICE NAME
	PUSHJ	P,SIXTYP
	MOVEI	T1,":"
	PUSHJ	P,EPUTCH

	SKIPN	T1,FILE(D)	;FILENAME
	  POPJ	P,
	PUSHJ	P,SIXTYP
	MOVEI	T1,"."
	SKIPE	EXT(D)
	  PUSHJ	P,EPUTCH
	HLLZ	T1,EXT(D)
	  PUSHJ	P,SIXTYP

	SKIPN	PTHB+.PTPPN(D)	;PATH
	  POPJ	P,
	MOVEI	T1,"["
	PUSHJ	P,EPUTCH
	MOVE	T1,PTHB+.PTPPN(D)
	PUSHJ	P,XWDTYP
	XMOVEI	T1,PTHB+.PTPPN+1(D)
	PUSH	P,T1
SFDLP:	SKIPN	@(P)
	  JRST	SFDEND
	MOVEI	T1,","
	PUSHJ	P,EPUTCH
	MOVE	T1,@(P)
	PUSHJ	P,SIXTYP
	AOS	(P)
	JRST	SFDLP
SFDEND:	POP	P,(P)
	MOVEI	T1,"]"
	PUSHJ	P,EPUTCH

	POPJ	P,		;DONE

> ;IF10

IF20,<
$J:	MOVEI	T1,.FHSLF	;GET JSYS ERROR NUMBER FOR LAST ERROR
	GETER%
	  ERJMP	.+1
	MOVEI	T2,(T2)		;GET JUST RIGHT HALF
	SKIPN	%ERNM2		;IS 2ND ERROR NUMBER 0?
	 MOVEM	T2,%ERNM2	;YES. STORE JSYS ERROR NUMBER
	CAIN	T2,GJFX3	;"No JFNs available"?
	 JRST	NOJFNA		;Yes, doing ERSTR% doesn't help!
	MOVE	T1,ERRPTR	;GET POINTER TO DESTINATION STRING
	HRLI	T2,.FHSLF
	MOVN	T3,ERRCNT	;NEGATIVE OF NUMBER OF CHARS IN BUFFER
	MOVSI	T3,(T3)		;IN LEFT HALF
	ERSTR%			;GET ERROR STRING
	 JRST	ERNSE		;NO SUCH ERROR
	 TRN			;STRING TOO SHORT, MSG TRUNCATED
	MOVEM	T1,ERRPTR	;STORE NEW STRING POINTER
	HLRE	T3,T3		;GET LEFTOVER COUNT
	MOVMM	T3,ERRCNT	;SAVE IT
	POPJ	P,

NOJFNA:	MOVEI	T1,[ASCIZ/no JFNs available/] ;Get error
	PJRST	ASCTYP

ERNSE:	SKIPA	T1,[[ASCIZ /(undefined error number)/]]
ERERR:	MOVEI	T1,[ASCIZ /(error in ERSTR)/]
	PJRST	ASCTYP

;Type filespec from DDB
$F:	PUSHJ	P,GETARG	;GET UDB ADDRESS
	JUMPE	T1,%POPJ	;IF ZERO, NOTHING TO PRINT
	SKIPN	D,DDBAD(T1)	;GET DDB POINTER
	 POPJ	P,		;NONE. DON'T PRINT TRASH
	LOAD	T2,IJFN(D)	;Get JFN of file
	JUMPE	T2,FNOJFN	;None yet
	CAIN	T2,.PRIIN	;Can't do JFNS on .PRIIN
	 JRST	NJFNS1

	HRROI	T1,JFNBUF	;Store filespec in temp buffer
	SETZ	T3,		;Set for default JFNS
	JFNS%
	 ERJMP	FNOJFN		;?can't, JFN must be bogus
	JRST	NJFNS2

;The JFN is actually .PRIIN
NJFNS1:	MOVE	T1,[ASCIZ/TTY:/]
	MOVEM	T1,JFNBUF
NJFNS2:	MOVEI	T1,JFNBUF	;Point to ASCIZ string to append
	PJRST	ASCTYP		;Append it and return

;No JFN available
FNOJFN:	SKIPN	DEV(D)		;ANY DEVICE?
	 POPJ	P,		;NO. NOTHING ELSE, EITHER
	XMOVEI	T1,DEV(D)	;Put device
	PUSHJ	P,ASCTYP	;into buffer
	MOVEI	T1,":"
	PUSHJ	P,EPUTCH
	SKIPN	DIR(D)		;Directory known yet?
	 JRST	FLEXGN		;No
	TXNE	F,F%PPN		;PPN instead of directory string?
	 JRST	NJFNE3		;Yes, another special case
	MOVEI	T1,"<"
	PUSHJ	P,EPUTCH
	XMOVEI	T1,DIR(D)
	PUSHJ	P,ASCTYP	;DIRECTORY
	MOVEI	T1,">"
	PUSHJ	P,EPUTCH

;Here to finish putting out FILE.EXT.GEN

FLEXGN:	SKIPN	FILE(D)		;ANY FILE GIVEN?
	 POPJ	P,		;NO. NOTHING MORE TO PRINT
	XMOVEI	T1,FILE(D)
	PUSHJ	P,ASCTYP
	MOVEI	T1,"."
	PUSHJ	P,EPUTCH
	XMOVEI	T1,EXT(D)
	PUSHJ	P,ASCTYP
	MOVEI	T1,"."
	PUSHJ	P,EPUTCH
	MOVE	T1,XGEN(D)	;Get gen number
	PJRST	DNOUT		;Print decimal # and return

NJFNE3:	MOVEI	T1,"["
	PUSHJ	P,EPUTCH
	MOVE	T1,DEV(D)
	PUSHJ	P,XWDTYP	;Type nn,,nn
	MOVEI	T1,"]"
	PUSHJ	P,EPUTCH
	JRST	FLEXGN		;Type FILE.EXT.GN and return

	SEGMENT	DATA
JFNBUF:	BLOCK	^D60		;Buffer for JFNS string
	SEGMENT	CODE

>;END IF20


$T:	MOVE	T2,ERRARG	;GET COL TO TAB TO
	SUB	T2,COLCNT	;GET NUMBER OF SPACES WE NEED
	MOVEI	T1," "
	PUSHJ	P,EPUTCH	;TYPE A SPACE
	SOJG	T2,.-1		;LOOP UNTIL AT DESIRED COL
	POPJ	P,		;DONE

IF10,<
$Z:	PUSHJ	P,GETARG	;GET ADDRESS OF STRING
	HRLI	T1,(POINT 6,)	;MAKE INTO BYTE POINTER
	MOVE	T4,T1		;IN SAFE PLACE
SIXLP:	ILDB	T1,T4		;GET CHAR
	JUMPE	T1,%POPJ	;SPACE TERMINATES STRING
	ADDI	T1,40		;CONVERT TO ASCII
	PUSHJ	P,EPUTCH	;TYPE IT
	JRST	SIXLP		;LOOP
> ;IF10

$A:	PUSHJ	P,GETARG	;GET ADDRESS OF STRING
ASCTYP:	HRLI	T1,(POINT 7,)	;MAKE INTO BYTE POINTER
	MOVE	T4,T1		;PUT IN SAFE PLACE
ASCLP:	ILDB	T1,T4		;GET CHAR OF STRING
	JUMPE	T1,%POPJ	;NULL TERMINATES STRING
	PUSHJ	P,EPUTCH	;TYPE CHAR
	JRST	ASCLP		;LOOP

;Routine to get initial PREFIX part of message
;CAll: t1/ prefix char

TYPEQM:	JUMPE	T1,TYPQM1	;Don't type anything if no char
	PUSHJ	P,EPUTCH	;Type char
IF10,<
	MOVE	T1,%MSLVL	;Get message level
	TXNN	T1,JW.WPR	;Does user want prefix?
	 JRST	NPR		;No, skip it

	HLRZ	T1,%COD(P2)	;Get 3-letter error code
	HRLI	T1,'FRS'	;Put in FOROTS prefix
	PUSHJ	P,SIXTYP	;Type it
	MOVEI	T1," "		;Follow with space
	PUSHJ	P,EPUTCH
NPR:
>;END IF10
TYPQM1:	SETZM	COLCNT		;Start counting cols for tabs
	POPJ	P,		;Return

;TYPE INPUT RECORD (PRESUMABLY CONTAINING AN ERROR) AND PUT AN ARROW
;UNDER THE ERRONEOUS CHARACTER.  THE ERROR POSITION IS GOTTEN FROM RPOS.

RCTYB1:	MOVNI	T1,1		;MOVE POINTER BACK 1 CHAR
	PUSHJ	P,%CIPOS

RECTYP:	PUSHJ	P,%RIPOS	;GET POSITION OF NEXT CHAR
	SUBI	T1,1		;GET POSITION OF BAD CHAR
	MOVEI	T2,(T1)		;COPY IT
	CAILE	T2,BEFSIZ	;MORE THAN WILL FIT?
	 MOVEI	T2,BEFSIZ	;YES. SUBSTITUTE JUST ENOUGH
	MOVEM	T2,ERRPOS	;SAVE FOR PRINTING THE ARROW
	SUBI	T1,(T2)		;CHOP OFF UNNEEDED CHARS
	ADDI	T1,1		;POINT TO CORRECT CHAR
	PUSHJ	P,%SIPOS

	MOVE	T1,[POINT 7,ER1BUF] ;PREPARE TO COPY RECORD TO ERROR BUFFER
	MOVEM	T1,ER1PTR	;SAVE PNTR
	MOVE	T3,ERRPOS	;GET POSITION OF BAD CHAR
	SOJLE	T3,ILCPEC	;GET # CHARS PRECEDING IT FOR ARROW
ILCLP:	PUSHJ	P,%IBYTE	;GET CHAR FROM RECORD
	PUSHJ	P,PUTERC	;PUT IN BUFFER, SPACE IN ARROW LINE
	SOJG	T3,ILCLP	;COPY RECORD UP TO BAD CHAR
ILCPEC:	PUSHJ	P,%IBYTE	;GET BAD CHAR
	PUSHJ	P,PUTER1	;STORE IT
	MOVEI	T3,BEFSIZ+AFTSIZ ;GET TOTAL ALLOWED SANDWICH
	SUB	T3,ERRPOS	;MINUS CHARS ALREADY OUT
ILCLP2:	SKIPG	IRCNT(D)	;AND CHARS IN RECORD?
	 JRST	ILCEND		;NO
	PUSHJ	P,%IBYTE	;GET NEXT CHAR
	PUSHJ	P,PUTER1	;STORE IT
	SOJG	T3,ILCLP2
ILCEND:	PUSHJ	P,BUFTYP	;TYPE RECORD
	PJRST	AROUT		;NOW OUTPUT ARROW LINE

PUTERC:	CAIN	T1,177		;RUBOUT?
	 MOVNI	T1,1		;YES. MAKE IT -1
	CAIN	T1,0		;NULL?
	 MOVEI	T1," "		;YES. MAKE IT A SPACE
	CAIGE	T1," "		;OR OTHER NON-PRINTING CHAR?
	 JRST	ERCTL		;YES. GO PRECEDE WITH "^"
	IDPB	T1,ER1PTR	;NO. JUST DEPOSIT IT
	POPJ	P,

PUTER1:	CAIN	T1,177		;RUBOUT?
	 MOVNI	T1,1		;YES. MAKE IT -1
	CAIN	T1,0		;NULL?
	 MOVEI	T1," "		;YES. MAKE IT A SPACE
	CAIGE	T1," "		;OTHER NON-PRINTING CHAR?
	 JRST	ER1CTL		;YES. PRECEDE WITH "^"
	IDPB	T1,ER1PTR	;NO. JUST STORE IT
	POPJ	P,

ERCTL:	AOS	ERRPOS		;INCR ARROW SPACE COUNT FOR "^"
ER1CTL:	MOVEI	T2,"^"		;OUTPUT UP-ARROW
	IDPB	T2,ER1PTR
	ADDI	T1,100		;CTL CHARS TO UPPER CASE, RUBOUT TO "?"
	IDPB	T1,ER1PTR	;STORE IT
	POPJ	P,

BUFTYP:	SETZ	T1,		;STORE NULL AT END OF BOTH STRINGS
	IDPB	T1,ER1PTR
	MOVE	T1,[POINT 7,ER1BUF] ;ERROR BUFFER
	PJRST	%EOREC		;Type it and return

AROUT:	MOVE	T3,[POINT 7,ER1BUF] ;POINT TO ERROR BUFFER AGAIN
	MOVE	T2,ERRPOS	;GET SPACE COUNT
	SOJLE	T2,PUTARO	;NO PRECEDING SPACES, JUST OUTPUT ARROW
	MOVEI	T1," "		;PUT SPACES INTO BUFFER
AROLP:	IDPB	T1,T3
	SOJG	T2,AROLP
PUTARO:	MOVEI	T1,"^"		;PUT IN ARROW
	IDPB	T1,T3
	SETZ	T1,		;PUT IN NULL
	IDPB	T1,T3
	MOVE	T1,[POINT 7,ER1BUF] ;POINT TO IT YET AGAIN
	PJRST	%EOREC		;TYPE IT

;TYPE FORMAT (PRESUMABLY CONTAINING AN ERROR) AND PUT AN ARROW UNDER THE
;ERRONEOUS CHARACTER.  THE ERROR POSITION IS GOTTEN FROM FMT.BP.

FMTTYP:	MOVE	T1,USR.SZ	;GET FORMAT SIZE
	SUB	T1,FMT.SZ	;GET CURRENT POSITION
	MOVEI	T2,(T1)		;COPY IT
	CAILE	T2,BEFSIZ	;TOO BIG?
	 MOVEI	T2,BEFSIZ	;YES. TRUNCATE IT
	MOVEM	T2,ERRPOS	;SAVE ERROR CHAR POSITION
	SUBI	T1,(T2)		;GET NUMBER OF CHARS TO SKIP
	MOVE	T3,USR.SZ	;GET # CHARS IN FORMAT AGAIN
	SUBI	T3,(T1)		;GET # CHARS IN TRUNCATED FORMAT
	CAILE	T3,BEFSIZ+AFTSIZ ;BUT NOT MORE THAN A PROPER SANDWICH
	 MOVEI	T3,BEFSIZ+AFTSIZ
	MOVEM	T3,ERRCNT	;SAVE IT
	ADJBP	T1,FMT.BG	;GET A POINTER TO THE FORMAT
	MOVEM	T1,ERRPTR	;SAVE IT
	MOVE	T1,[POINT 7,ER1BUF] ;POINT TO ERROR BUFFER
	MOVEM	T1,ER1PTR
	MOVE	T3,ERRPOS	;GET # CHARS PRECEDING ERROR CHAR
	SOJLE	T3,FMTPEC	;IF NONE, GO OUTPUT ERROR CHAR
FMTELP:	ILDB	T1,ERRPTR	;GET A CHAR
	PUSHJ	P,PUTERC	;STORE IN ERROR BUFFER, SPACE IN ARROW LINE
	SOJG	T3,FMTELP
FMTPEC:	ILDB	T1,ERRPTR	;GET ERROR CHAR
	PUSHJ	P,PUTER1	;STORE IN ERROR BUFFER

	MOVE	T3,ERRCNT	;GET TOTAL # CHARS AGAIN
	SUB	T3,ERRPOS	;GET SIZE OF REST OF FORMAT
FMTEL2:	ILDB	T1,ERRPTR	;GET ANOTHER FORMAT CHAR
	PUSHJ	P,PUTER1	;STORE IN ERROR BUFFER
	SOJG	T3,FMTEL2

	PUSHJ	P,BUFTYP	;OUTPUT FORMAT
	PJRST	AROUT		;OUTPUT ARROW LINE

IF10,<
;Type string with error in it, with arrow under the current char.
; %NCHRR is # of chars parsed so far (and the error position).
;%SRCBP is the CURRENT source byte ptr.

CHSTYP:	HRRZ	T3,%NCHRR	;Get # chars
	MOVEM	T3,ERRPOS	;SAVE FOR ARROW TYPOUT
	MOVNI	T3,(T3)		;NEGATIVE
	ADJBP	T3,%SRCBP	;POINT TO BEG OF STRING
	MOVEM	T3,ERRPTR	;SAVE IT
	MOVE	T1,[POINT 7,ER1BUF] ;Place to put it
	MOVEM	T1,ER1PTR
	HRRZ	T3,%NCHRR	;GET # CHARS PREVIOUS TO ERROR CHAR
	SOJLE	T3,CHSPEC	;IF NONE, JUST OUTPUT ERROR CHAR
CHSLP:	ILDB	T1,ERRPTR	;Get char
	PUSHJ	P,PUTERC	;STORE IN ERROR BUFFER, SPACE IN ARROW LINE
	SOJG	T3,CHSLP	;Loop till copied
CHSPEC:	ILDB	T1,ERRPTR	;GET ERROR CHAR
	PUSHJ	P,PUTER1	;STORE IN ERROR BUFFER
	PUSHJ	P,BUFTYP	;OUTPUT STRING
	PJRST	AROUT		;OUTPUT ARROW LINE

>;END IF10

	SEGMENT	DATA

BEFSIZ==^D50			;50 CHARS BEFORE ILCHR PRINTED
AFTSIZ==^D20			;20 CHARS AFTER ILCHR
RERRBF==30			;LENGTH OF RECORD AND FORMAT BUFFER
LERRBF==60			;LENGTH OF MESSAGE BUFFER, WORDS

G.ERBF::			;GLOBAL TAG
ERRBUF:	BLOCK	LERRBF		;BUFFER FOR THE ERROR MESSAGE
ERRCNT:	BLOCK	1		;COUNT OF CHARS LEFT IN IT
ERRPTR:	BLOCK	1		;POINTER TO NEXT FREE CHAR
ER1PTR:	BLOCK	1		;POINTER TO ERROR LINE BUFFER
ER1BUF:	BLOCK	RERRBF		;Buffer for the record

ERRPOS:	BLOCK	1		;POSITION OF ERROR CHARACTER
INICHR:	BLOCK	1		;PREFIX CHAR OF ERROR MESSAGE
ERRARG:	BLOCK	1		;ARG TO $<N>X COMMAND
COLCNT:	BLOCK	1		;COLUMN NUMBER
ARGPTR:	BLOCK	1		;POINTER TO NEXT ARG
EADDR:	BLOCK	1		;ERROR ADDRESS TEMP

	SUBTTL	TRACE

	SEGMENT	CODE

	$ERR (,TR0,-1,0)
	$ERR (,TR1,-1,0,<$S$7T($O)$16T$[$[---$23T$S$1O$34T($L)$48T$O$54T$A>,<RNAME,RPC,CNAME,OFFS,CPC,TRARGS,RGPTR>)
	$ERR (,TRC,-1,0,<Name   (Loc)    $[$[---  Caller     (Loc)        Args  Types>)

	FENTRY	(TRACE)
	MOVEM	P,%TRPDP	;USER STACK IS TRACE STACK
	MOVEM	P,%ERPDP	;AND ERROR STACK FOR MODCNV
	PUSHJ	P,SVEACS	;SAVE USER'S ACS

%TRACX:	SETZM	MSGPC		;NO PC ON EACH MESSAGE, PLEASE
	MOVE	P1,%TRPDP	;GET TRACE PDP
	PUSHJ	P,GETPC		;GET TOP CALL ON STACK
	JUMPE	P1,%POPJ	;NONE THERE, RETURN NOW
	MOVEM	P1,SAVPC	;SAVE DECREMENTED PC

	MOVEM	T1,CPC		;[3155] Save caller PC
	MOVEM	T2,RPC		;[3155] Save routine address
	HLL	T3,-1(T3)	;-COUNT,,ARGLST
	MOVEM	T3,TRARGS	;SAVE FOR LATER
	MOVE	T3,-1(T2)	;GET SIXBIT SUBROUTINE NAME
	MOVEM	T3,RNAME	;SAVE IT

	XMOVEI	T1,E.TR0+%EOFF	;OUTPUT BLANK LINE
	MOVEM	T1,%ERPTR
	PUSHJ	P,FOREC
	XMOVEI	T1,E.TRC+%EOFF	;OUTPUT TRACE HEADER
	MOVEM	T1,%ERPTR
	PUSHJ	P,FOREC

TRACEL:	MOVE	P1,SAVPC	;GET DECREMENTED PC FROM LAST CALL
	PUSHJ	P,GETPC		;GET NEXT PC ON STACK
	MOVEM	P1,SAVPC	;AND SAVE DECREMENTED ONE

	PUSH	P,T1		;SAVE INFO FOR NEXT LOOP
	PUSH	P,T2
	PUSH	P,T3

	MOVE	T4,CPC		;GET CALLER PC
	SUB	T4,T2		;[3155] Subtract start of caller's routine
	MOVEM	T4,OFFS

	CAIN	P1,0		;MAIN PROGRAM?
	  SKIPA	T4,[SIXBIT /MAIN./] ;YES, GET ITS NAME
	MOVE	T4,-1(T2)	;SUBROUTINE, GET NAME
	MOVEM	T4,CNAME	;SAVE AS CALLER'S NAME
	SETZM	STRNG		;INIT TO NULLS
	MOVE	T1,[STRNG,,STRNG+1]	;SETUP
	BLT	T1,STRNG+STRWDS-1	;INIT STRING
	MOVE	T1,[POINT 7,STRNG]	;PTR TO STRING
	MOVEM	T1,RGPTR	;STORE FOR ERR MACRO
	MOVE	T3,TRARGS	;RETRIEVE [-COUNT,,ARGLST]
	HLRE	T4,T3		;COUNT
	MOVNM	T4,TRARGS	;STORE FOR ERR MACRO
	SKIPN	T4,TRARGS	;ANY ARGS?
	  JRST	  TRCSHO	;  NOPE, GO DISPLAY
	CAIG	T4,STRLEN	;TOO MANY ARGS TO DISPLAY?
	  JRST	  TRCPTR	;  NOPE, GO FINISH SETTING UP
	HRLI	T3,-STRLEN	;SET AOBJ PTR TO MAX
	MOVE	T4,[ASCIZ/.../]	;UNDISPLAYED ARGS
	MOVEM	T4,STRNG+STRWDS	;STORE
TRCPTR: MOVE	T4,[POINT 7,STRNG]	;DEST PTR
TRCRGL:	LDB	T1,[POINT 4,(T3),12]	;GET DATA TYPE
	IDIVI	T1,5		;IN WHICH WORD IS SYMBOL?
	MOVE	T0,TYPCOD(T1)	;LOAD THE WORD
	IMULI	T2,7		;REMAINDER TO BIT OFFSET
	ROT	T0,7(T2)	;RIGHT JUSTIFY DATA TYPE SYMBOL
	IDPB	T0,T4		;SYMBOL TO STRNG
	AOBJN	T3,TRCRGL	;LOOP IF MORE ARGS

TRCSHO:	XMOVEI	T1,E.TR1+%EOFF	;OUTPUT A TRACE LINE
	MOVEM	T1,%ERPTR
	PUSHJ	P,FOREC

	POP	P,T3		;RESTORE 'GETPC' DATA FOR LOOP
	POP	P,T2
	POP	P,T1

	MOVEM	T1,CPC		;[3155] Save caller PC
	MOVEM	T2,RPC		;[3155] Save routine address
	HLL	T3,-1(T3)	;-COUNT,,ARGLST
	MOVEM	T3,TRARGS	;SAVE FOR LATER
	MOVE	T3,-1(T2)	;GET SIXBIT SUBROUTINE NAME
	MOVEM	T3,RNAME	;SAVE IT

	SKIPE	SAVPC		;ANY MORE STACK TO TRACE?
	 JRST	TRACEL		;YES. GO DO IT

	XMOVEI	T1,E.TR0+%EOFF	;NO. OUTPUT BLANK LINE
	MOVEM	T1,%ERPTR
	PJRST	FOREC		;AND LEAVE

STRWDS==3		;WORDS TO ACCOMODATE ARGUMENT SYMBOL STRING
STRLEN==5*STRWDS	;5 ASCII BYTES PER WORD
;		 0123456701234567
TYPCOD:	ASCII	/OLIUFUOSDIOGXCUH/
repeat 0,<
	DATA TYPE
	 0	INTEGER
	 1	LOGICAL
	 2	INTEGER
	 3	
	 4	REAL
	 5
	 6	OCTAL
	 7	STATEMENT LABEL
	10	DOUBLE REAL
	11	DOUBLE INTEGER
	12	DOUBLE OCTAL
	13	G-FLOATING
	14	COMPLEX
	15	CHARACTER
	16
	17	LITERAL STRING
>
	SEGMENT	DATA
STRNG:	BLOCK	STRWDS+1	;SYMBOL STRING + '...'

SAVPC:	BLOCK	1		;PLACE FOR DECREMENTED PC FROM GETPC
CPC:	BLOCK	1		;CALLER PC
RPC:	BLOCK	1		;ROUTINE PC
CNAME:	BLOCK	1		;CALLER NAME
RNAME:	BLOCK	1		;ROUTINE NAME
OFFS:	BLOCK	1		;OFFSET FROM BEGINNING OF CALLER
TRARGS:	BLOCK	1		;# ARGUMENTS
RGPTR:	BLOCK	1		;STRING POINTER FOR ERROR MACRO

	SEGMENT	CODE
;ROUTINE TO FIND THE NEXT PC ON THE STACK
;ARG:	 P1 = POINTER TO STACK
;RETURN: P1 = UPDATED TO PAST RETURNED PC, 0 IF NO PC FOUND
;	 T1 = PC OF PUSHJ
;	 T2 = DEST ADDRESS OF PUSHJ
;	 T3 = ADDRESS OF ARG LIST

GETPC:	MOVE	T1,(P1)		;GET SOMETHING OFF STACK
	CAMN	T1,['STOP!!']	;MAGIC END-OF-STACK CONSTANT?
	  JRST	GETPCE		;YES, GO RETURN END-OF-STACK INDICATION

	SKIPN	%FSECT		;NON-ZERO SECTION?
	 TLZ	T1,-1		;[3151] No, discard section 0 flag bits

	TLNE	T1,(77B5)	;[3151] Leftmost 6 bits must be zero by now
	 SOJA	P1,GETPC	;[3151] Nope, can't be a saved PC

	PUSHJ	P,ADRCHK	;CHECK THAT ADDRESS IS REASONABLE
	  SOJA	P1,GETPC	;NOT, NOT A PC

	MOVE	T1,(P1)		;GET ENTIRE ADDR AGAIN
	SKIPN	%FSECT		;SECTION ZERO?
	 TLZ	T1,-1		;[3151] Yes, throw away flag bits
	HLLZM	T1,PCSECT	;SAVE SECTION #
	SUBI	T1,1		;DECR PC
	HLRZ	T2,(T1)		;GET INSTRUCTION POINTED TO BY STACK
	TRZ	T2,37		;TURN OFF INDIRECT AND INDEX
	CAIE	T2,(PUSHJ P,)	;A SUBROUTINE CALL?
	 SOJA	P1,GETPC	;NO, NOT A PC
	HLRZ	T2,-1(T1)	;GET INSTRUCTION BEFORE THE PUSHJ
	TRZ	T2,37		;TURN OFF INDEIRECT AND INDEX
	CAIE	T2,(MOVEI L,)	;CORRECT?
	CAIN	T2,(XMOVEI L,)	; (The other choice)
	 TRNA			;Yes
	  SOJA	P1,GETPC	;NO

	MOVE	T3,(T1)		;GET THE PUSH INST
	TLNE	T3,17		;INDEXED?
	 JRST	UNKDST		;YES. DESTINATION UNKNOWN
	HRRZ	T2,(T1)		;GET THE PUSHJ INST DEST
	HLL	T2,PCSECT	;GET SECTION FROM CALLER ADDR
	TLNE	T3,(@)		;INDIRECT?
	 XMOVEI	T2,@(T2)	;YES. GET DEST ADDR OF PUSHJ
	HLRZ	T3,(T2)		;GET INSTRUCTION AT THAT ADDRESS
	CAIE	T3,(JSP 1,)	;POSSIBLE OVRLAY CALL?
	  JRST	GETPC1		;NO
	HRRZ	T3,(T2)		;GET RH OF JSP
	MOVE	T4,-1(T3)	;GET WORD BEFORE JSP TARGET
	CAME	T4,['.OVRLA']	;IS IT LINK'S OVERLAY ROUTINE?
	  JRST	GETPC1		;NO, NOT AN OVERLAY CALL
	MOVE	T2,(T3)		;GET THE WORD AFTER THE JSP
	TLO	T2,(IFIW)	;MAKE IT A LOCAL
	TLZ	T2,(1B1)	;[3147] Clear the undefined IFIW bit
	XMOVEI	T2,@T2		;GET THE DEST ADDR OF THE OVERLAY CALL
	JRST	GETPC1		;AND PROCESS IT

UNKDST:	XMOVEI	T2,1+[EXP <SIXBIT /UNKNWN/>,0]
GETPC1:	MOVE	T3,-1(T2)	;GET ROUTINE NAME
	TLNN	T3,770000	;FIRST 6 BITS NON-ZERO?
	 JRST	ZERARG		;YES. THERE IS NO ARG LIST

	MOVE	T4,-1(T1)	;GET XMOVEI OR MOVEI AGAIN
	TLNE	T4,17		;INDEXED?
	 JRST	ZERARG		;YES. UNKNOWN ARG LIST
	HRRZ	T3,-1(T1)	;GET ARG LIST ADDRESS FROM MOVEI INSTRUCTION
	HLL	T3,PCSECT	;ADD IN SECTION #
	TLNE	T4,(@)		;INDIRECT XMOVEI?
	 XMOVEI	T3,@(T3)	;YES. RESOLVE IT
	MOVS	T4,-1(T3)	;GET ARG COUNT FROM -1 WORD OF LIST
	CAIL	T4,400000	;MUST BE NEGATIVE
	CAILE	T4,777777
	  JUMPN	T4,GETPCN	;OR ZERO
	SOJA	P1,%POPJ	;DONE

GETPCN:	SOJA	P1,GETPC	;NOT SO, NOT A POSSIBLE PC

ZERARG:	XMOVEI	T3,1+[EXP 0,0]	;POINT T3 AT NULL ARG LIST
	SOJA	P1,%POPJ	;DONE

GETPCE:	SETZ	P1,		;FLAG THAT PDL IS DONE
	SETZ	T1,		;Return a zero.
	MOVE	T2,%STADD	;GET START ADDRESS
	MOVEI	T3,1+[0]	;NO ARGS
	POPJ	P,		;DONE

;ROUTINE TO ADDRESS CHECK A PC
;ARG:	 T1 = ADDRESS
;SKIP RETURN IF ADDRESS OK, NONSKIP OTHERWISE
;ADDRESS IS OK IF IT'S IN LOW SEGMENT, HIGH SEGMENT, OR FOROTS

ADRCHK:
IF10,<				;[3151] This code doesn't work for Tops-20
	CAIGE	T1,140		;BELOW LOW SEG START?
	  POPJ	P,		;NO, BAD
	CAMG	T1,.JBREL	;BELOW LOW SEG END?
	  JRST	%POPJ1		;YES, FINE

	SKIPE	T2,.JBHRL	;GET HIGH SEG POINTER
	CAILE	T1,(T2)		;COULD ADDRESS BE IN HIGH SEG?
	 POPJ	P,		;NO
	HLRZ	T3,T2		;GET HIGH SEG LENGTH
	SUBI	T2,(T3)		;GET HIGH SEG ORIGIN
	CAIL	T1,(T2)		;IS ADDRESS IN HIGH SEG?
	 AOS	(P)		;YES, IT'S OK
	POPJ	P,		;ADDRESS IS ILLEGAL
> ;[3151] End of IF10

IF20,<
FH%EPN==1B19			;[3162] Extended page number (Release 5 symbol)

	TXNE	T1,777B8	;[3155] Does the page number fit on a KL ?
	 POPJ	P,		;[3155] No, can't be a good address
	LSH	T1,-^D9		;[3151] Change to page number
	HRLI	T1,.FHSLF	;[3151] Inquire about our process
	SKIPE	%FSECT		;[3217] Running in a non-zero section ?
	 TXO	T1,(FH%EPN)	;[3162] Yes, don't let section 0 be defaulted
	RPACS%			;[3151] See what the page's attributes are
	 ERJMP	RETURN		;[3151] Definitely not a return PC, punt
	TXNE	T2,PA%PEX	;[3151] Does the page exist ?
	 AOS	(P)		;[3151] Yes, set up for skip (success return)
RETURN:	POPJ	P,		;[3151] Return
> ;[3151] End of IF20

;ROUTINE TO CONVERT AN ADDRESS INTO SYMBOL+OFFSET
;ARG:	 ORGADR = ADDRESS TO CONVERT
;RETURN: SYMNAM = RADIX50 SYMBOL NAME
;	 SYMVAL = VALUE OF SYMBOL
;	 SYMOFF = OFFSET FROM SYMBOL
;	 SYMMOD = RADIX50 MODULE NAME

;THIS ROUTINE FINDS THE LARGEST SYMBOL LESS THAN OR EQUAL TO THE ADDRESS.
;IT IS DESIGNED FOR CONVERTING PCS ... IT ASSUMES THAT THE USEFUL SYMBOLS
;IN ANY ROUTINE HAVE VALUES GREATER THAN THE ROUTINE START ADDRESS.
;ZERO IS RETURNED IN SYMNAM IF THERE IS NO SYMBOL TABLE OR IF THE ADDRESS
;IS NOT IN ANY MODULE (FUNCTION, SUBROUTINE, OR MAIN PROGRAM) IN THE TABLE.
;MODULE NAMES ARE USED AS LAST-DITCH CANDIDATES FOR SYMBOLS.

SYMCNV:	SETZM	SYMNAM		;CLEAR THE MATCHED SYMBOL & VALUE
	SETZM	SYMVAL
	SETZM	SYMMOD		;AND MODULE NAME
	MOVE	T2,.JBSYM	;GET LOW SYMTAB START
	JUMPE	T2,CNVDON	;NONE. ONLY LOOK IN THE LOWSEG FOR NOW
	PUSHJ	P,SYMSRH	;DO A SEARCH
	 JRST	CNVDON		;NO VALID SYMBOLS
	MOVEM	T1,SYMNAM	;SAVE THE SYMBOL NAME
	MOVEM	T2,SYMVAL	;AND ITS VALUE
	MOVEM	T3,SYMMOD	;AND MODULE NAME
	MOVE	T1,ORGADR	;GET ORIGINAL ADDR
	SUB	T1,SYMVAL	;TURN INTO OFFSET FROM SYMBOL FOUND
	MOVEM	T1,SYMOFF	;AND SAVE IT
CNVDON:	POPJ	P,

SYMSRH:	XMOVEI	T4,(T2)		;[3155] Make into global address
	MOVEM	T4,SYMBEG	;[3155] Save address
	HLRE	T2,T2		;GET SYMTAB LENGTH
	MOVM	T2,T2		;[3166] MAKE IT POSITIVE
	ADD	T2,T4		;[3166] GET SYMBOL TABLE END + 1
	SETZB	T4,MODEND	;CLEAR MODULE NAME AND END ADDRESS
	SETZM	SRHVAL		;INITIALIZE BEST-SO-FAR MODULE ADDRESS
	SETZM	SRHSYM		;AND SYMBOL

MODLP:	MOVE	T1,T2		;POINT TO START OF MODULE
	CAMG	T1,SYMBEG	;STILL IN SYMBOL TABLE?
	  JRST	MODLPE		;NO, SEARCH DONE
	HLRE	T2,-1(T1)	;GET -LENGTH OF MODULE SYMBOLS
	SKIPGE	T2		;[3155] If positive, junk symbol table format
	 TRNE	T2,1		;MUST ALSO BE EVEN
	  POPJ	P,		;[3155] Odd, go die
	HRRZ	T3,-1(T1)	;GET LAST WORD IN MODULE, START ADDRESS
	XMOVEI	T3,(T3)		;[3166] INSERT OUR SECTION NUMBER
	MOVE	T4,-2(T1)	;AND NEXT TO LAST, MODULE NAME
	TLNE	T4,740000	;AN ACTUAL MODULE NAME?
	 POPJ	P,		;[3155] No, invalid symbol table format
	ADD	T2,T1		;POINT TO START OF MODULE SYMBOLS

	CAMG	T3,ORGADR	;DOES MODULE START AFTER ADDRESS TO CONVERT?
	CAMGE	T3,SRHVAL	;NO, IS MODULE BETTER THAN PREVIOUS BEST?
	  JRST	MODLP		;NO, LOOP UNTIL FIND APPROPRIATE MODULE

	MOVEM	T1,MODEND	;SAVE END+1 ADDRESS OF MODULE SYMBOLS
	MOVEM	T3,SRHVAL	;SAVE MODULE ADDRESS
	MOVEM	T4,SRHSYM	;AND MODULE NAME AS SYMBOL NAME
	MOVEM	T4,SRHMOD	;ALSO SAVE MODULE NAME FOR MESSAGES
	JRST	MODLP		;SEARCH WHOLE SYMBOL TABLE

MODLPE:	SKIPN	T1,MODEND	;GET END+1 ADDRESS OF SYMBOLS
	 POPJ	P,		;[3155] No suitable module, can't do conversion
	HLRE	T2,-1(T1)	;FIND START ADDRESS OF SYMBOLS
	ADD	T1,T2

;NOW HAVE T1 POINTING TO FIRST SYMBOL IN MODULE, AND
;MODEND = END+1 ADDRESS OF SYMBOLS IN MODULE

SYMLP:	MOVE	T2,1(T1)	;GET A SYMBOL VALUE
	CAMG	T2,ORGADR	;BELOW DESIRED ADDRESS?
	CAMGE	T2,SRHVAL	;YES, BETTER VALUE THAN PREVIOUS BEST?
	  JRST	SYMLPN		;NO, FORGET IT
	PUSHJ	P,SUPCHK	;IS SYMBOL OF FORM <n>M?
	  JRST	SYMLPN		;YES, FORGET IT EVER HAPPENED
	DMOVE	T2,(T1)		;GET SYMBOL AND VALUE
	MOVEM	T2,SRHSYM	;SAVE NEW SYMBOL NAME
	MOVEM	T3,SRHVAL	;SAVE NEW BEST VALUE
SYMLPN:	ADDI	T1,2		;BUMP TO NEXT SYMBOL
	CAMGE	T1,MODEND	;AT END OF MODULE?
	  JRST	SYMLP		;NO, SEARCH WHOLE THING

	AOS	(P)		;INCREMENT RETURN ADDRESS
	MOVE	T1,SRHSYM	;GET SYMBOL
	TLZ	T1,740000	;CLEAR HIGH BITS OF SYMBOL
	MOVE	T2,SRHVAL	;GET ITS VALUE
	MOVE	T3,SRHMOD	;AND GET THE MODULE NAME

	POPJ	P,

	SEGMENT	DATA

PCSECT:	BLOCK	1		;SECTION # FOR GETPC IN LEFT HALF
SRHSYM:	BLOCK	1		;SYMBOL
SRHVAL:	BLOCK	1		;ITS VALUE
SRHMOD:	BLOCK	1		;RADIX50 MODULE NAME FROM SYMBOL SEARCH
ORGADR:	BLOCK	1		;ADDR WE'RE TRYING TO MATCH
SYMBEG:	BLOCK	1		;BEG OF SYMBOL TABLE
MODEND:	BLOCK	1		;MODULE END
SYMNAM:	BLOCK	1		;FINAL SYMBOL
SYMVAL:	BLOCK	1		;FINAL VALUE
SYMOFF:	BLOCK	1		;OFFSET OF ADDR FROM SYMBOL
SYMMOD:	BLOCK	1		;FINAL MODULE NAME

	SEGMENT	CODE

;ROUTINE TO DECIDE IF A SYMBOL SHOULD BE SUPPRESSED FROM TYPEOUT
;ARG:	T1 = POINTER TO SYMBOL
;NONSKIP RETURN IF SYMBOL SHOULD BE SUPPRESSED.

;SUPPRESSED SYMBOLS ARE:
;  COMPILER-GENERATED TEMP LABELS OF THE FORM <DIGITS>M
;  SYMBOLS (CURRENTLY GENERATED ONLY BY MACRO) DEFINED WITH ==
;PRESERVES T1

SUPCHK:	MOVE	T2,(T1)		;GET RADIX50 SYMBOL NAME
	JUMPL	T2,%POPJ	;IF SUPPRESS BIT SET, SUPPRESS SYMBOL
	TLZ	T2,740000	;CLEAR EXTRA BITS
	IDIVI	T2,50		;GET LOW-ORDER CHAR IN T4
	JUMPE	T2,%POPJ1	;IF SYMBOL WAS ONLY 1 CHAR, NOT AN M-SYMBOL
	CAIE	T3,R50(M)	;DOES SYMBOL END WITH M?
	  JRST	%POPJ1		;NO, NOT AN M-SYMBOL

SCHKLP:	IDIVI	T2,50		;GET NEXT CHAR
	CAIL	T3,R50(0)	;IS IT A DIGIT?
	CAILE	T3,R50(9)
	  JRST	%POPJ1		;NONDIGIT, NOT AN M-SYMBOL
	JUMPN	T2,SCHKLP	;CHECK WHOLE SYMBOL FOR DIGITNESS

	POPJ	P,		;SYMBOL IS AN M-SYMBOL, SUPPRESS IT

	PURGE	$SEG$
	END