SEARCH	MTHPRM,FORPRM
	TV	FORERR	ERROR HANDLER,11(5025)

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE 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 V7 Development *****

3271	JLC	14-Feb-83
	Restore the AC's before jumping out of TRACE or exiting it.

3275	RJD	18-Mar-83
	Have TRACE routine print the number of arguments in decimal
	rather than in octal.

3352	MRB	27-Sep-83
	Insert a check for arithmetic trap errors and change the 
	second number to the number of the occurances (of the error).

3353	RJD	30-Sep-83
	Have XTIME routine handle elapsed times with greater
	than 99 hours.

3375	RJD	14-Dec-83	SPR:10-34341
	Have XTIME use the DPOS routine to print hours.

3406	TGS	25-Jan-84	SPR:NONE
	Fix SYMCNV/SYMSRH to properly handle extended addresses.   Values
	fetched from the symbol  table were not  always having a  section
	number inserted.  If  the symbol+offset found  is an offset  from
	MAIN. and there is also a PROGRAM name symbol, prefer the latter.


***** Begin Version 10 *****

4000	JLC	22-Feb-83
	Save/restore ACs around TRACE calls correctly. Move code
	around to prevent GETPC call for library warnings unless
	an ERRSET or break address is set.

4013	PLB	1-Jun-83
	Fix FOREC to be able to type out library errors when
	the error text resides in a different section from FORERR.

4014	JLC	14-Jun-83
	Changed names of some DDB variables so they wouldn't conflict
	with definitions in MACSYM and MONSYM.

4015	PLB	21-Jun-83
	Fix SYMSRH to handle symbol table from another section.

4021	PLB	24-Jun-83
	Teach TRACE% not to use AOBJN.

4031	JLC	7-Jul-83
	Fix FORER% so it uses the lowseg arg list for the user
	subroutine call.

4036	JLC	8-Aug-83
	Widen TRACE output for extended addressing.

4037	JLC	11-Aug-83
	Fix error messages which have no unit number printed
	Also fix TRACE output so it's aligned.

4044	JLC	27-Sep-83
	Changed type code for immediate args to "I" for tracebacks.

4046	JLC	3-Oct-83
	Repair edit 3352. Return sense of %CHKEL is opposite from
	V7.

4047	JLC	5-Oct-83
	Fix GETPC for routines in overlays.

4050	JLC	6-Oct-83
	Modify TRACE to give special trace line for ERRSET subroutine
	calls.

4051	JLC	6-Oct-83
	Fix edit 4050. Setup of L was moved to after it was used.

4052	JLC	12-Oct-83
	Don't print magtape attributes in error lines. Code changes
	necessary for minor performance enhancements for formatted
	I/O.

4061	JLC	4-Nov-83
	Fix IOSTAT bug, set %ERIOS instead of IOSTAT variable,
	set IOSTAT variable in %SETAV at end of I/O.

4064	JLC	14-Nov-83
	Fix updated IOSTAT processing, was not recording IOSTAT value
	if no DDB.

4065	JLC	6-Dec-83
	Remove some unused code.

4066	JLC	11-Jan-84
	More preparations for RMS.

4076	TGS	6-Feb-84
	Fix SYMSRH so it does not depend on the module count word in
	the symble table containing an 18-bit module start address in
	the right half.  Future LINKs may not supply this in non-zero
	sections.  Search for the global symbol corresponding to the
	module name instead.

4077	JLC	6-Feb-84
	Fix tracebacks so they print more information, especially
	in the case of I/O errors where ERRSET has been used. This
	code depends on the previous development effort which
	eliminated IOPDL.

4102	JLC	17-Feb-84
	Use the "standard" filename string code to get the
	filename for error messages. Eliminate the extraneous
	blank in non-filename typeouts. Create a new entry point
	for compatibility message output.

4104	JLC	22-Feb-84
	More compatibility flagging code.

4105	JLC	28-Feb-84
	Change the handling of fatal ("?") error messages to
	always go to a fatal error handler (e.g., %ABORT).
	Add a new entry for DIALOG error handling: %DERR, called
	with a $DCALL, which sets the fatal error handler to
	REQDIA.

4106	JLC	2-Mar-84
	Fix ADRCHK bug - we were calling it with the address in
	the stack entry, then actually peeking at that address-1,
	creating pages on the -20 and getting ill mem ref on the -10.

4107	JLC	5-Mar-84
	Add $E to TOPS-20 message handler, same as $J.

4111	JLC	16-Mar-84
	Add two new entry points (%AERR and %DERR) for fatal error messages.
	Ignore the continuation address, and substitute a fatal
	error handler address (%ABORT or REQDIA) for $AERR and $DERR.

4114	JLC	28-Mar-84
	Remove I%TCH on TOPS-10, as it is almost useless
	and didn't work anyhow.

4116	JLC	4-Apr-84
	Remove $E, substitute (smarter) $J.

4122	JLC	2-May-84
	A whole raft of changes to make the TOPS-10 and TOPS-20
	DDB databases the same.

4123	JLC	5-May-84
	Fix ADRCHK on TOPS-10 for twoseg programs.

4127	JLC	 15-May-84
	Partial fix for ERR= and IOSTAT= freeing of UDB and DDB.
	Eliminate F%DCU.

4131	JLC	12-Jun-84
	Hopefully final fix for ERR= and IOSTAT= freeing of UDB and
	DDB. Add $E for memory full diagnostic. For TOPS-20, save the
	I/O error (retrieved with GETER%) in saved T1, so that recursive
	errors (such as an error on the DIVERT unit) will not lose it.
	Fix the TOPS-10 error diagnostic for "wrong direction for device".

4152	JLC	24-Sep-84
	Use %SVCNV to convert the contents of .JBSYM into address
	and length of symbol table.

4153	JLC	27-Sep-84
	Reference the user program start address indirectly, as it is now
	the address of a location containing the start address.

4154	JLC	1-Oct-84
	Don't call error break subroutine for informational messages
	or FOROTS internal errors.

4155	JLC	17-Oct-84
	Deallocate the rename DDB and UDB on errors with IOSTAT= or ERR=.

4156	JLC	23-Oct-84
	Since we set %UDBAD to -1 in %SAVAC so that it is really a flag
	of whether I/O is in progress, we must check for %UDBAD being
	negative or zero.

***** End V10 Development *****

***** Begin Version 11 *****

5007	TGS	4-Jan-85
	Add RMS error handling.  This becomes an extention of the $J
	JSYS error handling for local disk files.

5010	MRB	5-Feb-86
	Add handeling for long names for in traceback message $S.
	reads sixbit string from HELLO macro. symbol table lookup
	not done yet.


5017	MRB	19-JUN-86
	Fix routine that types out R50 symbol names to type out
	the long (SIXBIT) symbol names it they are there.
	Routines: R50TYP, FND2ST, SRH2ST

