;;;   -*-MIDAS-*-
;;;   **************************************************************
;;;   ***** MACLISP ****** MACLISP ERROR HANDLERS, AND MSGS ********
;;;   **************************************************************
;;;   ** (C) COPYRIGHT 1981 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;;   ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;;   **************************************************************

SUBTTL	ERROR UUO HANDLERS

.SEE EPRINT
EPRNT1:
	PUSHJ P,SAVX5		;ERROR PRIN1
	PUSH P,AR1	.SEE ERROR3
	PUSHJ P,MSGFCK
	SKIPN V%PR1
	 JRST EPRNT2
	MOVEI B,(AR1)
	CALLF 2,@V%PR1
	JRST EPRNT3

EPRNT2:	TLO AR1,200000
	PUSHJ P,$PRIN1
EPRNT3:	STRT 17,[SIXBIT \ !\]
	POP P,AR1
	JRST RSTX5


ERROR1:	MOVEM TT,UUTTSV
	MOVEM R,UURSV
EROR1Z:	JSP TT,ERROR9		;PROCESS A LISP ERROR
	 JRST EROR1A		; (LERR AND LER3)
	PUSHJ P,MSGFCK
	MOVEI D,-2(P)		;D POINTS TO ERRFRAME
	PUSHJ P,ERROR3
EROR1A:	MOVEI A,NIL
	JRST 2,@[ERRRTN]

;;; MSGFILES CHECK.  GET VALUE OF MSGFILES IN AR1 AFTER CHECKING FOR
;;; VALIDITY.  IF A LOSER, SIGNAL AN ERROR AFTER RESTORING IT TO (T).
;;; SAVES A.

MSGFCK:	HRRZ AR1,VMSGFILES
SFA$	JSP F,MSGFC1		;MAKE SURE AN SFA NEVER GETS INVOKED FROM
SFA$	0			; MPFLOK, BUT STILL DO VALIDITY CHECK
SFA$ MSGFC1:
	PUSHJ P,MPFLOK		;SKIPS IF LIST OF FILES *NOT* VALID
CMSGFCK: POPJ P,MSGFCK
	PUSH P,A
	MOVEI B,QTLIST
	MOVEI A,QMSGFILES
	PUSHJ P,BDGLBV
	POP P,A
	JRST MSGFCK


SUBTTL	ERRFRAME FORMATS

;;; FORMAT OF ERRFRAME:
;;;
;;; [1] NORMAL TYPE ERROR (ERINT, LERR, ETC.)
;;;		<SP>,,<RETURN FROM ERROR IF ERINT>
;;;		$ERRFRAME
;;;		<UUO>		;ADDRESS OF MSG IN RIGHT HALF
;;;		<S-EXP>		;FOR ERINT, LER3
;;;
;;; [2] ERRBAD TYPE ERROR (ILL MEM REF, ETC.)
;;;		<SP>,,<ADDRESS WHERE ERROR OCCURRED>
;;;		$ERRFRAME
;;;		0,,<ADDRESS OF MSG>
.SEE ERRBAD

ERROR9:	PUSH P,UUOH
	HRLM SP,(P)
	PUSH P,[$ERRFRAME]	;RANDOMNUMBER,,EPOPJ
	PUSH P,40		;CANNOT HAVE LH = 0; SEE ERRPRINT
	PUSH P,A
LERFRAME==:4			;LENGTH OF ERRFRAME - WATCH THIS IN CASE OF CHANGE

IFN ITS,[
	.SUSET [.SPICLR,,XC-1]
	.SUSET [.SDF1,,R70]
	.SUSET [.SDF2,,R70]
]		;END OF IFN ITS
IFN D10+D20, PUSHJ P,REAINT	;RE-ENABLE INTERRUPTS
EROR9A:	SKIPN PSYMF
	 SKIPE ERRSW
	  JRST 1(TT)
	JRST (TT)

;;; ERROR RETURN.  COME HERE TO PERFORM AN ERROR BREAKOUT (RETURN
;;; TO ERRSET OR TOP LEVEL).  VALUE TO RETURN FROM ERRSET IN A.

ERRRTN:	SETZM NOQUIT
IFN ITS,[
	.SUSET [.SPICLR,,XC-1]
	.SUSET [.SDF1,,R70]
	.SUSET [.SDF2,,R70]
]		;END OF IFN ITS
IFN D10+D20, PUSHJ P,REAINT	;RE-ENABLE INTERRUPTS
	PUSH P,A
	SKIPL A,UNREAL
	 PUSHJ P,CHECKU		;CHECK FOR ANY DELAYED "REAL TIME" INTS
	POP P,A
ERR2:	SKIPE ERRTN		;TO TOPLEVEL, OR BREAK OUT OF AN ERRSET
	 JRST ERR0		;GO BREAK UP AN ERRSET
LSPRT0:	PUSH FXP,CATRTN		;RETURN TO TOP LEVEL FROM LISP ERROR
	JSP A,ERINI0
	POP FXP,CATRTN		;GJS NEEDS TO THROW FROM A *RSET-TRAP
CLSPRET:
	SETZ A,LSPRET
	SKIPE B,V.TRAP		;INVOKE *RSET-TRAP
	 CALLF 1,(B)
	MOVE A,VERRLIST
	MOVEM A,VIQUOTIENT
	JUMPE A,LSPRET
	HRRZ T,C2
	HRRZ T,1(T)
	CAIE T,HACENT		;MEANS BUG ON ERRLIST
	 JRST LSPRET
	MOVE A,VERRLIST
	MOVEI B,QERRLIST
	PUSH P,CLSPRET



SUBTTL	ERINT, SERINT, LERR, LER3

;ERROR3:	0	;PRINT OUT ERROR MESSAGE FOR ORDINARY
			; LISP ERRORS (LERR, LER3, ERINT, SERINT)
ERROR3:				;CALLED VIA  PUSHJ P,ERROR3
				;POINTER TO $ERRFRAME IN D
	JUMPE AR1,CPOPJ
	MOVEI A,TRUTH		;PREVENT AUTO-TERPRI IN THE
	JSP T,SPECBIND		; MIDDLE OF AN ERROR MESSAGE
	   0 A,V%TERPRI		;SPECBIND SAVES D
	HRLI AR1,200000		;OUTPUT FILES LIST FOR MSG IN AR1
	LDB TT,[331100,,1(D)]	;P HAS BEEN STACKED UP BY ERROR9
	JUMPE TT,EROR3C		;ERRBD2 PUSHS MSG WITH NO LERR OPERATION
	HRRZ A,2(D)		;MUST FETCH THE S-EXPRESSION TO PRINT
	STRT AR1,[SIXBIT \^M;!\]	;PRECEDE MSG WITH A ";"
	CAIE TT,LERR_-33	;LERR DOESN'T PRINT AN S-EXP
	 PUSHJ P,EPRINT
	CAIN TT,SERINT_-33	;SERINT HAS AN S-EXP MSG
	 JRST EROR3F
	LDB A,[270400,,1(D)]	;IF IT IS LERR OR LER3, THEN
	CAIE TT,ERINT_-33	; A NON-ZERO AC FIELD MEANS
	 JUMPN A,EROR3F		; THE MSG IS AN S-EXP
EROR3C:
	STRT AR1,@1(D)		;NOTE: THIS CLOBBERS UUOH LEVEL VARS
EROR3E:	STRT AR1,STRTCR
	JRST UNBIND

EROR3F:
	HRRZ A,1(D)
	PUSHJ P,$PRINC
	JRST EROR3E


;;; PROCESS ERINT/SERINT CORRECTABLE INTERRUPTS

ERROR5:	MOVEM TT,UUTTSV
	MOVEM R,UURSV
	SKIPN ERRTN		;ALLOW USER INTERRUPT TO RUN,
	 JRST EROR5F		; EVEN IF INSIDE AN ERRSET,
	SKIPN VERRSET		; IF THE ERRSET BREAK IS SET
	 JRST ERROR1		;OTHERWISE, JUST DO NORMAL ERROR
EROR5F:	LDB TT,[270400,,40]
	CAIGE TT,NERINT		;TT HAS AC FIELD FROM UUO
	 SKIPN VUDF(TT)
	  JRST ERROR1		;CONVERT TO LER3 IF NOT ENABLED
	MOVEI T,ERRV		;NORMAL XIT FROM CODE BELOW IS POP2J,
	CAIE TT,<%IOL_-27>&17	;IO-LOSSAGE
	 CAIN TT,<%FAC_-27>&17	;FAIL-ACT
	  MOVEI T,EVAL.A