5020	MRB	3-JUL-86
	Check to see if the error PC is zero and don't type the 
	symbolic address for $E calls.

5021	MRB	18-AUG-86
	Fix long symbol typeout routine SIXPTR (again).

5025	MRB	10-DEC-86	
	Change routine SIXPTR to use OWGBP to get chars.
	(Only needed when user code and FOROTS are in different 
	sections.)

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

\

	ENTRY	%TRACX,%IOERR,%OTSER,%TRPER
	EXTERN	%UDBAD,%DDBTAB,%FSECT,I.BAT,%PC1,%ABORT,%ABFLG,I.XSIR,O.DIAL
	EXTERN	%SETAV,%FREBL,%EOREC,%HALT,%CIPOS,%CLSCL,%RNAMD,%RNAMU
	EXTERN	E.NAM,%MSGVX,%MSG77,%MSGB,%FLIDX,%IONAM
	EXTERN	%SAVE1,%SAVE2,%SAVE3,AU.ACS
	EXTERN	%ERRCT,%ERRLM,%ERRSB,%ERRSZ,%ERRBK,%NAMLN,%LALAD
	EXTERN	%POPJ,%POPJ1
	EXTERN	%STADD
	EXTERN	%RIPOS,%SIPOS,%IBYTE,%ERFNS,%SVCNV
	EXTERN	FMT.BP,FMT.BG,FMT.SZ,USR.SZ
	EXTERN	A.END,A.ERR,A.IOS,%CUNIT
	EXTERN	%FSECT
	EXTERN	%MSLVL
	EXTERN	%RMDAB,O.KEY					;[5000]
IF20,<	EXTERN	%RMECL,%RMERR,%ERMIN				;[5007]>

	INTERN	%ERNM1,%ERNM2,%UNFXD,%FIXED,%ERTYP,%ERPDP,%ERRPC,%ERCHR
	INTERN	%DFERR,%ERNAM,%LERN1,%LERN2,%ERIOS,%EOPTR,%EOCNT,%ERINI
	INTERN	%DERR,%AERR
	INTERN	%ERNM3
IF20,<	INTERN	%RMPDP,ERRPTR,OCTTYP,ASCTYP,INICHR		;[5007]>
IF20,<	INTERN	%RMEPT,FOREC2,EMSGT0,%ERPTR,ERRCNT		;[5007]>

	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	DQW		;NO. PRINT DISK QUOTA EXCEEDED MESSAGE
	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:	$ACALL	DQE		;AND PRINT ERROR MESSAGE AND DIE
> ;END IF20

;HERE FROM ERROR MACROS
;
;CALLS:
;
;	$DERR	(CHR,COD,N1,N2,MSG,ARGS,FLGS)	;ERROR WITH DIALOG REQUEST
;	$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,

%CMSG:	0			;NO COMPATIBILITY MESSAGE
	%MSGVX			;VAX COMPATIBILITY MESSAGE
	%MSG77			;ANSI-77 COMPATIBILITY MESSAGE
	%MSGB			;BOTH VAX AND ANSI-77

%IOERR:	POP	P,IOERP		;SAVE ARG POINTER
	PUSHJ	P,SVEACS	;SAVE THE ACS ON THE ERROR STACK
	SETZM	FERADR		;NO FATAL ERROR ADDRESS
	JRST	IOER1		;JOIN COMMON CODE

%DERR:	POP	P,IOERP		;SAVE ARG POINTER
	PUSHJ	P,SVEACS	;SAVE THE ACS ON THE ERROR STACK
	XMOVEI	T1,REQDIA	;GET ADDR OF DIALOG REQUEST
	SKIPE	%ABFLG		;[4131] BUT IF WE ARE ABORTING
	 XMOVEI	T1,%ABORT	;[4131] ABORT IT AGAIN
	MOVEM	T1,FERADR	;SAVE AS FATAL ERROR ADDRESS
	JRST	IOER1		;JOIN COMMON CODE

%AERR:	POP	P,IOERP		;SAVE ARG POINTER
	PUSHJ	P,SVEACS	;SAVE THE ACS ON THE ERROR STACK
	XMOVEI	T1,%ABORT	;GET ADDR OF ABORT ENTRY
	MOVEM	T1,FERADR	;SAVE AS FATAL ERROR ADDRESS
IOER1:	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,%FLGS(P2)	;[4131] GET ERROR FLAGS
	TXNE	T1,I%JERR	;[4131] $J IN ERROR MSG?
	 PUSHJ	P,ESAVE		;[4131] YES. GET ERROR CODE INTO SAVED T1
	MOVE	T1,%CHR(P2)	;GET CHARACTER
	CAIN	T1,"$"		;CHARACTER IN ARGUMENT?
	 PUSHJ	P,GETARG	;YES. GET IT
	MOVEM	T1,%ERCHR	;SAVE IT FOR MESSAGE

;If 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
	XMOVEI	T1,@T1		;DO EA CALC

;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 ERRSNS.
	MOVE	T1,%ERNM2	;GET 2ND ERROR NUMBER
	MOVEM	T1,%ERIOS	;SAVE FOR IOSTAT VARIABLE SETTING
	PUSHJ	P,FXTRET	;FIXUP STUFF TO RETURN
	MOVNI	T1,20		;ADJUST ERROR STACK POINTER
	ADDM	T1,ERSTKP	;TOSS THE SAVED FOROTS ACS
	PJRST	%SETAV		;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.
;For V7 and beyond, this code should never be
;executed, since IOSTAT= gets a gratutious ERR= to avoid
;character stack unwinding and function call problems.

	PUSHJ	P,%EMSGT	;Get error message text for ERRSNS.
	MOVE	T1,%ERNM2	;GET 2ND ERROR NUMBER
	MOVEM	T1,%ERIOS	;SAVE FOR IOSTAT VARIABLE SETTING
	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
	MOVNI	T1,20		;ADJUST ERROR STACK POINTER
	ADDM	T1,ERSTKP	;TOSS THE SAVED FOROTS ACS
	PJRST	%SETAV		;RETURN TO USER'S PROGRAM

;Routine to fixup stuff to return from IO error.
;[4131] NEW CODE
FXTRET:	SKIPE	T1,%RNAMU	;[4155] ANY UDB FOR RENAME?
	 PUSHJ	P,%FREBL	;[4155] YES. DEALLOCATE IT
	SKIPE	T1,%RNAMD	;[4155] ANY DDB FOR RENAME?
	 PUSHJ	P,%FREBL	;[4155] YES. DEALLOCATE IT
	SETZM	%RNAMU		;[4155] NOW CLEAR THEIR POINTERS
	SETZM	%RNAMD		;[4155]
	SETZM	O.KEY		;[5007] CLEAR ANY KEY PNTR

	SKIPG	U,%UDBAD	;[4156] ANY DDB ALLOCATED?
	 POPJ	P,		;No. Don't deallocate
	HXRE	T1,UNUM(U)	;GET THE UNIT NUMBER
	CAIG	T1,MAXUNIT	;IS IT A REAL UNIT?
	 CAMGE	T1,[MINUNIT]
	  POPJ	P,		;NO. LEAVE

	SKIPE	%DDBTA(T1)	;IS DDB ESTABLISHED?
	 POPJ	P,		;YES. DON'T FREE IT
	MOVE	D,DDBAD(U)	;GET DDB ADDRESS TO TOSS
	PJRST	%CLSCL		;CLEAN UP AS IF AFTER CLOSE