EROR5A:	PUSH FXP,T
	MOVEI T,(TT)	;SAVE AC NUMBER FOR BELOW
	JSP TT,ERROR9	;PUSH AN ERROR FRAME
	 JFCL
	MOVEI A,(A)
	PUSH FXP,T
	JSP T,PDLNMK
	EXCH D,(FXP)
	CAIG D,<%UGT_-27>&17
	 PUSHJ P,ACONS
	PUSH P,A		;FOR GC PROTECTION ONLY
	TRO D,2000		;ERINT SERIES USER INTERRUPT
	HRLI D,(A)
	MOVE TT,UUTTSV
	MOVE T,UUTSV
	SKIPN INHIBIT
	 SKIPE NOQUIT
	  .VALUE		;STUPID TO SIGNAL ERROR WHEN INTERRUPTS LOCKED
	PUSHJ P,UINT
	POP FXP,D
	SUB P,R70+1		;GC PROTECTION NO LONGER NEEDED
	JUMPE A,EROR6A
	PUSH FXP,TT
	SKOTT A,LS
	 JRST EROR6A
	POP FXP,TT
	HLRZ A,(A)		;IF ATOM RETURNED, THEN CRAP OUT
				;OTHERWISE, RETURNED VALUE IS LIST OF
	 POPJ FXP,		;CORRECT QUANTITY MUST GO TO EVAL.A OR ERRV
EROR6A:	MOVE A,(P)		;RESTORE A
	MOVEI TT,EROR1Z		;USER DIDN'T SUPPLY SUITABLE VALUE
	JRST EROR9A		;SO ERROR OUT

ERRV:	SUB P,R70+LERFRAME-1	;CLEAR OUT ALL BUT RETURN ADDRESS
	POPJ P,