;Print out the error.

NERR1:	MOVE	P1,P		;USE CURRENT STACK PNTR
	PUSHJ	P,GETPC		;GET CALLER, CALLED ADDR
	MOVEM	P1,%ERPDP	;SAVE NEXT STACK IN CASE NO SYMBOLS
	MOVEM	T1,%ERRPC	;SAVE PC OF CALL
	MOVE	T1,-1(T2)	;[4131] GET NAME OF FOROTS ROUTINE
	MOVEM	T1,%ERNAM	;[4131] SAVE FOR MESSAGE
	SETZM	MSGPC		;ASSUME NO PC DESIRED IN MESSAGE

	PUSHJ	P,%CHKEL	;CHECK IF WE SHOULD PRINT MESSAGE
	 PUSHJ	P,IOMSG		;YES. OUTPUT MESSAGE
	XMOVEI	T1,%EARGL	;GET ADDRESS OF OTS ERROR BLOCK
	MOVEM	T1,EARGPT	;SAVE IT FOR USER SUBR CALL
	SKIPN	FERADR		;ANY FATAL ERROR ADDRESS SET?
	 JRST	CALRET		;NO. GO CALL USER, RETURN
	PUSHJ	P,CALRET	;YES. CALL USER
	JRST	@FERADR		;AND GO TO FATAL ERROR HANDLER

IOMSG:	SKIPE	%NAMLN		;NAME LINE ALREADY OUT?
	 JRST	FOREC		;YES. JUST OUTPUT MESSAGE DIRECTLY

	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
	PJRST	FOREC		;OUTPUT THE MESSAGE

REQDIA:	SKIPGE	I.BAT##		;BATCH?
	  JRST	%ABORT		;YES, DON'T TRY TO DIALOG WITH A .CTL FILE
	SETOM	O.DIAL		;[4131] SET REQUEST FOR DIALOG
	POPJ	P,		;RETURN FROM ROUTINE CONTAINING ERROR


%TRPER:	POP	P,%ERPTR	;GET ERROR BLOCK POINTER
	PUSHJ	P,SVEACS	;SAVE THE ACS ON THE ERROR STACK
	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
	 PUSHJ	P,FOREC		;YES. OUTPUT THE MESSAGE
	XMOVEI	T1,%EARGL	;GET ADDRESS OF OTS ERROR BLOCK
	MOVEM	T1,EARGPT	;SAVE IT FOR USER SUBR CALL
	JRST	CALRET		;GO CALL USER, RETURN

%OTSER:	POP	P,%ERPTR	;GET ERROR BLOCK POINTER
	MOVEM	P,%ERPDP	;SAVE CALLER ADDR FOR MSG
	PUSHJ	P,SVEACS	;SAVE ACS
	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
	 PUSHJ	P,FOREC		;YES. OUTPUT MESSAGE
	XMOVEI	T1,%EARGL	;GET ADDRESS OF OTS ERROR BLOCK
	MOVEM	T1,EARGPT	;SAVE IT FOR USER SUBR CALL
	JRST	CALRET		;GO CALL USER, RETURN

	FENTRY	(MTHER,FORER)
	POP	P,%ERPTR	;SAVE ERROR BLOCK POINTER
	MOVEM	P,%ERPDP	;SAVE PDP FOR NOSYM
	PUSHJ	P,SVEACS	;SAVE ACS
	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	T1,%LALAD	;GET LOWSEG ARG LIST ADDRESS
	MOVEM	T1,EARGPT	;SAVE FOR USER SUBR CALL
	PUSHJ	P,%CHKEL	;CHECK IF WE WANT MESSAGE
	 JRST	FOMSG		;YES. GO GET PC AND OUTPUT MESSAGE
	PUSHJ	P,ECHKU		;CHECK IF USER SUBR TO CALL
	 JRST	FOCALU		;YES. GO GET PC AND CALL USER
	PUSHJ	P,ECHKB		;CHECK IF BREAK SPECIFIED
	 JRST	FOCALB		;YES. GO GET PC AND BREAK
	JRST	ERRET		;RETURN

FOMSG:	PUSHJ	P,FOGPC		;GET PC
	PUSHJ	P,FOREC		;OUTPUT MESSAGE
	JRST	CALRET		;GO CALL USER, RETURN

FOCALU:	PUSHJ	P,FOGPC		;GET PC
	JRST	CALRET		;CALL USER, RETURN

FOCALB:	PUSHJ	P,FOGPC		;GET PC
	PUSHJ	P,ECALB		;CALL BREAK
	JRST	ERRET

FOGPC:	MOVE	P1,%ERPDP	;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
	POPJ	P,

CALRET:	PUSHJ	P,ECALU		;CALL USER IF SPECIFIED
	PUSHJ	P,ECALB		;CALL BREAK ROUTINE
ERRET:	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.
FOREC2:	PUSHJ	P,EMSGT1	;[5007] FINISH ERROR MESSAGE

	MOVE	T1,[POINT 7,ERRBUF] ;GET POINTER TO ERROR BUFFER
	MOVEM	T1,%EOPTR	;SAVE IT
	MOVEI	T1,5*LERRBF-1	;GET ORIGINAL COUNT
	SUB	T1,ERRCNT	;GET # CHARS IN MESSAGE
	MOVEM	T1,%EOCNT	;SAVE IT
	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
	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
	SKIPGE	T2,%NUM1(T1)	;GET 1ST ERROR NUMBER
	 POPJ	P,		;IF NEGATIVE, DON'T CHECK LIMITS
	CAIL	T2,%ERRSZ	;WITHIN ERROR TABLE?
	 POPJ	P,		;NO. DON'T CHECK ANYTHING
	AOS	T4,%ERRCT(T2)	;INCREMENT LIBRARY ERROR COUNT
	MOVE	T3,%CHR(T1)	;GET INITIAL CHARACTER
	CAIN	T3,"?"		;FATAL ERROR?
	 POPJ	P,		;YES. DON'T CHECK LIMITS
	MOVE	T1,%ERNM1	;[3352]get first number 
	CAIGE	T1,10		;[3352]Is it less than 10?
	 MOVEM	T4,%ERNM2	;[3352]Yes; save new second number!
	CAMLE	T4,%ERRLM(T2)	;[3352]PAST LIMIT?
	 AOS	(P)		;YES. SKIP RETURN
	POPJ	P,

ECHKB:	SKIPN	%ERRBK		;ANY BREAK ADDR?
	 AOS	(P)		;NONE
	POPJ	P,

ECALB:	SKIPE	P1,%ERRBK	;[4154] GET BREAK ADDR
	 SKIPGE	%ERNM1		;[4154] DON'T BREAK ON ERRORS WITH NUM1=-1
	  POPJ	P,		;[4154] NO BREAK ADDR OR NUM1 NEGATIVE
ECALB1:	MOVE	L,EARGPT	;GET ARG POINTER
	MOVE	T1,%ERNM1	;GET ERROR CLASS AGAIN
	MOVEM	T1,@%OECN(L)	;SAVE IT
	MOVE	T1,%ERRPC	;GET PC
	MOVEM	T1,@%OEPC(L)	;SAVE IT
	MOVE	T1,%ERNM2	;GET 2ND ERROR NUMBER
	MOVEM	T1,@%OIEN(L)	;SAVE IT
	PJRST	@%ERRBK		;** Call user routine **

ECHKU:	SKIPGE	T1,%ERNM1	;GET ERROR CLASS, NO SUBR IF NEGATIVE
	 JRST	%POPJ1
	CAIGE	T1,%ERRSZ	;WITHIN TABLE?
	 SKIPN	P1,%ERRSB(T1)	;YES. ANY USER TRAP ROUTINE SPECIFIED?
	  AOS	(P)		;NO. SKIP RETURN
	POPJ	P,

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	P1,USRADR	;SAVE ADDR FOR CALL
	MOVE	L,EARGPT	;GET ARG POINTER
	MOVE	T1,%ERNM1	;GET ERROR CLASS AGAIN
	MOVEM	T1,@%OECN(L)	;SAVE IT
	MOVE	T1,%ERRPC	;GET PC
	MOVEM	T1,@%OEPC(L)	;SAVE IT
	MOVE	T1,%ERNM2	;GET 2ND ERROR NUMBER
	MOVEM	T1,@%OIEN(L)	;SAVE IT
	XMOVEI	L,@EARGPT	;GET ARG POINTER IN WAY SO TRACE LIKES IT
UTRAPC:	PUSHJ	P,@USRADR	;CALL USER ROUTINE SO TRACE CAN FIND IT
	POPJ	P,

	-%EAEND+%EARGL,,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
%EAEND=.

	SEGMENT	DATA

ERSTKP:	BLOCK	1		;ERROR AC STACK POINTER
AERACS:	BLOCK	1		;LOCAL ADDR OF SAVED ACS
ERRSTK:	BLOCK	60		;ERROR AC STACK
MSGPC:	BLOCK	1		;PC FOR MESSAGE
IOERP:	BLOCK	1		;IOERR PNTR SAVE LOC
EARGPT:	BLOCK	1		;ARG LIST POINTER
USRADR:	BLOCK	1		;USER ROUTINE ADDR
FERADR:	BLOCK	1		;FATAL ERROR HANDLER ADDRESS

;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
%ERNM3:	BLOCK	1		;[5007] 3RD ERROR NUMBER (STV FOR RMS)
%ERIOS:	BLOCK	1		;2ND ERROR NUMBER FOR IOSTAT
%ERNAM:	BLOCK	1		;ROUTINE NAME FOR MESSAGE
%ERRPC:	BLOCK	1		;PC TO TYPE
%RMEPT:	BLOCK	1		;[5007] RMS ERROR MSG POINTER
%ERPTR:	BLOCK	1		;POINTER TO ERROR BLOCK
%RMPDP:	BLOCK	1		;[5007] RMS ERROR STACK POINTER
%ERPDP:	BLOCK	1		;STACK POINTER FOR GETPC, NOSYM
%ERCHR:	BLOCK	1		;ERROR CHAR FOR I/O ERRORS
%EOPTR:	BLOCK	1		;OUTPUT ERROR MESSAGE POINTER
%EOCNT:	BLOCK	1		;OUTPUT ERROR MESSAGE COUNT

	SEGMENT	CODE

;Routine to save the acs
;Call:	PUSHJ	P,SVEACS
;	<return here>
SVEACS:	DMOVEM	0,@ERSTKP	;SAVE 0 AND 1
	HRRZ	1,ERSTKP	;GET BASE OF SAVED ACS
	MOVEM	1,AERACS	;SAVE LOCAL ADDR OF SAVED ACS
	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 finish error string

EMSGT1:	MOVE	T1,INICHR	;GET INITIAL CHAR AGAIN
	CAIE	T1,"["		;OPEN BRACKET?
	 JRST	EMSGNL		;PUT A NULL CHAR AT END OF MESSAGE
	MOVEI	T1,"]"		;YES, TYPE CLOSING BRACKET
	PUSHJ	P,EPUTCH
EMSGNL:	SETZ	T1,		;PUT A NULL AT END OF STRING
	IDPB	T1,ERRPTR	;BUT DON'T COUNT IT AS A CHARACTER
	POPJ	P,

EMSGT0:	XMOVEI	P3,%MSG(P2)	;[4013] GET GLOBAL ADDR  OF LOCAL BYTE POINTER
	HRR	P3,%MSG(P2)	;[4013] STEAL Y FIELD OF BYTE POINTER
	$BLDBP	P3		;[4013] 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 ROOM FOR 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	"5",$5		;RADIX50 WORD
	XWD	"A",$A		;ASCIZ STRING
	XWD	"C",$C		;ASCII CHAR, RIGHT-JUSTIFIED
	XWD	"D",$D		;DECIMAL NUMBER
	XWD	"E",$E		;ADD A USER PC TO THE LINE [4131] 
	XWD	"F",$F		;FILESPEC FROM DDB [NO ARG, USES (D)]
	XWD	"I",$I		;INCOMPATIBILITY FLAGGER INDEX
	XWD	"J",$J		;JSYS (TOPS-20) OR I/O (TOPS-10) ERROR
	XWD	"L",$L		;TYPE VALUE AS SYMBOL+OFFSET
	XWD	"N",$N		;NAME OF ROUTINE (SIXBIT) FROM %ERNAM [NO ARG]
	XWD	"O",$O		;OCTAL NUMBER
	XWD	"P",$P		;ERROR PC, OCTAL [NO ARG]
	XWD	"R",$R		;RECORD NUMBER
	XWD	"S",$S		;SIXBIT WORD
	XWD	"T",$T		;SPACES TO GET TO COL N
	XWD	"U",$U		;UNIT NUMBER, DON'T TYPE IF NEGATIVE [NO ARG]
	XWD	"X",$X		;XWD FORMAT, OCTAL
	XWD	"Y",$Y		;MS TIME AS HH:MM:SS.SS

LERRTB==.-ERRTAB


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