;;; IOJRST UUO DECODER. USAGE:
;;;		.CALL FOO	;OR .OPEN, OR WHATEVER
;;;		 IOJRST N,FOO
;;; IOJRST CAUSES A TRANSFER TO FOO AFTER PUTTING IN C THE
;;; ADDRESS OF A SIXBIT (STRT FORMAT) STRING INDICATING THE
;;; ERROR MESSAGE.  THIS MESSAGE MAY BE GIVEN TO AN ERINT
;;; UUO (TYPICALLY %IOL).  N IS THE NUMBER OF THINGS ON THE
;;; REGPDL ABOVE THE RETURN ADDRESS - THIS IS A CROCK SO THAT
;;; IOJRST CAN STICK THE ADDRESS OF A RESTORATION ROUTINE
;;; ON THE PDL.  (THIS ISN'T DONE IN THE D10 VERSION, HOWEVER.)
;;; FOR ITS, THE MOST RECENT ERROR AS DETERMINED BY .BCHN IS
;;; OBTAINED VIA THE ERR DEVICE AND STACKED UP ON FLP.
;;; FOR D10, TT IS ASSUMED TO CONTAIN THE LOOKUP/ENTER/RENAME
;;; ERROR CODE OF INTEREST, AND IS USED TO INDEX A TABLE.
;;; FOR D20, THE MOST RECENT ERROR IS OBTAINED FROM THE ERSTR
;;; JSYS AND STACKED UP ON FLP.
;;; CLOBBERS THE JCL BUFFER!
;;; USER INTERRUPTS SHOULD BE INHIBITED.

ERRIOJ:
10%	PUSH P,A		;SAVE ACS
10%	PUSH P,B
IFN D10,[
	HRRE C,TT		;ISOLATE ERROR CODE
	SKIPL C			;IF TT CONTAINS SOME WEIRD
	 CAILE TT,LERTBL	; VALUE, JUST CALL IT THE
	  SKIPA C,ERTBL-1	; "UNKNOWN ERROR"
	   MOVE C,ERTBL(C)	;OTHERWISE USE A STANDARD MESSAGE FROM THE TABLE
]		;END OF IFN D10
IFN ITS+D20,[
	PUSHN P,2		;PUSH 2 SPARE PDL SLOTS
	LDB A,[270400,,40]	;GET N
	ADDI A,2		;ADD 2 FOR PUSHED ACS
	MOVEI C,(P)
ERIOJ1:	MOVE B,-2(C)		;SHUFFLE PDL UP TWO SLOTS
	MOVEM B,(C)
	SUBI C,1
	SOJG A,ERIOJ1
	MOVEM FLP,-1(C)		;SAVE CURRENT FLP POINTER
	MOVEI A,ERIOJ9		;PLOP IN ADDRESS OF RESTORATION ROUTINE
	MOVEM A,(C)
	MOVEI C,1(FLP)
	PUSH FXP,C
IFN ITS,[
	.SUSET [.RBCHN,,A]
	.CALL ERIO6B
	 .LOSE 1400
	.CALL ERIOJ6		;GET MOST RECENT ERROR FOR THIS JOB
	 .LOSE 1400
	MOVE A,[440700,,JCLBF]
	MOVEI B,LJCLBF*BYTSWD-1
	.CALL ERIO6A		;READ IT IN USING A SIOT
	 .LOSE 1400
	.CLOSE TMPC,
]		;END OF IFN ITS
IFN D20,[
	HRROI 1,JCLBF
	HRLOI 2,.FHSLF		;GET MOST RECENT ERROR FOR THIS FORK
	HRLZI 3,-<LJCLBF*BYTSWD-1>
	ERSTR
	 HALT			;GROSS ERROR
	 JFCL			;BUFFER NOT BIG ENOUGH
]		;END OF IFN D20
	IDPB NIL,A
	MOVEI A,'#		;# IS THE STRT QUOTE CHARACTER
	PUSH FXP,[440700,,JCLBF]
ERIOJ2:	MOVSI B,(440600,,(FLP))
	PUSH FLP,R70
ERIOJ3:	ILDB C,(FXP)		;GET A CHARACTER OF THE ERROR MESSAGE
	CAIGE C,40
	 JRST ERIOJ8		;ANY CONTROL CHARACTER TERMINATES IT
	CAIGE C,140		;CONVERT CHARACTER TO SIXBIT,
	 SUBI C,40		; ALLOWING LOWER CASE TO WORK
	ANDI C,77
	CAIE C,'#		;SOME CHARACTERS REQUIRE QUOTING
	 CAIN C,'^
	  JRST ERIOJ5
	CAIN C,'!
	 JRST ERIOJ5
ERIOJ4:	IDPB C,B		;DEPOSIT SIXBIT ON FLP
	TLNE B,770000
	 JRST ERIOJ3
	JRST ERIOJ2		;NO MORE ROOM - MUST PUSH ANOTHER WORD

ERIOJ5:	IDPB A,B		;DEPOSIT QUOTING CHARACTER
	TLNE B,770000
	 JRST ERIOJ4		;GO DEPOSIT REAL CHARACTER
	MOVSI B,(440600,,(FLP))
	PUSH FLP,R70		;NEED ANOTHER WORD FIRST
	JRST ERIOJ4

ERIOJ8:	POPI FXP,1		;FLUSH THE BYTE POINTER ON FXP
	POP FXP,C
ERIOJ7:	MOVEI A,'!		;MUST WRITE TERMINANTION INTO STRING
	IDPB A,B
	POP P,B			;RESTORE A AND B
	POP P,A
]		;END OF IFN ITS+D20
	MOVE T,UUTSV
	JRST @40		;THAT'S 40, NOT UUOH!  MUST EFFECT A TRANSFER

IFN ITS,[
ERIO6B:	SETZ
	SIXBIT/STATUS/
	A			;BAD CHANNEL
	402000,,A		;STATUS RETURNED

ERIOJ6:	SETZ
	SIXBIT \OPEN\		;OPEN FILE
	   1000,,TMPC		;CHANNEL NUMBER
	      ,,[SIXBIT \ERR\]	;DEVICE NAME
	1000,,3			;3 MEANS ERROR STATUS IN FN2
	400000,,A

ERIO6A:	SETZ
	SIXBIT \SIOT\		;STRING I/O TRANSFER
	  1000,,TMPC		;CHANNEL NUMBER
	      ,,A		;BYTE POINTER
	400000,,B		;BYTE COUNT
]		;END OF IFN ITS

IFN ITS+D20,[
;;; RESTORATION ROUTINE

ERIOJ9:	POP P,FLP		;RESTORE FLP
	POPJ P,			;NOW REALLY RETRN FROM ORIGINAL FUNCTION
]		;END OF IFN ITS+D20

IFN D10,[
;;; TABLE OF STANDARD LOOKUP/ENTER/RENAME ERRORS

	[SIXBIT \UNKNOWN ERROR!\]
ERTBL:
OFFSET -.
ERFNF%::	[SIXBIT \FILE NOT FOUND!\]
ERIPP%::	[SIXBIT \NON-EXISTENT PPN!\]
ERPRT%::	[SIXBIT \PROTECTION VIOLATION!\]
ERFBM%::	[SIXBIT \FILE BUSY BEING MODIFIED!\]
ERAEF%::	[SIXBIT \FILE ALREADY EXISTS!\]
ERISU%::	[SIXBIT \ILLEGAL SEQUENCE OF UUOS!\]
ERTRN%::
	SA%	[SIXBIT \TRANSMISSION ERROR!\]
	SA$	[SIXBIT \DIFFERENT FILENAME SPECIFIED!\]
ERNSF%::
	SA%	[SIXBIT \NOT A SAVE FILE!\]
	SA$	[SIXBIT \THIS ERROR CAN'T HAPPEN!\]
ERNEC%::
	SA%	[SIXBIT \NOT ENOUGH CORE!\]
	SA$	[SIXBIT \BAD RETRIEVAL ##10!\]
ERDNA%::
	SA%	[SIXBIT \DEVICE NOT AVAILABLE!\]
	SA$	[SIXBIT \BAD RETRIEVAL ##11!\]
ERNSD%::
	SA%	[SIXBIT \NO SUCH DEVICE!\]
	SA$	[SIXBIT \DISK IS FULL!\]
IFE SAIL,[
ERILU%::	[SIXBIT \ILLEGAL UUO!\]
ERNRM%::	[SIXBIT \NO ROOM ON FILE STRUCTURE!\]
ERWLK%::	[SIXBIT \DEVICE WRITE-LOCKED!\]
ERNET%::	[SIXBIT \NOT ENOUGH MONITOR TABLE SPACE!\]
ERPOA%::	[SIXBIT \PARTIAL ALLOCATION ONLY!\]
ERBNF%::	[SIXBIT \BLOCK NOT FREE!\]
ERCSD%::	[SIXBIT \CAN'T SUPERSEDE DIRECTORY!\]
ERDNE%::	[SIXBIT \CAN'T DELETE NON-EMPTY DIRECTORY!\]
ERSNF%::	[SIXBIT \SFD NOT FOUND!\]
ERSLE%::	[SIXBIT \SEARCH LIST EMPTY!\]
ERLVL%::	[SIXBIT \SFD NESTED TOO DEEP!\]
ERNCE%::	[SIXBIT \NO-CREATE FOR ALL SEARCH LISTS!\]
ERSNS%::	[SIXBIT \NON-SWAPPED SEGMENT!\]
ERFCU%::	[SIXBIT \CAN'T UPDATE FILE!\]
ERLOH%::	[SIXBIT \SEGMENTS OVERLAP!\]
ERNLI%::	[SIXBIT \NOT LOGGED IN!\]
]		;END OF IFE SAIL
LERTBL==:.
OFFSET 0
]		;END OF IFN D10


	SUBTTL DEC-10 HAIRY PDL OVERFLOW HANDLER (NEWIO)

IFN D10*<PAGING-1>,[
PDLOV:	MOVE F,INTPDL		;INTERRUPT ROUTINES MUST LOAD INTPDL INTO F
	MOVE R,IPSWD1(F)	;GET OLD INTERRUPT MASK
IFN D10,[
IFE SAIL,[
	TRZ R,AP.CLK		;LEAVE ON ALL EXCEPT CLOCK INTS
	MOVEM R,IMASK		;REMEMBER, ALLOW PDL OV IN PDL OV HANDLER
	APRENB R,
]	;END IFE SAIL
IFN SAIL,[
	TLZ R,4			;TURN OFF <ESC>I INTERRUPTS
	MOVEM R,IMASK
	INTMSK R		;LEAVE ON ALL BUT ESC<I> AND CLOCK INTS
]	;END IFN SAIL
]	;END IFN D10
	HLRZ R,NOQUIT
	JUMPN R,GCPDLOV		;PDL OV IN GC - LOSE, LOSE, LOSE!!!
	MOVEI R,P		;NOW, AS GLS SAYS, "20 QUESTIONS"
	JUMPGE P,PDLH0
	MOVEI R,SP
	JUMPGE SP,PDLH0
	MOVEI R,FLP
	JUMPGE FLP,PDLH0
	MOVEI R,FXP
	JUMPGE FXP,PDLH0
	HLRZ R,NOQUIT
	SKIPN R
	 LERR [SIXBIT \RANDOM PDL OVERFLOW!\]
	JRST INTXT2

PDLH0:	HRRZ D,OC2-P(R)		;GET ORIGION OF OVERFLOW AREA
	CAIGE D,@(R)		;IF OVER THEN LOSE
	 JRST PDLLOS
	CAIG D,@(R)		;IF EQUAL THEN WE HAVE REALLY OVERFLOWED
	 JRST PDLOV1
;IF WE ARRIVE HERE THEN WHAT HAS HAPPENED IS THAT A ROUTINE IS FORCING A
;RECALCULATION OF THE LENGTH OF THE PDL AND THERE DOES NOT ACTUALLY
;EXIST A PDL OV.  THEREFORE, ALL WE HAVE TO DO IS TO CALCULATE THE
;NUMBER OF WORDS REMAINING IN THE PDL AND RETURN TO MAINLINE.
	HRRZ D,(R)		;GET PDL POINTER
	HRRZ F,C2-P(R)		;GET PDL ORIGION
	SUBI D,(F)		;COMPUTE NUMBER OF WORDS USED
	HLRZ F,C2-P(R)		;GET FULL SIZE OF PDL
	ADDI F,(D)		;COMPUTER CURRENT SIZE
	HRLM F,(R)		;STORE LENGTH IN PDL POINTER
	HRRZ F,INTPDL		;THEN JUST RETURN NORMALLY
	JRST INTXT2

;HERE IF WE HAVE A REAL PDL OV BUT STILL HAVE SOME EMERGENCY SPACE TO USE
PDLOV1:	MOVE F,OC2-P(R)		;GET OVERFLOW POINTER
	MOVEM F,(R)		;STORE IN APPROPRIATE PDL
	MOVSI D,QREGPDL-P(R)
	HRRI D,1005		;PDL-OVERFLOW
	HRRZ R,INTPDL
	HRRZ R,IPSPC(R)
	CAIL R,UINT0		;AVOID DEEP INTERRUPT RECURSION:
	 CAILE R,EUINT0		; IF PDL OVERFLOWED WITHIN UINT0,
	  JRST PDLH4		; THEN JUST STACK UP THE INTERRUPT,
	JSR UISTAK		; AND SOMEONE WILL EVENTUALLY TRY CHECKI
PDLRET:	HRRZ F,INTPDL
	JRST INTXT2

PDLH4:	MOVE R,FXP		;ELSE TRY TO GIVE A PDL OVERFLOW
	SKIPE GCFXP		; USER INTERRUPT IMMEDIATELY
	 MOVE FXP,GCFXP		;REMEMBER, PDL OVERFLOW IS NOT
	PUSH FXP,R		; DISABLED INSIDE THE PDL
	PUSHJ FXP,$IWAIT	; OVERFLOW HANDLER!!!
	 JRST XUINT
	JRST INTXIT

PDLLOS:	MOVE P,C2
	MOVE FXP,FXC2
	SETZM TTYOFF
	STRT UNRECOV
	STRT @PDLMSG-P(R)
	JRST DIE

PDLMSG:	POVPDL		;REG
	POVFLP		;FLONUM
	POVFXP		;FIXNUM
	POVSPDL		;SPEC
]		;END OF IFN D10*<PAGING-1>

SUBTTL	UNRECOVERABLE PDL OVERFLOW ACTION

PDLOV5:
IFN ITS,[
	.SUSET [.SPICLR,,XC-1]
	.SUSET [.SDF1,,R70]
	.SUSET [.SDF2,,R70]
]		;END OF IFN ITS
IFN D10+D20, PUSHJ P,REAINT	;RE-ENABLE INTERRUPTS
	STRT UNRECOV
	STRT (B)
	SKIPN ERRTN	;BACK TO TOPLEVEL IF NOT ERRSET
	 JRST LSPRET
	JSP T,GOBRK	;BREAK UP THE ERRSET, AND SEE IF
	MOVEI A,NIL
	HRRZ TT,OFXC2	;ENOUGH PDL SPACE WAS RELEASED
	HRRZ D,OSC2	;THEREBY.  IF NOT, THEN DO MAJOR
	CAILE D,(SP)	;RESTART
	 CAIG TT,(FXP)
	  JRST PDLOV6
	HRRZ D,OC2
	HRRZ TT,OFLC2
	CAILE D,(P)
	 CAIG TT,(FLP)
	  JRST PDLOV6
	JRST (T)	;HERE IS ERRSET'S ERROR EXIT

PDLOV6:	SETZM TTYOFF
	MOVE P,C2
	PUSHJ P,ERRPNU		;UNDO SPECIAL BINDINGS, NO UNWIND-PROTECTS RUN
	STRT MESMAJ
	JRST LISPGO		;BIG RESTART

SUBTTL	ILLEGAL OPERATION AND MEMORY VIOLATION HANDLER


ERRBAD:	MOVE T,UUTSV
	MOVEM D,ERRSVD
	SETZM JPCSAV		;TOO LATE TO GET JPC
	MOVE D,UUOH
IFN ITS,[
	JRST UUOGL2
UUOGL1:	MOVEM D,ERRSVD
	MOVE D,UUOGLEEP
];END IFN ITS
UUOGL2:
IT$	SUBI D,THIRTY+5		;SEE IF LOSING INSTRUCTION WAS AN X
IT$	TRNN D,-1
IT$	 JRST $XLOST
IT$	ADDI D,THIRTY+5-1	;ELSE MOVE PC BACK TO LOSING INST
	SKIPN VMERR		;SKIP IF USER HANDLER
	 JRST UUOGL7
	PUSH FXP,ERRSVD		;YES, SET UP USER INTERRUPT
	PUSH FXP,D
	HRLI D,(D)
	HRRI D,UIMILO+100000	;ILLEGAL OPERATION
	PUSHJ P,UINT
	POP FXP,ERRSVD
	POP FXP,D
	JRST 2,@ERRSVD		;RESTORE MACHINE FLAGS

UUOGL7:	EXCH D,ERRSVD		;NO USER HANDLER
IT$	.CALL UUOGL8		;CRAP OUT TO DDT
10$	OUTSTR [ASCIZ\?ILLEGAL INSTRUCTION - BAD ERROR\]	
	 .VALUE

IFN ITS,[
UUOGL8:	SETZ
	SIXBIT \LOSE\		;TELL DDT WE'RE LOSING
	  1000,,1+.LZ %PIILO	;ILLEGAL OPERATION
	400000,,ERRSVD		;NEW PC

]		;END OF IFN ITS

SUBTTL	MISCELLANEOUS ERROR ROUTINES

;; A REVERSE LISTIFICATION FOR ERROR ROUTINES -- GENERALLY YOU
;;  FIND A VALUE IN A, AND YOU WANT TO LISTIFY IT AND CONS ONTO THAT
;;  SOME QUOTED VALUE
%%RLFE:	PUSHJ P,NCONS
	HRRZ B,@(P)
	PUSHJ P,XCONS
	JRST POPJ1

UUONVE:	PUSHJ P,%%RLFE
	 ,,QNUMBERP
	FAC [NUMBER FUNCTION RETURNED NON-NUMERIC VALUE!]
	JRST UUONVL


NTHIEN:	WTA [ILLEGAL ELEMENT NUMBER - NTH/NTHCDR!]
	JRST NTHCD5
NTHER:	%WTA NAPLMS
	JRST NTHCD2
LASTER: %WTA NAPLMS
	JRST LAST

UUOMER:	HRRZ A,40
	LER3 [SIXBIT \ - MACRO NOT PERMITTED IN UUO CALL!\]
UUOFER:	HRRZ A,40
	LER3 [SIXBIT \ - WRONG NUMBER ARGS IN UUO CALL!\]

IFN BIGNUM,[
REMAIR:	WTA [FLONUM ARG TO REMAINDER!]
	JRST -4(T)
]		;END OF IFN BIGNUM

UNOVER:
IFE NARITH,	TLNN T,100		.SEE %PCFXU	;FLOATING UNDERFLOW
IFN NARITH,	TLNN A,100		.SEE %PCFXU	;FLOATING UNDERFLOW
OVFLER:	LERR [SIXBIT \ARITHMETIC OVERFLOW!\]
UNFLER:	LERR [SIXBIT \ARITHMETIC UNDERFLOW!\]

ER4:	LERR [SIXBIT \GO OUT OF CATCH-BREAK DAMN#!!\]

ADEAD:	JFCL		;PUSHJ OR JRST THROUGH DEAD ARRAY PTR
	MOVEI A,ARQLS	;COULD ALSO GET HERE VIA ACALL/AJCALL
	FAC [ARRAY DEFINITION LOST!]


EG1:	UGT [NOT SEEN AS PROG TAG!]
	JRST GO2

INTNCO:	UNLOCKI			;INTERN CRAP-OUT
	PUSHJ FXP,SAV2 
	MOVEI B,OBARRAY
	MOVEI A,QOBARRAY
	PUSHJ P,BDGLBV
	PUSHJ FXP,RST2
	JRST INTRN4


DFPER:	POPI P,1
	POP P,A
	WTA [WRONG FORMAT - DEFPROP!]
	JRST DEFPROP

DEFNER:	POPI P,1
	POP P,A
	WTA [WRONG FORMAT - DEFUN!]
	JRST DEFUN

REVER:	%WTA NAPLMS
	JRST REV4

NAPLMS: SIXBIT \ARGUMENT MUST BE A PROPER LIST!\

PNGE:
PNGE1:	%WTA NASER
	JRST -2(T)

NASER:	SIXBIT \ATOMIC SYMBOL REQUIRED!\
SBADSP:	SIXBIT \ BAD SPACE TYPE - STATUS!\


;;; INCREDIBLE CROCK TO CONSTRUCT AN ERROR MESSAGE
;;; CONTAINING THE NAME OF THE APPROPRIATE CAR/CDR FUNCTION.

CA.DER:	PUSH FXP,[SIXBIT \ILLEGA\]
	PUSH FXP,[SIXBIT \L DATU\]
	PUSH FXP,[SIXBIT \M - CX\]
	PUSH FXP,[SIXBIT \R!!!! \]
CA.DE1:	TRNN T,776
	JRST CA.DE2
	ROT T,-1
	JRST CA.DE1
CA.DE2:	MOVEI D,-1(FXP)
	HRLI D,060600
CA.DE3:	ROT T,1
	MOVEI TT,'A
	TRNE T,1
	MOVEI TT,'D
	IDPB TT,D
	TRNN T,400000
	JRST CA.DE3
	MOVEI TT,'R
	IDPB TT,D
	%WTA -3(FXP)
	SUB FXP,R70+4
	JRST CR1A



NILSETQ:	PUSH P,A	;SOME NERD TRIED TO SETQ NIL, MAYBE?
	PUSH P,CPOPAJ
	CAIE T,VNIL
	 JRST TSETQ		;NO, 'TWAS REALLY A TSETQ, MAYBE?
	MOVEI A,QNILSETQ
	%FAC NIHIL

TSETQ:	CAIE T,VT
	 JRST XSETQ		;NO, I DON'T KNOW WHAT IT WAS!
	MOVEI A,QTSETQ
	%FAC VERITAS

XSETQ:	HRLM T,QXSET1		;HAND VALUE CELL (?) TO LOSER
	MOVEI A,QXSETQ
	%FAC PURITAS

STORE5:	PUSH P,CSTOR7
STOREE:	HRRZ A,-2(P)
	%WTA [SIXBIT \NOT VALID ARRAY REFERENCE - STORE!\]
	MOVEM A,-2(P)
CSTOR7:	POPJ P,STORE7

RPLCA0:	WTA [BAD ARG - RPLACA!]
	JRST RPLACA
RPLCD0:	WTA [BAD ARG - RPLACD!]
	JRST RPLACD
RPLCA1:	WTA [PURE ARG - RPLACA!]
	JRST RPLACA
RPLCD1:	WTA [PURE ARG - RPLACD!]
	JRST RPLACD

%ARR0A:	WTA [WRONG TYPE ARRAY - ARRAYCALL!]
	JRST %ARR0B
%ARR0:	WTA [NOT ARRAY POINTER!]
%ARR0B:	MOVEM A,1(D)
	JRST %ARR7

LDGETQ:	FAC [CAN'T GET DDT SYMBOL - FASLOAD!]
LDXERR:	LERR [SIXBIT \BAD VALUE FOR "PURE" - FASLOAD!\]
10$ LDYERR:	LERR [SIXBIT \BAD VALUE FOR *PURE - FASLOAD!\]
LDALREADY:
	FAC [INCORRECTLY NESTED FASLOAD!]

IFE BIGNUM*DBFLAG*CXFLAG,[
LDATE9:	QBIGNUM
	QDOUBLE
	QCOMPLEX
	QDUPLEX

LDATER:
HN%	SKIPA A,LDATE9-3(T)
HN$	MOVE A,LDATE9-3(T)
]		;END OF IFE BIGNUM*DBFLAG*CXFLAG
HN% FASHNE:	MOVEI A,QHUNK
IFE HNKLOG*BIGNUM*DBFLAG*CXFLAG, LER3 [SIXBIT \IN FASL FILE, BUT NOT IMPLEMENTED IN THIS LISP!\]

.SEE DBCONS
.SEE CXCONS
.SEE DXCONS
IFE DBFLAG*CXFLAG, NUM1MS: SIXBIT \CONS IN COMPILED CODE, BUT NOT IMPLEMENTED IN THIS LISP!\

IBSERR:	MOVEI B,IN10
	MOVEI A,QIBASE
	PUSH P,[RD0B1]

;; BaD GLoBal Variable routine -- enter with name of variable in A,
;;  with a default 'good' value in B, and with return address on stack
BDGLBV:	PUSH P,C
	HLRZ C,(A)		;GET SY2 BLOCK
	HRRZ C,(C)		; THEN ADDR OF VALUE CELL
	EXCH B,(C)		;SET LOSING VARIABLE TO WINNING VALUE
	POP P,C
	CALLF 2,QLIST
	FAC [BAD VALUE FOR SYSTEM GLOBAL VARIABLE!]


BASER:	MOVEI B,IN10
	MOVEI A,QBASE
	PUSH P,[PRINI]
	JRST BDGLBV


IFN USELESS,[
%LVERR:	SETZ B,
	MOVEI A,Q%LEVEL
	PUSH P,[%LVCHK]
	JRST BDGLBV

%LNERR:	SETZ B,
	MOVEI A,Q%LENGTH
	PUSH P,[%LNCHK]
	JRST BDGLBV

]			;END OF IFN USELESS


SUBTTL	A PANDORA'S BOX OF ERROR MESSAGES
	
	NIHIL:	SIXBIT \NIHIL EX NIHIL - DON'T SETQ NIL!\
	VERITAS: SIXBIT \VERITAS AETERNA - DON'T SETQ T!\
	PURITAS: SIXBIT \FOO - DON'T SETQ PURE VALUE CELL!\
	POVPDL:	SIXBIT \REG PDL OVERFLOW!\
	POVFLP:	SIXBIT \FLONUM PDL OVERFLOW!\
	POVFXP:	SIXBIT \FIXNUM PDL OVERFLOW!\
	POVSPDL: SIXBIT \SPEC PDL OVERFLOW!\
	MESMAJ:	SIXBIT \^M;MAJOR RESTART UNDERTAKEN^M!\
	UNRECOV: SIXBIT \^M;UNRECOVERABLE !\
	FLNMER:
	$ARERR:	SIXBIT \NON-FLONUM VALUE!\
	IARERR:
	FXNMER:	SIXBIT \NON-FIXNUM VALUE!\
DB$	DBNMER:	SIXBIT \NON-DOUBLE VALUE!\
CX$	CXNMER:	SIXBIT \NON-COMPLEX VALUE!\
DX$	DXNMER:	SIXBIT \NON-DUPLEX VALUE!\
	NMV3:	SIXBIT \NON-NUMERIC VALUE!\
IFN BIGNUM+CXFLAG,	NMV5:	SIXBIT \UNACCEPTABLE NUMERIC VALUE!\
	CAMMES:	SIXBIT \FIXNUM CANT COMPARE TO FLONUM.  IN  =, <, OR >!\
	MES5:	SIXBIT \UNDEFINED FUNCTION OBJECT!\
	MES6:	SIXBIT \UNBOUND VARIABLE!\
	MES14:	SIXBIT \NOT INSIDE LEXPR/LSUBR!\
	MES18:	SIXBIT \TOO MANY ARGUMENTS - APPLY!\
	MES19:	SIXBIT \TOO FEW ARGUMENTS - APPLY!\
	MES20:	SIXBIT \WRONG NUMBER OF ARGS!\
	MES21:	SIXBIT \WRONG NUMBER OF ARGS TO FSUBR!\

;	EMS11:	SIXBIT \HOW THE HELL CAN THIS BE?!\	.SEE HHCTB
	EMS12:	SIXBIT \TOO MANY INTERRUPTS - GO AWAY!\
	EMS13:	SIXBIT \LOST USER INTERRUPT!\
	EMS15:	SIXBIT \UNDEFINED FUNCTION IN UUO CALL!\
	EMS16:	SIXBIT \MORE THAN 5 ARGS!\
	EMS18:	SIXBIT \FUNCTION UNDEFINED AFTER AUTOLOAD!\
	EMS21:	SIXBIT \IMPROPER USE OF MACRO - EVAL!\
	EMS22:	SIXBIT \ILGL GO OR RETURN - NOT INSIDE A PROG!\
	EMS25:	SIXBIT \UNEVALUABLE DATUM - EVAL!\
	EMS26:	SIXBIT \FILE NOT FOUND!\
	EMS29:	SIXBIT \NO CATCH FOR THIS TAG - THROW!\
	EMS31:	SIXBIT \INVALID ARG TO GENSYM!\
	EMS34:	SIXBIT \NOT SUBR POINTER!\
	STRTCR:	SIXBIT \^M!\

	NFXIX:	SIXBIT \NON-FIXNUM INDEX!\
	IXEXBD:	SIXBIT \INDEX EXCEEDS BOUNDS!\

;READER ERROR MSGS

	RDRM1:	SIXBIT \EXTRA CHARS - READLIST!\
	RDRM2:	SIXBIT \ILLEGAL TOKEN PARSED - READ!\
	RDRM3:	SIXBIT \NOT ENOUGH CHARS - READLIST!\
	RDRM4:	SIXBIT \DOT CONTEXT ERROR!\
	RDRM5:	SIXBIT \READ-MACRO CONTEXT ERROR!\
	RDRM6:	SIXBIT \BLAST, MISSING ")"!\
	RDRM7:	SIXBIT \BLAST? - READ!\
	RDRM8:	SIXBIT \NUMERIC OVERFLOW - READ!\
	RDRM9:	SIXBIT \SPLICING MACROS RETURN NON-NIL AFTER "." -- READ!\
	RDRM11:	SIXBIT \ILLEGAL VALUE FROM SPLICING MACRO -- READ!\


NAFOS:	
SFA$	SIXBIT \NOT A FILE OR SFA!\
SFA%	SIXBIT \NOT A FILE!\



SUBTTL	YET MORE MISCELLANEOUS ERROR ROUTINES


ERRERC:	POP P,A		;LIKE (ERROR MSG ARGS)
	LER3 1,@(P)

ERRERO:	MOVEI A,(B)
	WTA [INVALID ERROR CHANNEL SPEC!]
	JRST ERRERB

ERERER:	MOVEI D,Q$ERROR
	SOJA T,S2WNAL


EVAL.A:	SUB P,[LERFRAME,,LERFRAME]	;CLEAR OUT ALL OF ERRFRAME
	PUSHJ P,SAVX5			;SAVE EVERYTING AND EVAL A
	PUSHJ FXP,SAV5M1		;ORDINARY FAIL-ACT ERROR.
	PUSHJ P,EVAL
EVAL.1:	PUSHJ FXP,RST5M1
	JRST RSTX5



.UDT:	SKOTTN A,FX+BN			;COME HERE WHEN COMPILED CODE CANT
	 JRST .UDT2			;  FIND A TAG FOR A COMPUTED "GO"
	SKIPN ERRSW
	 JRST .UDT1
	PUSH P,A
	STRT 17,[SIXBIT \^M;IN !\]	;USE MSGFILES, SINCE UGT BELOW WILL
	HRRZ B,-1(P)			;GET RETURN ADDRESS
	HRRZ AR1,VMSGFILES
	TLO AR1,200000
	PUSHJ P,ERRAD1			;AND PRINT OUT FUN THEREFOR
	POP P,A
.UDT1:	UGT [ UNDEFINED COMPUTED GO TAG!]
	POPJ P,

.UDT2:	SETZM PNBUF
	SETZM PNBUF+1
	SETZM PNBUF+2
	MOVEI C,10.
	MOVEI R,.UDT4
	MOVE AR1,[440700,,PNBUF]
	JUMPGE TT,.+3
	MOVNS TT
	%NEG%
	PUSHJ P,PRINI9
	SETOM LPNF
	MOVEI C,(AR1)
	JRST RINTERN

;	ENDCODE [.UDT]

ESB6:	MOVEI D,0
WNAERR:	CAMG TT,T
	 SKIPA TT,[MES19]	;TOO FEW ARGS
	  MOVEI TT,MES18	;TOO MANY ARGS
	MOVEM B,QF1SB
	PUSH FXP,TT
	TRNE D,1		; 1.1 of D ^= 0 => LISTING ALREADY DONE
	  JRST WNAER1
	PUSH FXP,R
	PUSHJ FXP,LISTX
	POP FXP,R
WNAER1:	HLRZ B,(P)
	PUSHJ P,XCONS
	MOVEM A,(P)
	PUSHJ P,ARGSCU
	POP FXP,TT
	JRST QF1A


QF3A:	SKIPA TT,[MES19]	;AT THIS POINT, WE CRAP OUT
QF2A:	 MOVEI TT,MES18
	MOVE T,R
	PUSHJ FXP,LISTX
	HLRZ B,(P)
	JUMPN B,.+2
	 MOVEI B,QM		;QUESTION MARK!
	PUSHJ P,XCONS
	EXCH A,(P)
	JSP T,%CADR
QF1A:	PUSHJ P,NCONS
	POP P,B
	PUSHJ P,XCONS
	%WNA (TT)
	JRST EVAL


UUOH3C:	SOVE A B
	MOVEI T,EMS18
	JRST UUOUE1

UUOH3A:	SOVE A B
UUOUER:	MOVEI T,EMS15
UUOUE1:	MOVNI A,LUUSV		;UNDEFINED UUO CALL
	PUSH FXP,UUOH+LUUSV(A)
	AOJL A,.-1
	PUSH FXP,40
	HRRZ A,40
	%UDF (T)	;UNDEF FUN IN UUO CALL (OR AFTER AUTOLOAD)
	POP FXP,40
	MOVEI T,LUUSV
	POP FXP,UUOH-1(T)
	SOJG T,.-1
	HRRZ T,A
	JUMPN A,UUOUE2
	HRRZ A,40
	PUSHJ P,EPRINT
	LERR [SIXBIT \UNDEFINED FUNCTION CALLED!\]
UUOUE2:	POP P,B
	POP P,A
	CAIE T,QUNBOUND
	 JRST UUOH0A
	JRST UUOH3A

EPRINT:	SKIPN ERRSW		;ERROR PRINTOUT
	 POPJ P,
	JRST EPRNT1

EV3B:	SKIPA A,EV0B
EV3A:	 HLRZ A,AR1
	%UDF MES5		;UNDEFINED FUNCTION OBJECT
	JRST EV4B

EV3J:	HLRZ A,AR1
	%UDF EMS18		;FN UNDEF AFTER AUTOLOAD
	JRST EV4B

IAP2A:	TDZA TT,TT		;UNDEFINED FN OBJECT
IAP2J:	 MOVEI TT,EMS18-MES5	;FN UNDEF AFTER AUTOLOAD
	HLRZ A,(C)
	SKIPN A
	 HRRZ A,(C)
	%UDF MES5(TT)
	HRRM A,(C)
	JRST ILP1

WNAL0:	MOVE D,(TT)
	TLNE D,1		;SKIP IF LSUBR
	 JRST WNAFOSE
WNALOSE:
	PUSHJ FXP,LISTX		;LISTIFY UP LSUBR ARGS
	MOVEI TT,MES20		;USE LSUBR MESSAGE
WNAL1:	MOVEI B,(D)
	PUSHJ P,XCONS		;CONS FUNCTION NAME ONTO ARG LIST
	PUSH P,A
	MOVEI A,QM		;USE ? FOR ARGS SPEC
	JRST QF1A

STERR:	MOVEI D,(F)
WNAFOSE:	MOVEI TT,MES21	;USE FSUBR MESSAGE
	JRST WNAL1


IFN D10,[
FASLUR:	RELEASE TMPC,
FASLUH:	UNLOCKI
	LERR [SIXBIT \CAN'T DEPURIFY HIGH SEGMENT!\]
]		;END OF IFN D10

FASLNX:
PG%	SETZM LDXSIZ
PG$	SETZM LDXLPC
FASLNC:
	HRRZ A,LDBSAR
	PUSHJ P,$CLOSE
	LERR [SIXBIT \NO MORE ADDRESS SPACE - FASLOAD!\]	;TOTAL LOSS

LDFERR:
	HRRZ A,LDBSAR
	PUSHJ P,$CLOSE
	UNLOCKI
	MOVE A,LDFNAM
	MOVEI B,QFASLOAD
	PUSHJ P,XCONS
	PUSHJ P,UNBIND
	SUB P,R70-LDPRLS+1
	FAC [FILE NOT IN FASLOAD FORMAT!]




LMBERR:	EXCH A,C
	MOVE R,T
	WTA [BAD LAMBDA LIST!]
	MOVE TT,C
	JRST IPLMB1

LXPRLZ:	LERR [SIXBIT \TOO MANY ARGS TO LEXPR!\]

DOERRE:	MOVEI A,(B)
	WTA [ BAD END TEST FORM - DO!]
	MOVEI B,(A)
	JRST DO4C

GETLE:	EXCH A,B
GETLE1:	%WTA NAPLMS
	EXCH A,B
	JRST GETL


SETWNA:	POP P,A
	MOVEI B,QSETQ
	PUSHJ P,XCONS
	PUSHJ P,NCONS
	WNA [ODD NUMBER OF ARGS - SETQ!]
	JRST EVAL

SIGNPE:	MOVE A,(P)
	WTA [BAD TEST REQUEST - SIGNP!]
	MOVEM A,(P)
	JRST SIGNP0

PROPER:	WTA [BAD ARG - PUTPROP!]
	JRST PUTPROP
RMPER0:	WTA [BAD ARG - REMPROP!]
	JRST REMPROP


LFYER:	PUSHJ P,%%RLFE		;NOT INSIDE LSUBR
	 ,,QLISTIFY		;LET LOSER FIGURE IT OUT
	%FAC MES14

GENSY8:	%WTA EMS31
	PUSH P,A
	JRST GENSY7

ARGCM8:	WTA [ARG OUT OF RANGE - ARG/SETARG!]
	JRST ARGCOM
ARGCM0:	MOVEI R,-1(R)	;NOTE: FLUSHES FLAGS IN LEFT HALF!
	CAIN R,ARGXX
	JRST ARGCM1
	CALLF 2,QLIST
	MOVEI B,QSETARG
	JRST ARGCM2
ARGCM1:	PUSHJ P,NCONS
	MOVEI B,QARG
ARGCM2:	PUSHJ P,ACONS	;LISTIFY AGAIN, WITHOUT LOSING B
	PUSHJ P,XCONS
	%FAC MES14


PTRCKE:	PUSH P,A
	MOVEI A,(TT)
	%WTA EMS34
	MOVEI TT,(A)
	POP P,A
	JRST PTRCHK

.STOLZ:	PUSH P,B
	PUSHJ P,%%RLFE
	 ,,QM
	MOVEI B,QSTORE
	PUSHJ P,XCONS
	POP P,B
	PUSH P,T
	FAC [CAN'T STORE INTO NON-ARRAY!]


TYOAGE:	WTA [NOT ASCII VALUE!]
	JRST TYOARG

EOFER:	MOVEI B,QRDEOF
	MOVEI T,[SIXBIT \END OF FILE WITHIN READ!\]
	PUSHJ P,EOFE
	JRST EOF5	

RDLNER:	PUSHJ P,SINFGET		;GETS VINFILE IN AR1
	MOVEI B,Q%READLINE
	MOVEI T,[SIXBIT \END OF FILE WITHIN A LINE!\]
EOFE:	MOVEI A,(AR1)
	PUSHJ P,NCONS
	PUSHJ P,XCONS
	PUSHJ P,[%FAC (T)]
	JUMPE A,CPOPJ
	SKIPE T,EOFRTN		;CLOBBER IN EOF VALUE IF NON-NIL
	 HRRM A,-LERSTP-1(T)	; AND IF EOF FRAME EXISTS
	POPJ P,




IFE ITS,[
IIOERR:	LERR [SIXBIT \I/O ERROR DURING INPUT!\]
OIOERR:	LERR [SIXBIT \I/O ERROR DURING OUTPUT!\]
]	;END OF IFE ITS

MAPWNA:	MOVEI D,QMAPLIST-MAPLIST-1(TT)
	SOJA T,WNALOSE


MEMQER:	EXCH A,(P)
	%WTA NAPLMS
	MOVE B,A
	EXCH A,(P)
	JRST (T)

DLTER:	CAIE B,MEMBER
	 SKIPA D,[QDELQ]
	  MOVEI D,QDELETE
	JRST WNALOSE

LIST.9:	MOVEI D,QLIST.		;ZERO ARGS => ERROR
	SOJA D,WNALOSE

SUSPE: PUSHJ P,%%RLFE
	 ,,QSUSPEND
	MOVE TT,FXP		;TO ALLOW RETURNS FROM THE FAC, FXP
	SUB TT,R70+1		; MUST BE RESTORED
	SKIPE (FXP)
	 MOVE TT,(FXP)		;IF TOP OF FXP NON-ZERO THEN IS POINTER
	MOVE FXP,TT		; TO OLD FXP; RESTORE CORRECT FXP
	FAC [I/O IN PROGRESS - CAN'T SUSPEND!]



GTPDL1:	WTA [NOT PDL POINTER!]
	JRST GTPDLP

RAND9:	MOVEI D,QRANDOM
S2WNAL:	SOJA T,S1WNAL

TYPKER:	MOVEI D,QTYIPEEK
S1WNAL:	SOJA T,WNALOSE

GRCTIE:	EXCH A,B
	WTA [BAD READTABLE INDEX!]
	EXCH A,B
	JRST GRCTI

FRERR:	WTA [NOT A FRAME POINTER!]
	JRST FRETURN

IFN USELESS,[
CRSRP2:	WTA [BAD CURSORPOS CODE!]
	JRST CRSRP3
]		;END OF IFN USELESS

ALST0:	MOVE A,-1(P)
	WTA [BAD ALIST - EVAL/APPLY!]
	MOVEM A,-1(P)
	JRST ALIST

LFY0:	WTA [ARG TOO LARGE - LISTIFY!]
	JRST LISTIFY

IFN ITS+SAIL,[
ALCK0:	EXCH A,B
	WTA [BAD ARG - ALARMCLOCK!]
	JRST ALARMCLOCK
]		;END OF IFN ITS+SAIL

PRGER1:	EXCH A,AR2A
	WTA [BAD VAR LIST - PROG!]
	EXCH A,AR2A
	JRST PRG1

DOERR:	POP P,A
	WTA [BAD VAR LIST - DO!]
	MOVEM A,-2(P)
	JRST DO5

DO5ER:	MOVEI A,(B)
	WTA [EXTRANEOUS STEPPER - DO!]
	JRST DO5Q


ATAN.7:	LERR [SIXBIT \OVERFLOW/UNDERFLOW IN ATAN!\]
EXP.ER:	MOVE D,[EXPER1,,[SIXBIT \ARG TOO BIG - EXP!\]]
	JRST NUMER
EXPER1:	EXCH A,B
	JRST EXP.
SIN.ER:	SKIPA D,[SIN.,,[SIXBIT \ARG TOO BIG FOR ACCURACY - SIN!\]]
COS.ER:	MOVE D,[COS.,,[SIXBIT \ARG TOO BIG FOR ACCURACY - COS!\]]
	JRST NUMER
SQR$ER:	SKIPA D,[SQRT.,,[SIXBIT \NEG ARG - SQRT!\]]
LOG.ER:	MOVE D,[LOG.,,[SIXBIT \NON-POS ARG - LOG!\]]
NUMER:	JSP T,PDLNMK		;IF ARG WAS A PDL NUM, GET A REAL ONE
	%WTA (D)		;COMPLAIN TO LOSER
	HLRZS D
	JRST 2,@D

	IARERR
	$ARERR
ARTHER:	%WTA @.-1(T)
	JRST ARITH

1EQNF:	TDZA T,T
1GPNF:	MOVEI T,$GREAT-$EQUAL
	EXCH A,B
	%WTA CAMMES
	JRST $EQUAL(T)
2EQNF:	TDZA T,T
2GPNF:	MOVEI T,$GREAT-$EQUAL
	%WTA CAMMES
	EXCH A,B
	JRST $EQUAL(T)

ALHNKE:	PUSH P,A
	PUSH FXP,TT
	MOVEI A,(FXP)
	WTA [CAN'T CREATE A HUNK OF THIS SIZE!]
	POPI FXP,1
	MOVE TT,(A)
	POP P,A
	JRST ALHUNK


GCMLOSE:	
	JUMPN A,GCMLS1
	HRRZ A,GCMES+NFF(F)
	POP FXP,F
	JRST GCMLS2
GCMLS1:	HRRZ C,GCMES+NFF(F)
	JSR GCRSR
GCMLS2:	SETOM PANICP
	%GCL GCLSMS
	SETZM PANICP
	POP P,A
	SETOM IRMVF	;ON GENERAL PRINCIPLES, GCTWA ONCE
	JRST AGC

GCMES:	QLIST
	QFIXNUM
	QFLONUM
DB$	QDOUBLE
CX$	QCOMPLEX
DX$	QDUPLEX
BG$	QBIGNUM
	QSYMBOL
IFN HNKLOG,[
	RADIX 10.
	REPEAT HNKLOG+1, CONC QHUNK,\.RPCNT
	RADIX 8
]	;END OF IFN HNKLOG
	QARRAY
	QSYMBOL		;FOR SYMBOL-BLOCKS, SIMPLY SAY "SYMBOL"
IFN .-GCMES-NTYPES-1+1, WARN [WRONG LENGTH TABLE]

GCLSMS:	SIXBIT \STORAGE CAPACITY EXCEEDED!\


;;; COME HERE WHEN THINGS LOOK REALLY DESPERATE IN GC.
GCLUZ0:	TDZA A,A
GCLUZ:	 MOVEI A,TRUTH
	SKIPN PANICP		;HOPE FOR THE BEST, JPG!
	 SKIPE INHIBIT		;GC-LOSSAGE CAN'T WIN IF INHIBITED
	  CAIA
	   JRST GCMLOSE
	JUMPN A,GCLUZ1
	SKIPE A,F		;IF A HAD (), THEN GCRSR ALREADY DONE
	 HRRZ A,GCMES+NFF(F)
	POP FXP,F
	JRST GCLUZ2
GCLUZ1:	SKIPE C,F
	 HRRZ C,GCMES+NFF(F)	;WELL, IT LOOKS LIKE WE
	JSR GCRSR		; HAVEN'T EVEN A SNOBOL'S
GCLUZ2:	SETZM TTYOFF		; CHANCE IN HELL HERE...
	JUMPE A,GCLUZ6
	PUSHJ P,PRINT		;TELL LOSER HE LOST TOTALLY
GCLUZ3:	STRT 17,GCLSMS
	STRT 17,[SIXBIT \ BEYOND RECUPERATION!\]
	SKIPLE IRMVF
	 JRST GCLUZ7
GCLUZ5:	MOVEI TT,SPDLORG
	CAILE TT,(SP)		;IF WE LOST OUT GC'ING AT TOP
	 JRST DIE		; LEVEL, WE ARE TOTALLY LOST
GCLUZ4:	STRT 17,MESMAJ		;OTHERWISE WE HAVE HALF A CHANCE
	PUSHJ P,ERRPNU		; OF FREEING UP SOME STORAGE (NO UNWIND-PRO'S)
	JRST LISPGO		; BY UNBINDING SPECIAL VARIABLES

GCLUZ6:	STRT 17,[SIXBIT \SYMBOL BLOCK!\]
	JRST GCLUZ3

GCLUZ7:	SETOM IRMVF
	JRST GCLUZ4


GCPDLOV:	SETZM TTYOFF
	MOVE P,C2
	MOVE FXP,FXC2
	STRT 17,[SIXBIT \^M;PDL OVERFLOW WHILE IN GC#!!\]
	JRST GCLUZ5


;;; COME HERE WHEN EVERY HOPE FOR RECOVERY HAS BEEN EXHAUSTED.
DIE:	STRT 17,[SIXBIT \^M;YOU HAVE LOST BADLY#!^M!\]
	.VALUE
	JRST DIE

SUBTTL	ERROR ADDRESS DECODER

ERRADR:	SKIPE AR1,TAPWRT
	HRRZ AR1,VOUTFILES
ERRAD1:	PUSH P,AR1
	PUSHJ P,ERRDCD
	POP P,AR1
	JRST $PRIN1
ERRDCD:	MOVEI A,QM		;DECODE ADDRESS AS SUBR OR ARRAY
10$	CAIL B,ENDFUN		; PROPERTY OF SOME ATOM
10%	CAIGE B,BEGFUN		;ADDRESS 0 ALWAYS GIVES OUT QM - SEE BK1A1B
CPRIN1:	 POPJ P,PRIN1		;ERRDCD SAVES T (SEE WNALOSE)
10$	CAIL B,BEGFUN
10%	CAIGE B,ENDFUN
	 JRST ERRO2E
	CAIL B,BBPSSG
	 CAMLE B,BPSH
	  POPJ P,
ERRO2E:	
10$ 	MOVEI AR2A,BBPSSG
10%	MOVEI AR2A,BEGFUN
	LOCKI			;GCGEN IS NOT INTERRUPT SAFE
	JSP R,GCGEN
		ERRO2Q
	UNLKPOPJ

ERRO2Q:	SKIPE INTFLG	;LET INTERRUPTS HAPPEN - THIS IS A VERY
	JRST ERRO2R	; LONG PROCESS FOR LARGE OBARRAYS!
ERRO2A:	HLRZ TT,(D)
ERRO2C:	HRRZ TT,(TT)
	JUMPE TT,ERRO2B
	HLRZ AR1,(TT)
	HRRZ TT,(TT)
	CAIN AR1,QLSUBR
	 JRST ERRO2H
	CAIE AR1,QSUBR
	 CAIN AR1,QFSUBR
	  JRST ERRO2H
	CAIE AR1,QARRAY
	 JRST ERRO2C
	HLRZ AR1,(TT)
	HRRZ TT,(AR1)
	CAML B,@VBPEND		;IF ARG IS < BPEND, THEN CANT BE AN ARRAY
	 CAIGE TT,-3(B)
	  JRST ERRO2B
	JRST ERRO2G

ERRO2H:	HLRZ TT,(TT)
10$	CAIL B,HILOC	;IF ARG IS IN HIGH SEGMENT,
10$	 JRST ERRO2G	; MUST BE SUBR
	CAML B,@VBPORG
	 JRST ERRO2B	;IF ARG > BPORG, THEN CANT BE A SUBR [MUST BE ARRAY]
ERRO2G:	CAMLE TT,AR2A
	 CAMLE TT,B
	  JRST ERRO2B
	MOVE AR2A,TT
	HLRZ A,(D)
ERRO2B:	HRRZ D,(D)
	JUMPN D,ERRO2A
	JRST GCP8A

ERRO2R:	HRRZ AR1,VOBARRAY
	MOVEI TT,(F)
	SUB TT,TTSAR(AR1)
	UNLOCKI			;GIVE A POOR INTERRUPT
	LOCKI			; A CHANCE IN LIFE
	ADD TT,TTSAR(AR1)
	HRRI F,(TT)
	JRST ERRO2A

SUBTTL	ERROR, ERRFRAME, ERRPRINT

BEGFUN==.

$ERROR:	JUMPE T,EROR1A		;(ERROR) SIMPLY ACTS LIKE (ERR)
	AOJE T,[LERR 1,@(P)]	;(ERROR MSG)
	AOJE T,ERRERC
	AOJN T,ERERER
	POP P,A
ERRERB:	MOVEI B,(A)
	CAIL A,QUDF
	 CAIL A,QUDF+NERINT
	  JRST ERRERN
10$	MOVEI D,(A)
10$	SUBI D,QUDF
.ELSE 	HRREI D,-QUDF(A)
	JRST ERRERD

ERRERN:	PUSHJ P,FIXP
	JUMPE A,ERRERO
	MOVEI D,-5(TT)
	JUMPL D,ERRERO
ERRERD:	CAIL D,NERINT		;# USER INTERRUPT ERRORS - RANGE FROM 0 TO NERINT-1
	 JRST ERRERO
	MOVEI A,POP1J		;(ERROR MSG ARGS CHNO)
	EXCH A,(P)
	IORI D,<(SERINT)>_-5
	DPB D,[2715_30 -1(P)]
	XCT -1(P)		;THIS WINS FOR FAIL-ACT, FOR IT WILL
	POPJ P,			; POPJ BY ISELF WITHOUT COMING HERE;
				; DITTO FOR IO-LOSSAGE.

SUBR:	HRRZ B,(A)		;SUBR 1
	JRST ERRDCD

;;; ERRFRAME TAKES PDL POINTER, AND RETURNS AN ERROR FRAME.
;;; FORM OF RETURNED VALUE:
;;;	(ERR <REGPDL PTR> <ERROR MSG> <SPECPDL PTR>)
;;; WHERE <ERROR MSG> TAKES ONE OF THREE FORMS:
;;;	(<MESSAGE>)
;;;	(<MESSAGE> <LOSING S-EXP>)
;;;	(<MESSAGE> <LOSING S-EXP> <TYPE>)
;;; I.E. IT IS A LIST OF ARGS SUITABLE FOR THE ERROR FUNCTION.

ERRFRAME:	JSP R,GTPDLP	;SUBR 1
		      $ERRFRAME		;MUST APPEAR TWICE
		      $ERRFRAME
	 JRST FALSE
	POPI D,1
	PUSH FXP,D
	PUSHJ FXP,SAV5M1
	MOVE D,2(D)	;D SHOULD POINT TO JUST BELOW THE FRAME MARKER
	PUSH P,R70
	LSHC D,-33
	LSH R,-40
	CAIGE D,ERINT_-33
	 JRST EPR6
	MOVEI A,QUDF(R)
	PUSHJ P,ACONS
	MOVEM A,(P)
EPR6:	HRRZ A,(FXP)
	HRRZ A,3(A)
	HRRZ B,(P)
	PUSHJ P,CONS
	MOVEM A,(P)
	HRRZ A,(FXP)
	HRRZ A,2(A)
	CAIN D,ERINT_-33
	 JRST EPR7
	CAIE D,SERINT_-33
	 SKIPE R
	  JRST EPR5
EPR7:	HRLI A,440600		;IF MSG IS SIXBIT, MUST CREATE
	MOVEM A,CORBP		; AN ATOMIC SYMBOL WHOSE PRINT NAME
	MOVEI T,EPR1		; IS THE MESSAGE
	PUSHJ FXP,MKNR6C
	PUSHJ P,RINTERN
EPR5:	POP P,B
	PUSHJ P,CONS
	PUSH P,CR5M1PJ
	PUSH P,A
	POP FXP,D
	JRST FRM4

EPR1:	ILDB BYTEAC,CORBP
	CAIN BYTEAC,'!	;! IS END OF MESSAGE
	 POPJ P,
	CAIN BYTEAC,'^	;^ CONTROLIFIES NEXT CHARACTER
	 JRST EPR3
	CAIN BYTEAC,'#	;# QUOTES NEXT CHAR
	 ILDB BYTEAC,CORBP
EPR4:	ADDI BYTEAC,40
	JRST POPJ1

EPR3:	ILDB BYTEAC,CORBP	;THIS "CONTROLIFICATION" ALGORITHM
	ADDI BYTEAC,40	; CONVERTS ^M TO CTRL/M, BUT ALSO ^4 TO
	TRC BYTEAC,100	; LOWER CASE T, ETC.; HENCE CAN REPRESENT
	POPJ P,		; ALL OF ASCII USING ^ AS AN ESCAPE


ERRPRINT:			;LSUBR (1 . 2)
	JSP F,PRNARG
	   [QERRPRINT]
	TRNE AR1,-1	;IF THERE IS ALREADY SOME MSGFILE TO GET THE MSG,
	TLO AR1,200000	; THEN INHIBIT AUTO-FORCT TO TTY
	PUSHJ P,OFCAN
	JSP R,GTPDLP	;PRINT OUT ERROR MESSAGE STACKED ON  
	   $ERRFRAME	; PDL JUST PRIOR TO POINT SPECIFIED BY ARG
	   $ERRFRAME	;EXTRA COPY OF $ERRFRAME
	 JRST FALSE
	PUSHJ P,ERROR3
	JRST TRUE


;OUTPUT FILE CANONICALIZER.  MAKES CONTENTS OF AR1
; INTO AN ORDINARY LIST SUITABLE FOR FEEDING TO STRT.

OFCAN:	PUSH P,A		;SAVES T
	MOVEI A,(AR1)
	SKIPGE AR1
	 PUSHJ P,ACONS
	HRRZ B,V%TYO
	TLNN AR1,200000
	 PUSHJ P,XCONS
	MOVEI AR1,(A)
	JRST POPAJ