$U:	SKIPLE	%UDBAD		;[4156] ARE WE IN AN I/O STATEMENT?
	 SKIPGE	%CUNIT		;YES. GET UNIT #
	  POPJ	P,		;NOT I/O OR NEG UNIT, NO UNIT NUMBER
	MOVEI	T1,[ASCIZ / unit /]
	PUSHJ	P,ASCTYP
	MOVE	T1,%CUNIT	;GET THE UNIT NUMBER
	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

$I:	PUSHJ	P,GETARG	;GET OFFENDING COMP INDEX
	AND	T1,%FLIDX	;CALC COMPOSITE INDEX
	MOVE	T1,%CMSG(T1)	;GET ADDRESS OF PROPER STRING
	PJRST	ASCTYP		;OUTPUT MESSAGE

$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	;Get next argument from the list (into T1)

;    [5010] Check to see if the argument is a sixbit word or a pointer to 
;    a (null terminated) sixbit string.

SIXTYP:	MOVE	T2,[POINT 6,T1]	;[5010] Make a byte pointer to the char
	ILDB	T2,T2		;[5010] Grab the first byte
	JUMPE	T2,SIXPTR	;[5010] If it's null then its a pointer

	MOVE	T2,T1		;It's a sixbit word just type it out
SIX1:	JUMPE	T2,%POPJ
	SETZ	T1,
	LSHC	T1,6
	ADDI	T1,40
	PUSHJ	P,EPUTCH
	JRST	SIX1


;+				;[5010]
;  SIXPTR - It's a pointer to a SIXBIT string. Output SIXBIT string.
;	Address of string is in T1.
;	Trashes T2
;-
SIXPTR:	MOVE	T2,[POINT 3,T1,5];[5021]Make a byte pointer
	LDB	T3,T2		;[5021]Get the word count
	SKIPN	,T3		;[5021]It's zero must be SIXBITZ
	 MOVEI	T3,6		;[5021]Set it to the max size
	IMULI	T3,6		;[5021]Calc. max number of bytes

	MOVE	T2,T1		;[5021] Get the address of the string
	TLZ	T2,770000	;[5025] Shut any of these bits off!
	TLO	T2,450000	;[5025] Make the OWGBP
SIXLOP:	ILDB	T1,T2		;[5021] Get a byte
	 JUMPE	T1,%POPJ	;[5021] If it's null then end of string,
	 ADDI	T1,40		;[5021] Else, convert it to ASCII 
	 PUSHJ	P,EPUTCH	;[5021] and type out the character.
	SOJG	T3,SIXLOP	;[5021] Loop for each char in string.
	POPJ	P,		;[5021]End of routine SIXPTR



$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 SECONDS
	JUMPE	T1,TIMEX	;ANY MINUTES?
	PUSH	P,T2		;YES, SAVE SECONDS
	IDIVI	T1,^D60		;[3353] GET MINUTES
	JUMPE	T1,PRMIN	;[3353] ANY HOURS?
	PUSH	P,T2		;[3353] YES, SAVE MINUTES
	MOVE	T2,T1		;[3353] GET HOURS
	PUSHJ	P,DPOS		;[3375] TYPE HOURS
	MOVEI	T1,":"		;[3353] TYPE COLON
	PUSHJ	P,EPUTCH	;[3353]
	POP	P,T2		;[3353] GET MINUTES
	PUSHJ	P,TIMEZ		;[3353] TYPE MINUTES
	TRNA			;[3353]
PRMIN:	PUSHJ	P,TIMEX		;[3353] TYPE MINUTES
	MOVEI	T1,":"		;TYPE COLON
	PUSHJ	P,EPUTCH	;
	POP	P,T2		;GET SECONDS
TIMEZ:	IDIVI	T2,^D10		;[3353] 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.

$E:
ADDPCM:	MOVEI	T1,[ASCIZ/ at /] 
	PUSHJ	P,ASCTYP
	SKIPN	T1,MSGPC	;[5021]Is the PC = zero?
	 JRST	PCTYP		;[5021]just type the PC not symbol!
	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. ']	;AND 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," "		;Output a space?
	PUSHJ	P,EPUTCH
	POP	P,T1

;+				;[5017]
;  R50TYP - Output a RADIX50 symbol name {to the output buffer}.
;		T1 - Contains either a RADIX50 word or a Pointer
;		     to a SIXBIT string {for long symbol names}.
;-
R50TYP:
;
;    [5017] Check to see if the argument is a RADIX50 word or a pointer to 
;    a (null terminated) sixbit string {for long symbol names}. Check to see 
;    if any of the first 4 bits are lit. These bits are used if the address
;    is a byte pointer and cleared for symbols.

	MOVE	T2,[POINT 4,T1]	;[5017] Make a byte pointer to the char
	ILDB	T2,T2		;[5017] Grab the R50 flags.
	JUMPN	T2,SIXPTR	;[5017] If there zero then its a pointer
				;[5017] Otherwise, It's R50 format.
R50LP:	IDIVI	T1,50		
	JUMPE	T1,.+4		;Any more characters?
	PUSH	P,T2		;Yes, put this one on the stack
	PUSHJ	P,R50LP		;     and type it out
	POP	P,T2		;No,  

	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 - Outputs a character to the error message buffer. 
;	T1/ Contains the ASCII character to be output.
;-
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,<

ESAVE:	POPJ	P,		;[4131] ERROR CODE IS ALREADY IN T1!

$J:	MOVE	T1,AERACS	;GET ADDRESS OF SAVED ACS
	MOVE	T1,T1(T1)	;GET SAVED T1
	TXNE	T1,IO.IMP!IO.DER!IO.DTE!IO.BKT!IO.EOF ;[4131] I/O ERROR?
	 JRST	IEROUT		;YES
	CAIL	T1,0		;NEGATIVE?
	CAILE	T1,LERMAX	;OR TOO BIG?
	  JRST	LERUNK		;YES, TYPE GENERAL-PURPOSE MSG

	MOVEI	T2,(T1)		;COPY ERROR CODE
	ADDI	T2,^D250	;ADD 250, BECAUSE V5A DID IT...
	MOVEM	T2,%ERNM2	;Fix error number
	JUMPN	T1,LERNAM	;[4131] NOT AMBIGUOUS
	LOAD	T2,INDX(D)	;[4131] GET DEVICE INDEX
	CAIE	T2,DI.DSK	;[4131] DISK?
	 JRST	WRGDIR		;[4131] NO. GIVE "WRONG DIRECTION" MSG
LERNAM:	IDIVI	T1,4		;[4131] 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,AERACS	;GET ADDRESS OF SAVED ACS
	MOVE	T1,T1(T1)	;GET SAVED T1
	PJRST	OCTTYP		;TYPE IT

WRGDIR:	MOVEI	T1,[ASCIZ /Wrong direction for device/] ;[4131] 
	PJRST	ASCTYP		;[4131] TYPE MESSAGE AND LEAVE

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
	X	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

IEROUT:	PUSHJ	P,%SAVE3	;SAVE P ACS
	MOVEI	T1,[ASCIZ /IO error /]
	PUSHJ	P,ASCTYP
	MOVE	T1,AERACS	;GET ADDRESS OF SAVED ACS
	MOVE	T1,T1(T1)	;GET SAVED T1
	SKIPN	%ERNM2		;IF NO 2ND NUMBER YET
	 MOVEM	T1,%ERNM2	;STORE I/O ERROR 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,PTHB+.PTSTR(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,PTHB+.PTSTR(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


> ;IF10

IF20,<

;[4131] NEW CODE
ESAVE:	LOAD	T1,STS(D)	;[5007] GET STS CODE
	CAMGE	T1,%ERMIN	;[5007] RMS ERROR?
	 TRNA			;[5007] NO
	PJRST	%RMERR		;[5007] YES, HANDLE STS ($SNH NEVER RETURNS)
	MOVEI	T1,.FHSLF	;GET JSYS ERROR NUMBER FOR LAST ERROR
	GETER%
	  ERJMP	.+1
	MOVE	T1,AERACS	;GET ADDRESS OF SAVED ACS
	MOVEM	T2,T1(T1)	;SAVE ERROR CODE IN SAVED AC1
	POPJ	P,

;[4131] NEW CODE
$J:	LOAD	T1,STS(D)	;[5007] GET STS CODE
	CAMGE	T1,%ERMIN	;[5007] RMS ERROR?
	 TRNA			;[5007] NO
	JRST	RMSERS		;[5007] YES, GO HANDLE
	MOVE	T1,AERACS	;GET ADDRESS OF SAVED ACS
	MOVE	T1,T1(T1)	;GET SAVED T1
	MOVEI	T2,(T1)		;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
	EXCH	T1,ERRPTR	;SAVE NEW PNTR, GET OLD ONE BACK
	MOVEI	T2,(T1)		;GET JUST RIGHT HALF
	HRRZ	T3,ERRPTR	;GET JUST ADDRESS OF NEW PNTR
	SUBI	T3,(T2)		;GET # WORDS USED
	IMULI	T3,IBPW		;GET # CHARS USED
	MULI	T1,IBPW		;GET # BYTES NOT USED BY OLD PNTR
	ADDI	T3,(T1)		;ADD THEM
	MOVE	T1,ERRPTR	;GET NEW PNTR AGAIN
	MULI	T1,IBPW		;GET # BYTES NOT USED BY NEW PNTR
	SUBI	T3,(T1)		;SUBTRACT THEM
	MOVNI	T3,(T3)		;GET NEGATIVE
	ADDM	T3,ERRCNT	;DECREMENT COUNT
	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

RMSERS:	MOVE	T1,%RMEPT	;[5007] GET RMS MSG POINTER
	PUSHJ	P,ASCTYP	;[5007] OUTPUT IT
	PJRST	%RMECL		;[5007] CLEAN UP AFTER RMS ERROR

>;END IF20

;Type filespec from DDB
$F:	PUSHJ	P,GETARG	;GET UDB ADDRESS
	JUMPLE	T1,%POPJ	;[4156] IF ZERO, NOTHING TO PRINT
	SKIPN	D,DDBAD(T1)	;GET DDB POINTER
	 POPJ	P,		;NONE. DON'T PRINT TRASH
	MOVEI	T1," "		;OUTPUT SPACE
	PUSHJ	P,EPUTCH
	MOVE	T1,[POINT 7,JFNBUF] ;GET FILESPEC
	PUSHJ	P,%ERFNS
	MOVEI	T1,JFNBUF	;POINT TO FILESPEC BUFFER
	PJRST	ASCTYP		;OUTPUT IT


	SEGMENT	DATA
JFNBUF:	BLOCK	LTEXTW		;Buffer for JFNS string
	SEGMENT	CODE


$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

$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:	SETZM	ERRCNT		;CLEAR # CHARS IN ERROR BUFFER
	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
	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
	AOS	ERRCNT		;INCR # CHARS IN BUFFER
	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
	AOS	ERRCNT		;INCR # CHARS IN BUFFER
	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
	MOVEI	T1,2		;ADD 2 TO COUNT
	ADDM	T1,ERRCNT
	POPJ	P,

BUFTYP:	SETZ	T1,		;DEPOSIT A NULL AT THE END
	IDPB	T1,ER1PTR
	MOVE	T1,[POINT 7,ER1BUF] ;ERROR BUFFER
	MOVEM	T1,%EOPTR	;SAVE IT
	MOVE	T1,ERRCNT	;GET # CHARS IN IT
	MOVEM	T1,%EOCNT	;SAVE IT
	PJRST	%EOREC		;Type it and return

AROUT:	MOVE	T4,[POINT 7,ER1BUF] ;POINT TO ERROR BUFFER AGAIN
	MOVE	T3,ERRPOS	;GET SPACE COUNT
	SOJLE	T3,PUTARO	;IF 1, JUST OUTPUT THE ARROW
	SETZB	T0,T1		;NO SOURCE
	EXTEND	T0,[EXP <MOVSLJ>," "] ;PAD WITH SPACES
	 $SNH
PUTARO:	MOVEI	T1,"^"		;PUT IN ARROW
	IDPB	T1,T4
	SETZ	T1,		;AND FINALLY A NULL CHAR
	IDPB	T1,T4
	MOVE	T1,[POINT 7,ER1BUF] ;POINT TO IT YET AGAIN
	MOVEM	T1,%EOPTR	;SAVE IT
	MOVE	T1,ERRPOS	;AND SAVE # CHARS IN ARROW LINE
	MOVEM	T1,%EOCNT
	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:	SETZM	ERRCNT		;CLEAR # CHARS IN ERROR BUFFER
	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,FMTCNT	;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,FMTCNT	;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

	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			;[5007] 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
FMTCNT:	BLOCK	1		;FORMAT SIZE FOR PRINTING

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$1T($O)$31T$[$[--$36T$S$1O$1T($O)$71T$D$75T$A>,<RNAME,RPC,CNAME,OFFS,CPC,TRARGS,RGPTR>)	;[5010]
	$ERR (,TR2,-1,0,<$S$1T($O)$31T$[$[--$36TERRSET subroutine call$71T$D$75T$A>,<RNAME,RPC,TRARGS,RGPTR>)		;[5010]
	$ERR (,TRC,-1,0,<      Name (Loc)               $[$[--       Called From (Loc)          Args  Types>)		;[5010]

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

	SETZM	MSGPC		;NO PC ON EACH MESSAGE, PLEASE
	MOVE	P1,P		;GET TRACE PDP
	PUSHJ	P,GETPC		;GET TOP CALL ON STACK
	JUMPE	P1,ERRET	;NONE THERE, RESTORE ACS AND RETURN
	MOVEM	P1,SAVPC	;SAVE DECREMENTED PC

	MOVEM	T1,CPC		;[3155] Save caller PC
	MOVEM	T2,RPC		;[3155] Save routine address
	MOVEM	T3,TRARGS	;[4021] SAVE ARGLIST 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	;[4021] RETRIEVE ARGLST
	HLRE	T4,-1(T3)	;[4021] COUNT
	MOVNM	T4,TRARGS	;STORE FOR ERR MACRO
	SKIPN	T5,TRARGS	;[4021] ANY ARGS?
	  JRST	TRCSHO		;  NOPE, GO DISPLAY
	CAIG	T5,STRLEN	;[4021] TOO MANY ARGS TO DISPLAY?
	  JRST	TRCPTR		;  NOPE, GO FINISH SETTING UP
	MOVEI	T5,STRLEN	;[4021] SET COUNTR 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
	AOJ	T3,		;[4021] BUMP ARG PTR
	SOJG	T5,TRCRGL	;[4021] LOOP IF MORE ARGS

TRCSHO:	XMOVEI	T1,E.TR1+%EOFF	;OUTPUT A TRACE LINE
	MOVE	T2,CPC		;GET CALLER PC
	XMOVEI	T3,UTRAPC	;GET EXTENDED ADDR OF ERRSET CALL LOC
	CAMN	T2,T3		;IS IT AN ERRSET CALL?
	 XMOVEI	T1,E.TR2+%EOFF	;YES. USE AN ALTERNATE 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
	MOVEM	T3,TRARGS	;[4021] SAVE ARGLST 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
	PUSHJ	P,FOREC		;AND LEAVE
	JRST	ERRET		;GO RESTORE ACS

STRWDS==3		;WORDS TO ACCOMODATE ARGUMENT SYMBOL STRING
STRLEN==5*STRWDS	;5 ASCII BYTES PER WORD
;		 0123456701234567
TYPCOD:	ASCII	/ILIUFUOSDIOGXCUH/
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:	JUMPE	P1,%POPJ	;DON'T PROCEED ON ZERO!
	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
	SUBI	T1,1		;LOOK AT THAT ADDR-1
	MOVEM	T1,PCADR	;SAVE IT
	HLLZM	T1,PCSECT	;SAVE SECTION #

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

	MOVE	T1,PCADR	;GET ADDRESS AGAIN
	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 PUSHJ 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,1(T2)	;GET THE WORD AFTER THE JSP
	MOVE	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

	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
	JUMPE	T3,ZERARG	;Is there a null arg list ptr?
	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:	TXNE	T1,777B8	;[3155] Does the page number fit on a KL ?
	 POPJ	P,		;[3155] No, can't be a good address

IF10,<
	HLLZ	T3,T1		;GET SECTION NUMBER OF PC
	MOVEI	T1,(T1)		;AND MAKE PC SECTION-LOCAL
	HRRZ	T2,.JBREL(T3)	;GET LOWSEG END IN PC SECTION
	CAMG	T1,T2		;BELOW LOW SEG END?
	 JRST	%POPJ1		;YES, FINE

	HRRZ	T2,.JBHRL(T3)	;GET HIGH SEG HIGHEST ADDRESS
	JUMPE	T2,%POPJ	;NONE
	CAILE	T1,(T2)		;COULD ADDRESS BE IN HIGH SEG?
	 POPJ	P,		;NO
	HLRZ	T3,.JBHRL(T3)	;GET HIGH SEG LENGTH
	SUBI	T2,-1(T3)	;GET HIGH SEG ORIGIN
	TRZ	T2,777
	CAIL	T1,(T2)		;IS ADDRESS IN HIGH SEG?
	 AOS	(P)		;YES, IT'S OK
	POPJ	P,		;ADDRESS IS ILLEGAL
> ;END IF10

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

	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
	SKIPE	T1,.JBSYM	;[4152] GET SYMTAB POINTER OR VECTOR ADDRESS
	 PUSHJ	P,%SVCNV	;[4152] CONVERT VECTOR OR IOWD TO ADDRESS/LENGTH
	JUMPE	T1,CNVDON	;[4152] NONE.
	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,


; SYMBOL SEARCH ROUTINE:
; T2/	SYMBOL TABLE LEN
; T3/	SYMBOL TABLE ADDR
;[4076]
; SEARCHS THE SYMBOL TABLE POINTED TO BY T3 FROM BOTTOM TO TOP.  THE MODLP
; PASS THROUGH THE TABLE LOOKS FOR THE BEST MODULE CANDIDATE WITHIN WHICH
; THE PC TO BE CONVERTED IS LOCATED. RETRIEVE THE RADIX 50 MODULE NAME
; AND SEARCH BACKWARDS FOR ITS GLOBAL EQUIVALENT R50 NAME WITHIN THE MODULE.
; FETCH ITS GLOBAL VALUE. IF THIS VALUE IS THE CLOSEST VALUE YET FOUND 
; LESS THAN/EQUAL THE ORIGINAL PC, STORE IT IN SRHVAL, THE END+1 SYMTAB ADDRESS
; OF THE MODULE IN MODEND, AND THE MODULE NAME IN SRHSYM AND SRHMOD. AFTER
; ONE PASS THROUGH THE SYMBOL TABLE, THE CLOSEST MODULE WILL EITHER HAVE
; BEEN FOUND OR A +1 RETURN WILL INDICATE SEARCH FAILURE.
;
;SYMBOL TABLE FORMAT:

;	  	~----------------------------~<= Symbol table start
;		~			     ~
;	        |----------------------------|<= Module symbol table start
;             / | F !    Radix50 name	     |<= MODBEG
;  symbol pair	|----------------------------|
;	      \	|        value		     |
;	        |----------------------------|
;             / | F !    Radix50 name	     |
;  symbol pair	|----------------------------|
;	      \	|        value		     |
;	        |----------------------------|
;	  	~			     ~
;		~			     ~
;		|----------------------------|
;             /	| F ! Radix50 Module name    |<= Flags=0
;     end pair  |----------------------------|
;	      \	|   -length,,start addr      |  -length,,0 in non-zero sections
;	        |----------------------------|<= End module symbols, start next
;		| F !   Radix50 name         |<= MODEND (END+1) 
;		|----------------------------|
;		|       value		     |
;		|----------------------------|
;	  	~			     ~
;		~			     ~
;		|----------------------------|<= End symbol table
;
;  F => bits 0-3 in the Radix50 word, where:
;
;       bit 0 (400000) => On if symbol is deleted output
;	bit 1 (200000) => On if symbol is deleted input
;	bit 2 (100000) => On if symbol is local
;	bit 3 (040000) => On if symbol is global
;    If 0-3 are off (740000), the symbol is a program name

; ALL FORTRAN MODULES WILL HAVE A GLOBAL R50 MODULE NAME. MACRO MODULES
; MAY NOT, IN WHICH CASE A SYMBOL+OFFSET FROM THE CLOSEST PREVIOUS FORTRAN
; MODULE (OR MACRO MODULE WITH GLOBAL MODULE SYMBOL) WILL BE RETURNED.
; IF THERE ARE NO PREVIOUS FORTRAN OR GLOBAL MACRO MODULES, A +1 RETURN
; DEFAULTS TO "MAIN.+n".

; ONCE A MODULE CANDIDATE IS FOUND, SYMLP SEARCHES THE MODULE FROM TOP DOWN
; FOR THE CLOSEST SYMBOL PLUS OFFSET.


SYMSRH:	MOVEM	T1,SYMBEG	;[4015] SAVE ADDRESS
	ADD	T2,T1		;[4015] GET SYMBOL TABLE END + 1
	MOVEM	T2,MODBEG	;[4076] INITIALIZE MODULE BEGINNING ADDRESS
	SETZM	MODEND		;[3406] CLEAR MODULE END ADDRESS
	SETZM	SRHVAL		;INITIALIZE BEST-SO-FAR MODULE ADDRESS
	SETZM	SRHSYM		;AND SYMBOL

MODLP:	MOVE	T1,MODBEG	;[4076] 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
	CAIGE	T2,0		;[4015] IF POSITIVE, JUNK SYMBOL TABLE FORMAT
	 TRNE	T2,1		;MUST ALSO BE EVEN
	  POPJ	P,		;[3155] Odd, go die
	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
	TLO	T4,040000	;[4076] SET ITS GLOBAL FLAG FOR COMPARISON
	ADD	T2,T1		;POINT TO START OF MODULE SYMBOLS
	MOVEM	T2,MODBEG	;[4076] SAVE
	XMOVEI	T2,-4(T1)	;[4076] POINT AT LAST PAIR IN MODULE
MODLP2:	MOVE	T3,(T2)		;[4076] GET ENTRY
	CAMN	T3,T4		;[4076] SAME AS MODULE NAME?
	 JRST	MODLPM		;[4076] YES, GET GLOBAL ADDRESS
	SUBI	T2,2		;[4076] NO, POINT TO PREVIOUS ENTRY PAIR
	CAML	T2,MODBEG	;[4076] AT START OF MODULE?
	 JRST	MODLP2		;[4076] NO, KEEP TRYING
	JRST	MODLP		;[4076] YES, TRY NEXT MODULE

MODLPM:	MOVE	T3,1(T2)	;[4076] YES, GET ITS GLOBAL VALUE
	TLNN	T3,-1		;[4076] ALREADY A SECTION NUMBER?
	 HLL	T3,T2		;[4076] NO, INSERT IT

	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
	TLZ	T4,040000	;[4076] CLEAR GLOBAL FLAG
	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

;+				;[5017]
;  Search for a long symbol table name in the DDT symbol table.
;  If the symbol named .SYMTB is found in this module then there
;  is a secondary symbol table that must be searched. Otherwise,
;  just search the DDT symbol table.
;-
	MOVEM	T1,MODBEG	;Save {address of first symbol in module}
FND2ST:	DMOVE	T2,(T1)		;Get a symbols' name and value
	CAMN	T2,[RADIX50 10,.SYMTB] ;Is it .SYMTB ????
	 JRST	SRH2ST		;Yes, Go search long symbol table
				;Otherwise, continue searching
	ADDI	T1,2		;Bump address to next symbol name
	CAMGE	T1,MODEND	;Reached END OF MODULE?
	 JRST	FND2ST		;No, Continue searching...
	
	MOVE	T1,MODBEG	;Restore address of first symbol in module
	JRST	SYMLP		;Go Search DDT symbol table {.SYMTB not found}

;+				;[5017]
;  SRH2ST - Search the secondary symbol table. 
;  T3 contains address of the long symbol table
;-

SRH2ST:	MOVE	T4,(T3)		;Number of symbols in table
	AOJ	T3,		;Increment to first symbol entry
	DMOVE	T1,(T3)		;Get module name from table (and addr)
	MOVEM	T2,SRHVAL	;Save modules address
	MOVEM	T1,SRHMOD	;Save modules name
	MOVEM	T1,SRHSYM	;Save module name as symbol name
	SETOM	SRHLSM		;Set flag "this is a long symbol"
;
; If the count of symbols in the long symbol table is one then, this table
; contains only the module name.  The other symbols are in the DDT table.
;
	CAIE	T4,1		;Is there more than one symbol in table?
	 JRST	SRH2LP		;Yes, Search entire long symbol table
	MOVE	T1,MODBEG	;No, Restore address of first symbol in module
	JRST	SYMLP		;Go Search DDT symbol table {.SYMTB not found}
	 

SRH2LP:	DMOVE	T1,(T3)		;Get byte pointer and value
 	CAMG	T2,ORGADR	;.GT. Requested symbols' value
	 CAMG	T2,SRHVAL	;.AND. Closer to req syms' value
	  JRST	SRH2LE		;No, continue searching

	MOVEM	T2,SRHVAL	;Save symbols' value
	MOVEM	T1,SRHSYM	;Save byt pointer to symbol name string
	
SRH2LE:	ADDI	T3,2		;Adjust pointer to next symbol
	SOJG	T4,SRH2LP	;Decrement counter and loop

	AOS	(P)		;Increment return address
	MOVE	T3,SRHMOD	;Get the module name
	POPJ	P,		;Return

;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
	XMOVEI	T2,(T2)		;[3406] GET SECTION NUMBER
	CAMG	T2,ORGADR	;BELOW DESIRED ADDRESS?
	CAMG	T2,SRHVAL	;[3046] 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
	XMOVEI	T3,(T3)		;[3406] GET SECTION NUMBER
	MOVEM	T3,SRHVAL	;SAVE NEW BEST VALUE
	SETZM	SRHLSM		;Clear long symbol flag
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
	SKIPN	0,SRHLSM	;Is this a long symbol?
	TLZ	T1,740000	;No, CLEAR HIGH BITS OF SYMBOL
	MOVE	T2,SRHVAL	;GET ITS VALUE
	MOVE	T3,SRHMOD	;AND GET THE MODULE NAME

	POPJ	P,

	SEGMENT	DATA

PCADR:	BLOCK	1		;ADDRESS FOUND IN STACK ENTRY
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
SRHLSM:	BLOCK	1		;Symbol in SRHSYM is a byte pointer to a
				; long symbol name. {Don't clear flag bits}
ORGADR:	BLOCK	1		;ADDR WE'RE TRYING TO MATCH
SYMBEG:	BLOCK	1		;BEG OF SYMBOL TABLE

MODEND:	BLOCK	1		;MODULE END
MODBEG:	BLOCK	1		;[4076] MODULE START

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