Google
 

Trailing-Edge - PDP-10 Archives - AP-D480B-SB_1978 - forerr.mac
There are 27 other files named forerr.mac in the archive. Click here to see a list.
	TITLE	FORERR	%5A(714) ERROR PROCESSING MODULE FOR THE FOROTS SYSTEM
	SUBTTL	D. TODD/DRT/HPW/SRM/MD/DPL/JNG/CLRH/SJW/SWG		27-SEP-77
;***COPYRIGHT 1972,1973,1974,1975,1976,1977 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
	SUBTTL	REVISION HISTORY

;250	 -----	IMPLEMENT BOUNDS CHECKING ERROR MODULE ER%SRE
;347	 -----	ADD ERROR MESSAGE FOR LIST-DIRECTED INPUT
;354	 -----	FIX FREE FORMAT INPUT
;375	 -----	DO NOT ALLOW SEQUENTIAL ACCESS TO RANDOM FILE
;412	14525	TRACE DOES NOT NAME ROUTINES CALLED INDIRECTLY
;414	14602	TYPING ILLEGAL CHAR IN DATA MAY OUTPUT
;		A LOT OF GARBAGE.
;415	14823	REMOVE EXTRA END STATEMENT
;424	14996	ADD ERROR MESSAGE FOR ATTEMPT TO READ UNWRITTEN ASCII
;		RANDOM ACCESS RECORD
;432	15764	FIX PRINTING OF PPN IN FORM OF <X0Y>
;435	-----	FIX FORER% TO CHECK OPCODE FIELD OF ERROR MACRO AND ADD
;		PROPER OFFSET TO AC FIELD TO ALLOW UP TO 48 MSGS/CLASS.
;447	16733	FIX ER%DEV TO PUT END= AND ERR= ADDR'S IN USR.PC SO
;		EOF TAKES AFFECT IMMEDIATELY AND NO IO VARIABLES GET
;		CLEARED
;450	-----	FIX EDIT 424 IN ER%DA1 TO CHECK P3 NOT P2 FOR IO.FMT
;451	-----	FIX DAT7 SO NO ATTEMPT IS MADE TO PRINT A FORMAT
;		STATEMENT WHEN ILLEGAL CHAR IS FOR NAMELIST INPUT
;****************BEGINNING OF VERSION 4C
;463	16661	CHANGE 'ILLEGAL MODE FOR DEVICE' MESSAGE TO SAY MORE
;		CORRECTLY 'ILLEGAL MODE OR MODE SWITCH' IN ER%OPN
;474	17648	DON'T STOP PRINTING RECORD ON LF IF ERROR.
;510	17898	STORE NEW PC IN BOTH USR.PC AND ALT.PC AS EOF FLAG.
;515	18756	FIX EDIT 424 AT ER%DA1+10 TO CHECK P3 NOT P2 FOR IO.FMT
;524	18699	FIX QUOTA EXCEEDED MESSAGE
;527	19205	FIX ILL MEM REFS IN DISPATCH TABLES
;546	15285	FIX TRACE% TO OUTPUT CORRECT TYPES FOR ROUTINE
;			ARGUMENTS
;547	-----	ADD ERROR MESSAGE FOR MEMORY MANAGEMENT ERRORS
;552	19131	CLEAR IO ACTIVE BIT AFTER GETSTS BEFORE JFFO IN ER%DEV
;*** BEGIN VERSION 5
;564	VER5	ADD ERR= CLEANUP/RETURN PROCESSOR
;600	Q00573	ADD STATIC WORD FOR MAIN. ADDRESS FOR TRACE%
;603	Q00820	ADD ERROR MESSAGE FOR ILLEGAL SEQUENCE OF UUOS
;612	Q00839	ERR%OPN 5 <- "ILLEGAL SEQUENCE OF MONITOR CALLS"
;
;	BEGIN VERSION 5A, 7-NOV-76
;
;626	-----	CHANGE DATA ERROR 11 TO SPECIFY NAMELIST NAME
;		AND INVALID VARIABLE NAME
;636	Q1037	FIX DAT7 TO UNDERSTAND ILLEGAL CHARACTER IN DATA WITH
;			T FORMAT
;650	-----	CHANGE REF TO EXTERNAL DMPSTR TO DMPST.
;711	-----	STOP RECURSIVE ERROR CALLS IN ER%DEV
;712	-----	FIX TRACEBACK IN ER%LIB TO USE CORRECT STARTING STKPTR
;713	-----	FIX TRACEBACK OVER OVERLAYS IN TRACE%
;714	-----	FIX ERROR RECOVERY AT ERR%ER TO RETURN "RECOVERY FAILED"
;		  IF THERE IS AN ERR= BUT NO RECOVERY ROUTINE SPECIFIED
;*** END OF REVISION HISTORY ******
	ENTRY	FORER%		;ENTRY POINT TO FORERR - MUST BE DEFINED BEFORE


	SEARCH	FORPRM	;GLOBAL SYMBOLS DEFINED IN FORPRM

VERNO==5		;MAJOR VERSION NUMBER
VEDIT==714		;MAJOR EDIT NUMBER
VMINOR==1		;MINOR EDIT NUMBER
VWHO==0			;WHO EDITED LAST

VERERR==BYTE (3)VWHO(9)VERNO(6)VMINOR(18)VEDIT

;	DEFINE THE LOADING
	SEGMEN
HGH.AC==T5			;NUMBER OF AC'S TO SAVE


;CONTROL FLAGS IN THE LEFT HALF OF THE MESSAGE TABLE ENTRIES
;	FOLLOWING FLAGS ARE CONTAINED IN T5 DURING ERROR PROCESSING

ER.HDR==400000	;MESSAGE HEADER TO BE TYPED OUT
ER.DDB==200000	;DEVICE INFO TO BE TYPED OUT
ER.EDB==100000	;EXTENDED DEVICE INFO TO BE TYPED (IMPLIES ER.DDB)
ER.MSG==040000	;ASSOCIATED SPECIAL ROUTINE (ROUTINE ADDRESS)
ER.USR==020000	;USER'S ADDRESS IS NOT AVAILABLE FOR MESSAGE HEADER
	PAGE
	SUBTTL FORERR ENTRY POINTS DEFINED BY ERRDIR IN (FORRM)
ERDIR%:		;DEFINE THE BEGINNING OF THE DISPATCH TABLE
	SALL

	ERRDIR
FORER%:	PUSHJ	P,.+1		;SAVE THE CALLING PC
;**; [527] CHANGE AT FORER% + 1	CLRH	26-MAR-76
	PUSH	P,T0		; [527] SAVE THE AC'S
	PUSH	P,T1		; [527]
	PUSH	P,T2		; [527]
	PUSH	P,T3		; [527]
	PUSH	P,T4		; [527]
	PUSH	P,T5		; [527]
	N.==HGH.AC+1		;DEFINE THE STACK DEPTH
	PUSH	P,P4		;SAVE P4 FOR A BASE REGISTER
	N.=N.+1			;ACCOUNT FOR IT
				;THE AC'S PLUS RETURN ADDRESS
	HRRZ	P4,.JBOPS	;GET THE LOW SEGMENT POINTER
	MOVE	T3,-N.(P)	;GET THE XCT ADDR +1
	HLRZ	T4,(T3)		;GET THE TYPE AND SEVERITY CODE
	HLRZ	T1,(T3)		;[435] GET OPCODE
	ANDI	T1,70000	;[435] ISOLATE SECOND DIGIT
	LSH	T1,-10		;[435] POSITION FOR ADDING TO TYPE
	ANDI	T4,757		;SAVE THE INDEX AND AC FIELD
	ROT	T4,-5		;POSITION THE AC FIELD
	ADD	T4,T1		;[435] ADD OFFSET TO GET REAL TYPE
	PUSH	P,T4		;SAVE THE TYPE CODE ON THE  STACK
	N.=N.+1			;COUNT THE SEVERITY CODE AND TYPE CODE
	ANDCMI	T4,-1		;CLEAR THE RIGHT HALR
	ROT	T4,5		;GET THE SEVERITY CODE BACK
	HRLM	T4,(P)		;PUT THE SEVERITY IN THE LEFT HALF
	HLRZ	T4,-1(T3)	;GET THE CLASS CODE
	LSH	T4,-5		;GET THE AC FIELD
	ANDI	T4,17		;SAVE FOUR BITS
	MOVEI	T1,FORRTN	;GET THE RETURN ADDRESS
;**; [527] INSERT @ FORRTN - 4 1/2	CLRH	26-MAR-76
	CAILE	T4,ERD.MX	; [527] IN RANGE ?
	MOVEI	T4,12		; [527] NO -- UNDEFINED
	HLL	T1,ERDIR%(T4)	;GET THE CLASS NAME
	PUSH	P,T1		;SAVE ON THE STACK
	N.=N.+1		;COUNT THE PUSH
	HRRZ	T1,ERDIR%(T4)	;GET THE DISPATCH ADDRESS
NN.==N.			;DEFINE THE STACK DEPTH FOR THE REST
	JRST	(T1)		;GO TO THE ERROR CLASS ROUTINE
FORRTN:				;RETURN FROM THE CLASS ROUTINE
	N.=N.-1			;ACCOUNT FOR THE POPJ BACK HEHRE
	HRRZ	T3,@-N.(P)	;GET THE RETURN ADDRESS
	JUMPN	T3,FORRT3	;IS A RETURN SPECIFIED
FORRT0:	PUSHJ	P,TRAC%%	;GIVE A USERS TRACE
	MOVEI	T3,EXIT%##	;NO, USE SYSTEM RETURN
	OUTSTR	[ASCIZ /
? Job aborted
/]
FORRT3:	MOVEM	T3,-N.(P)	;SET THE RETURN ADDRESS
FORRT1:	POP	P,(P)		;GET THE TYPE CODE AND SEVERITY OFF THE STACK
	N.=N.-1
	POP	P,P4		;RESTORE THE BASE REG
	N.=N.-1		;ACCOUNT
;**; [527] CHANGE @ FORRT1 + 4L	CLRH	26-MAR-76
	POP	P,T5			; [527] RESTORE REGISTERS
	POP	P,T4			; [527]
	POP	P,T3			; [527]
	POP	P,T2			; [527]
	POP	P,T1			; [527]
	POP	P,T0			; [527]
	N.=N.-HGH.AC
	POPJ	P,		;RETURN
	N.=N.-1

SYSRET:	POP	P,T0		;RETURN TO MONITOR VIA EXIT
	JRST	FORRT0		;LOAD THE EXIT RETURN

USRRET:	POP	P,T0		;REMOVE THE CALLING ADDRESS
	JRST	FORRT1		;EXIT
	PAGE
	SUBTTL	TY%XXX GENERAL PURPOSE OUTPUT ROUTINES TO THE TTY
;				;ROUTINE TO TYPE A STRING ON THE
				;CURRENT OUTPUT DEVICE
;	CALL
;	TYPSTR (ADDR OF STRING)		;CALLED BY THE TYPE STRING MACRO
;	(RETURN)
TY%STR:	MOVE	T2,(P)		;GET THE ARGUMENT
	MOVEI	T2,@(T2)	;GET THE LOCATION OF THE MESSAGE
	HRLI	T2,100		;SET UPPER CASE SHIFT MODE
TY%FI1:	MOVE	T1,(T2)		;GET A FIVBIT WORD
	TRNN	T1,1		;CHECK FOR LAST WORD OF THE STRING
	TLO	T2,400000	;YES, LAST WORD SET FLAG
TY%FI3:	SETZ	T0,		;CLEAR THE OUTPUT WORD
	LSHC	T0,5		;GET FIVE BITS
	CAIN	T0,37		;IS THIS A CASE SHIFT
	JRST	[TLC  T2,40	;YES, COMPLEMENT CASE SHIFT
		JRST	TY%FI3]	;GET THE NEXT CHARACTER
	JUMPE	T0,.+2		;JUMP IS A FIVBIT BLANK SEEN
	TSOA	T0,T2		;SET UP THE CASE SHIFT
	MOVEI	T0," "		;GET A BLANK
	JUMPN	T1,.+2		;CHECK FOR END OF WORD
	AOJGE	T2,TY%FI1	;CONTINUE UNLESS END OF STRING
	OUTCHR	T0		;OUTPUT THE ASCII CHARACTER
	JUMPN	T1,TY%FI3	;ANY CHARACTERS LEFT
	JUMPGE	T2,TY%FI3	;AND NOT LAST WORD 
	POPJ	P,		;UNLESS END OF STRING

TY%SIX:				;OUTPUT THE SIXBIT WORD IN T1
	SETZ	T0,		;CLEAR THE RECEIVER OF THE SIXBIT CHARACTER
	LSHC	T0,6		;GET A SIXBIT CHARACTER
	ADDI	T0," "		;CONVERT TO ASCII
	OUTCHR	T0		;OUTPUT THE CHARACTER
	JUMPN	T1,TY%SIX	;CONTINUE, IF ANY CHARACTERS LEFT
	POPJ	P,		;RETURN

TY%XWD:	HRLM	T0,(P)		;SAVE THE RIGHT HALF
	HLRZS	T0		;GET THE LEFT HALF
	PUSHJ	P,TY%OCT	;TYPE IT
	OUTSTR	[ASCIZ/,/]	;TYPE A COMMA
	HLRZ	T0,(P)		;GET THE RIGHT HALF
;	PJRST	TY%OCT		;TYPE IT
TY%OCT:	SKIPA	T2,[10]		;SET OCTAL RADIX
TY%DEC:	MOVEI	T2,^D10		;SET DECIMAL RADIX
TY%RDX:	JUMPGE	T0,TYRDX1	;JUMP IF +
	OUTSTR	[ASCIZ /-/]	;SUMP A MINUS SIGN
	MOVNS	T0		;NEGATE THE NUMBER
TYRDX1:IDIVI	T0,(T2)		;GET A DIGIT
	HRLM	T1,(P)		;SAVE ON THE STACK
	SKIPE	T0		;ANY DIGITS LEFT
	PUSHJ	P,TYRDX1	;YES, CONTINUE
	HLRZ	T0,(P)		;GET A DIGIT BACK
	ADDI	T0,"0"		;CONVERT TO ASCII
	CAILE	T0,"9"		;IF DIGIT IS GREATER THAN 9
	ADDI	T0,"A"-"0"	;CONVERT TO LETTERS
	OUTCHR	T0		;OUTPUT
	POPJ	P,		;RETURN FOR NEXT DIGIT

TY%TIM:			;PRINT THE TIME IN TO "HH:MM:SS.HH"
	ADDI	T0,5		;ROUND OFF THE HUNDREDTHS OF SECONDS
	IDIVI	T0,^D1000	;COMPUTE SECONDS
	PUSH	P,T1		;SAVE THOUSANDS OF A SECOND
	IDIVI	T0,^D60		;COMPUTE MINUTES
	PUSH	P,T1		;SAVE MINUES
	JUMPE	T0,TY%TI2	;SKIP IF NO MINUTES
	IDIVI	T0,^D60		;COMPUTE HOURS
	PUSH	P,T1		;SAVE THE MINUTES
	JUMPE	T0,TY%TI1	;SKIP IF NO HOURS
	PUSHJ	P,TY%DEC	;TYPE THE HOURS
	OUTSTR	[ASCIZ /:/]	;TYPE A SEPERATOR
TY%TI1:	POP	P,T0		;GET THE MINUTES BACK
	PUSHJ	P,TY%DEC	;TYPE THE MINUTES
	OUTSTR	[ASCIZ /:/]	;TYPE A SEPERATOR
TY%TI2:	POP	P,T0		;GET THE SECONDS BACK
	PUSHJ	P,TY%DEC	;TYPE THE SECONDS
	OUTSTR	[ASCIZ /./]	;TYPE A SEPERATOR
	POP	P,T0		;GET THE THOUSANDS BACK
	IDIVI	T0,^D10		;CHANGE TO HUNDREDTHS
	IDIVI	T0,^D10
	IORI	T0,"0"		;CONVERT TO ASCII
	OUTCHR	T0		;TYPE IT
	MOVEI	T0,(T1)
	PJRST	TY%DEC		;TYPE THE HUNDREDTHS
	PAGE
	SUBTTL TY%DDB ROUTINE TO DUMP THE DEVICE BLOCK INFO.
TY%DDB::			;ROUTINE TO OUTPUT THE DEVICE DATA BLOCK
	TLNE	P3,IO.EDC	;ENCODE/DECODE ERROR
	JRST	TYPDD7		;[211] YES - INDICATE ENCODE/DECODE ERROR
	OUTSTR	[ASCIZ/
Unit=/]			;TYPE A LABEL
	HRRE	T0,DD.UNT(P3)	;GET THE FLU
	PUSHJ	P,TY%DEC	;TYPE THE FLU
	OUTSTR	[ASCIZ/ /]	;SPACE
	MOVE	T1,DD.DEV(P3)	;GET THE DEVICE NAME
	PUSHJ	P,TY%SIX	;TYPE OUT THE DEVICE IF ONE
	OUTSTR	[ASCIZ/:/]	;TYPE A COLON
TYPDD1:	SKIPN	T1,DD.NAM(P3)	;GET THE FILE NAME
	JRST	TYPDD5		;NO FILE NAME
	PUSHJ	P,TY%SIX	;TYPE THE FILE NAME
	HLLZ	T1,DD.EXT(P3)	;GET THE EXTENSION
	JUMPE	T1,TYPDD2	;NULL EXTENSION
	OUTSTR	[ASCIZ/./]	;TYPE A PERIOD
	PUSHJ	P,TY%SIX	;TYPE OUT THE EXTENSION
TYPDD2:	SKIPN	T3,DD.PPN(P3)	;GET THE PPN
	JRST	TYPDD4		;NO PPN SKIP
	OUTSTR	[ASCIZ/[/]	;TYPE A LEFT BRACKET
	MOVE	T0,T3		;GET THE PPN FOR XWD PRINT
	TLNN	T3,-1		;IS THIS A PPN OR A POINTER
	MOVE	T0,2(T3)	;THIS IS A SFD LIST, GET PPN
	PUSHJ	P,TY%XWD	;TYPE OUT THE HALF WORDS
	TLNE	T3,-1		;CKECK FOR SFD LIST
	JRST	TYPDD3		;NO QUIT
TYPDD8:	SKIPN	T1,3(T3)	;YES, GET SFD NAME
	JRST	TYPDD3		;NONE LEFT
	OUTSTR	[ASCIZ/,/]	;TYPE A COMMA
	PUSHJ	P,TY%SIX	;TYPE OUT SFD ENTRY
	AOJA	T3,TYPDD8	;CONTINUE UNTIL LIST TERNIMATOR
TYPDD3:	OUTSTR	[ASCIZ/]/]	;TYPE A CLOSING BRACKET
TYPDD4:	LDB	T1,[POINT 9,DD.PRV(P3),8]  ;GET THE PROTECTION CODE
	JUMPE	T1,TYPDD5	;NO PROTECTION, SKIP IT
	OUTSTR	[ASCIZ/</]	;TYPE A <
	MOVE	T0,T1		;ALIGN THE PROTECTION
	TRNN	T0,700		;CHECK THE OWNER'S FIELD
	OUTSTR	[ASCIZ /0/]	;ZERO, TYPE A ZERO
	TRNN	T0,770		;[432] CHECK THE PROJECT FIELD
	OUTSTR	[ASCIZ /0/]	;ZERO, TYPE A ZERO
	PUSHJ	P,TY%OCT	;TYPE IT
	OUTSTR	[ASCIZ/>/]	;GET CLOSING BRACKET
TYPDD5:	OUTSTR	[ASCIZ \/\]	;TYPE A SLASH
	TYPSTR	OP.SWT##+2	;TYPE /ACCESS
	OUTSTR	[ASCIZ /=/]	;TYPE =
	LDB	T1,[POINT 4,DD.BLK(P3),9];GET THE ACCESS INDEX
	TYPSTR	ACC.TB##(T1)	;TYPE THE VALUE
	OUTSTR	[ASCIZ \/\]	;TYPE A SLASH
	TYPSTR	OP.SWT##+12	;TYPE /MODE
	OUTSTR	[ASCIZ /=/]	;TYPE =
	LDB	T1,[POINT 4,DD.BLK(P3),13];GET THE MODE INDEX
	TYPSTR	MOD.TB##(T1)	;TYPE THE VALUE
TYPDD6:	OUTSTR	[ASCIZ/
/]				;END THIS LINE
	POPJ	P,		;RETURN

TYPDD7:	OUTSTR	[ASCIZ \
ENCODE/DECODE ERROR
\]				;[211] INDICATE ENCODE/DECODE
	POPJ	P,		;[211] RETURN
	PAGE
	SUBTTL ERROR MESSAGE PROCESSOR
TY%HDR:
	SKPINC			;KILL ^O TYPE OUT
	JFCL
	OUTSTR	[ASCIZ/
%FRS/]	;TYPE A WARNING FLAG
	HLLZ	T1,-1(P)	;GET THE CLASS NAME
	PUSHJ	P,TY%SIX	;type OUT THE SIXBIT
	OUTSTR	[ASCII / /]	;AND A SPACE
	POPJ	P,		;RETURN TO SOMEONE

;THE FOLLOWING ENTRIES ARE NOT DEFINED
ER%UUO:ER%QUE:ER%UNF:ER%US0:ER%US1:ER%US2:
ERCALL:	PUSHJ	P,TY%HDR	;TYPE THE HEADER
	TYPSTR	[FIVBIT (Undefined ENTRY in FORERR)]
	POPJ	P,
	PAGE
	SUBTTL SYS ERROR PROCESSOR
ER%SYS:
	HRRZ	T5,-1(P)	;GET THE TYPE CODE
	CAILE	T5,SYS.MX		;CHECK FOR IN RANGE
	PJRST	ERCALL		;UNDEFINED ENTRY
	PUSHJ	P,SYS%V2	;[564] SET ERR.V &CHECK ERR=
	MOVE	T5,SYSTAB(T5)	;GET THE ERROR ENTRY
	TLNE	T5,ER.HDR	;HEADER TO BE TYPED
	PUSHJ	P,TY%HDR	;YES, TYPE IT
	TLNN	T5,ER.MSG	;MESSAGE TO BE TYPE
	PJRST	@T5		;NO, ROUTINE DISPATCH
	TYPSTR	(@T5)		;YES, TYPE THE MESSAGE
	POPJ	P,		;EXIT
SYSTAB:				;SYSTEM ERROR TABLE
XWD ER.HDR!ER.MSG,[FIVBIT (FOROTS system error)]			;(0)
XWD	,SYS01								;(1)
XWD ER.HDR!ER.MSG,[FIVBIT (ARGUMENT BLOCK not in the correct format)]	;(2)
XWD ER.HDR!ER.MSG,[FIVBIT (MONITOR not built to support FOROTS)]	;(3)
XWD ,SYSRET								;(4)
XWD ER.HDR!ER.MSG,[FIVBIT (User program has requested more core than is available)]	;(5)
XWD ER.HDR!ER.MSG,[FIVBIT (Runtime memory management error)] ;(6) [547]
SYS.MX==.-SYSTAB-1		;SYSTBL SIZE

SYS01:			;PRINT THE TIMES OUT
	SKPINC		;KILL ^O TYPE OUT
	JFCL
	OUTSTR	[ASCIZ /
END OF EXECUTION
CPU TIME: /]
	SETZ	T0,		;ASK FOR OUT RUNTIME
	RUNTIME	T0,		;GET THE TOTAL RUNTIME
	SUB	T0,RUN.TM(P4)	;MINUS THE STARTING TIME
	PUSHJ	P,TY%TIM	;TYPE THE TIME OUT
	OUTSTR	[ASCIZ /	ELAPSED TIME: /]
	MSTIME	T0,		;GET THE TIME OF DAY
	SUB	T0,DAY.TM(P4)	;GET THE STARTING TIME
	JUMPGE	T0,.+2		;CHECK FOR AFTER MIDNIGHT
	ADD	T0,[^D1000*^D3600*^D24]	;ADD MILLISECONDS IN A DAY
	JUMPL	T0,.-1		;MAY BE MANYS DAY OF RUNNING
	PUSHJ	P,TY%TIM	;TYPE THE TIME OUT
	CALLI	12		;EXIT TO MONITOR
	PAGE
	SUBTTL OPN ERROR PROCESSOR
ER%OPN:
	HRRZ	T5,-1(P)	;GET THE TYPE CODE
	MOVNS	T5		;NEGATE THE TYPE CODE
	JUMPN	T5,EROPN1	;JUMP IF NO ZERO
	HRRZ	T5,DD.EXT(P3)	;GET THE ERROR CODE
;**; [527] INSERT @ EROPN1	CLRH	26-MAR-76
EROPN1:	CAILE	T5,OPN.MX	; [527] IN RANGE ?
	MOVEI	T5,OPN.MX+1	; [527] NO, SET BAD VALUE
	PUSHJ	P,OPN%V2	;[564] SET ERR.V & CHECK ERR=
	MOVE	T5,OPNTAB(T5)	; [527]GET THE DISPATCH ENTRY
	PUSHJ	P,TY%HDR	;TYPE THE HEADER ALWAYS
EROPN%:	TLNN	T5,ER.MSG	;TYPE A MESSAGE
	JRST	EROPN2		;ERROR ROUTINE
	TYPSTR	(@T5)		;YES, TYPE THE ERROR MESSAGE
	JRST	EROPN3
EROPN2:	PUSHJ	P,@T5		;PROCESS THE ERROR ROUTINE
	OPNNN.==NN.+1		;COUNT THE PUSHJ ON THE STACK
EROPN3:	TLNE	T5,ER.DDB	;DD.BLK TO BE TYPED
	PJRST	TY%DDB		;YES, TELL THE USER THE DEVICE AND FILE
	POPJ	P,		;RETURN
XWD ER.MSG!ER.DDB,[FIVBIT (Dump Mode Random or Append Access unimplemented  try Image Mode)]	;[257] (-15)
XWD ER.MSG!ER.DDB,[FIVBIT (Dialog file can not be opened)]		;(-14)
XWD ,OPN13											;[270] (-13)
XWD ER.MSG!ER.DDB,[FIVBIT (Record length missing for RANDOM access)]		;(-12)
XWD ,OPN11							;(-11)
XWD ER.MSG,[FIVBIT (Too many devices open FIFTEEN MAX)]			;(-10)
XWD ER.MSG!ER.DDB,@DATTAB						;(-7)
XWD ER.MSG!ER.DDB,@OPNTAB+12						;(-6)
XWD ER.MSG!ER.DDB,@OPNTAB+11						;(-5)
XWD ER.MSG!ER.DDB,@DATTAB						;(-4)
XWD ER.MSG!ER.DDB,@SYSTAB;(ENTRY NOT USED)				;(-3)
XWD ER.MSG!ER.DDB,[FIVBIT (Illegal ACCESS for device)]			;(-2)
;**;[463],OPNTAB-1,DPL,04-AUG-75
XWD ER.MSG!ER.DDB,[FIVBIT (Illegal MODE or MODE switch)]			;[463](-1)
OPNTAB:
XWD ER.MSG!ER.DDB,[FIVBIT (File was not found)]				;(0)
XWD ER.MSG!ER.DDB,[FIVBIT (No directory for project programmer number)]	;(1)
XWD ER.DDB,OPN02							;(2)
XWD ER.MSG!ER.DDB,[FIVBIT (File was being modified)]			;(3)
XWD ER.MSG!ER.DDB,[FIVBIT (Rename file name already exists)]		;(4)
;**; [603] CHANGE @ OPNTAB+5	CLRH	8-OCT-76
;**; [612] CHANGE @ OPNTAB+5	SJW	26-OCT-76
XWD ER.MSG!ER.DDB,[FIVBIT (Illegal Sequence of Monitor Calls)]		;(5) [612][603]
XWD ER.MSG!ER.DDB,[FIVBIT (Bad UFD or bad RIB)]				;(6)
XWD ER.MSG!ER.DDB,@SYSTAB						;(7)
XWD ER.MSG!ER.DDB,@SYSTAB						;(10)
XWD ER.MSG!ER.DDB,[FIVBIT (Device not available)]			;(11)
XWD ER.MSG!ER.DDB,[FIVBIT (No such device)]				;(12)
XWD ER.MSG!ER.DDB,@SYSTAB+2						;(13)
XWD ER.MSG!ER.DDB,[FIVBIT (No room or quota exceeded)]			;(14)
XWD ER.MSG!ER.DDB,[FIVBIT (Write lock error)]				;(15)
XWD ER.MSG!ER.DDB,[FIVBIT (Not enough monitor table space)]		;(16)
XWD ER.MSG!ER.DDB,[FIVBIT (Partial allocation only)]			;(17)
XWD ER.MSG!ER.DDB,[FIVBIT (Block not free on allocation)]		;(20)
XWD ER.MSG!ER.DDB,[FIVBIT (Can not supersede an existing directory)]	;(21)
XWD ER.MSG!ER.DDB,[FIVBIT (Can not delete or rename a non empty directory)];(22)
XWD ER.MSG!ER.DDB,[FIVBIT (SFD not found)]				;(23)
XWD ER.MSG!ER.DDB,[FIVBIT (Search list empty)]				;(24)
XWD ER.MSG!ER.DDB,[FIVBIT (SFD nested too deeply)]			;(25)
XWD ER.MSG!ER.DDB,[FIVBIT (No create on for specified SFD path)]	;(26)
;**; [527] INSERT @ OPN02 - 1 1/2	CLRH	26-MAR-76
XWD ER.MSG!ER.DDB,@SYSTAB				; (27) [527]
XWD ER.MSG!ER.DDB,[FIVBIT (File cannot be updated)]	; (30) [527]
XWD ER.MSG!ER.DDB,@SYSTAB				; (31) [527]
XWD ER.MSG!ER.DDB,@SYSTAB				; (32)  [527]
	OPN.MX==.-OPNTAB-1				; [527]
XWD ER.MSG!ER.DDB,[FIVBIT (LOOKUP ENTER or RENAME error)]		;(??)
OPN02:			;PROTECTION OR DTA FULL ERROR
	MOVE	T1,DD.STS(P3)	;GET THE DEVICE STATUS
	TLNE	T1,DV.DTA	;DTA DEVICE
	TYPSTR	([FIVBIT (DTA Directory is full)])
	TLNE	T1,DV.DSK	;DSK DEVICE
	TYPSTR	([FIVBIT (Protection failure)])
	POPJ	P,		;RETURN
OPN11:				;OPEN STATEMENT ERROR
	TYPSTR	OPN11Z		;TYPE OPEN ERROR
	OUTSTR	[ASCII/
/]
	JUMPN	G3,OPN112	;JUMP IF ARG ERROR
	SKIPN	T4,-OPNNN.+1+T1(P)	;[237] RELOAD AC T1
	JRST	OPN11A		;[237] INVALID DELIMITER
	TYPSTR	T4		;TYPE THE SWITCH NAME
	OUTSTR	[ASCIZ /=	is not /]
	MOVEI	T1,[ASCIZ /unique/]
	SKIPN	-OPNNN.+1+T4(P)	;SKIP IF NOT UNIQUE
	MOVEI	T1,[ASCIZ /defined/]
	OUTSTR	(T1)		;TYPE IT
	EXCH	P2,P3		;SWAP THE DEVICE POINTER
	PUSHJ	P,TY%DDB	;TYPE WHAT WE HAVE
	EXCH	P2,P3		;SWAP IT BACK
	POPJ	P,
OPN112:	TYPSTR	OP.SWT##(G3)	;TYPE THE SWITCH NAME
	OUTSTR	[ASCIZ /=/]
	MOVE	T0,-OPNNN.+1+T1(P)	;GET THE SWITCH VALUE
	MOVE	T1,T0		;COPY INCASE SIXBIT
	LDB	T4,[POINT 3,OP.DSP##(G3),8]	;GET THE VALUE TYPE
	CAIN	T4,5		;DECIMAL
	PUSHJ	P,TY%DEC
	CAIN	T4,4		;OCTAL
	PUSHJ	P,TY%OCT
	CAIN	T4,1		;FIVBIT
	TYPSTR	T0
	CAIN	T4,2		;SIXBIT
	PUSHJ	P,TY%SIX
	OUTSTR	[ASCIZ /	is an invalid argument/]
	POPJ	P,		;RETURN

OPN11A:	TYPSTR	([FIVBIT (Invalid delimiter)])	;[237]***
	JUMPL	P2,OPN11B	;[237] LOCATE CHARACTER
	SKIPA	G2,G1		;[237] CHARACTER IN CORE
OPN11B:	MOVE	G2,DD.HRI+1(P3)	;[237] CHARACTER IN BUFFER
OPN11C:	LDB	T0,G2		;[237] LOAD THE CHARACTER
	OUTSTR	[ASCIZ \ [ \]	;[237] DELIMIT CHARACTER
	OUTCHR	T0		;[237] TYPE CHARACTER
	OUTSTR	[ASCIZ \ ]\]	;[237] DELIMIT CHARACTER
	POPJ	P,		;[237] RETURN

OPN11Z:	FIVBIT (Switch error during DIALOG or OPEN statement scan)	;(-11)

OPN13:	TYPSTR	OPN13A		;[270] GIVE MESSAGE
	OUTSTR	[ASCIZ / (/]	;[270] TYPE A "("
	MOVE	T0,G2		;[270] LOAD ILLEGAL UNIT NUMBER
	PUSHJ	P,TY%DEC	;[270] TYPE ILLEGAL UNIT #
	OUTSTR	[ASCIZ /)
/]				;[270] DELIMIT MESSAGE
	POPJ	P,		;[270] RETURN

				;[270] MESSAGE TEXT
OPN13A:	FIVBIT	(Illegal FORTRAN unit number)
	PAGE
	SUBTTL APR ARITHMETIC FAULT ERROR PROCESSOR
FXU=1B11	;FLOATING EXPONENT UNDERFLOW FLAG
FOV=1B3		;FLOATING OVERFLOW BIT
NDV=1B12	;NO DIVIDE BIT
ER%APR:		;ENTRY TO APR FAULT
	AOS	OVCNT.(P4)	;COUNT THE APR FAULT
	SOSGE	ERRMX.(P4)	;COUNT THE ERRORS
	POPJ	P,		;TOO MANY DON'T PRINT
	HRRZ	T4,-NN.(P)	;GET THE ERROR MACRO PC
	HRRZ	T5,-1(P)	;GET THE TYPE CODE
	SOJGE	T5,ERAPR1	;SPECIAL ENTRY FOR A MESSAGE TYPE
	MOVE	T4,.JBTPC	;GET THE APR TRAP LOC
	HLRZ	T5,T4		;GET THE TRAP BITS
	ANDI	T5,(FXU!FOV!NDV)	;SAVE THE FLAG BITS
	LSH	T5,-5		;MAKE A MESSAGE POINTER
	TRZE	T5,(1B8)	;INDEX
	IORI	T5,1B33		;BETWEEN 0-7
;**; [527] INSERT @ ERAPR1	CLRH	26-MAR-76
ERAPR1:	CAILE	T5,APR.MX	; [527] IN RANGE ?
	MOVEI	T5,APR.MX		; [527] NO, SET AS LAST
	MOVE	T5,APRTAB(T5)		; [527] GET THE FLAGS
	PUSHJ	P,TY%HDR	;TYPE OUT THE HEADER
	TYPSTR	(@T5)		;TYPE THE ERROR MESSAGE
	OUTSTR	[ASCIZ /	PC= /]
	MOVEI	T0,-1(T4)	;GET THE ERROR LOCATION
	PUSHJ	P,TY%OCT	;60;TYPE OUT THE PC
	OUTSTR	[ASCIZ /
/]
	POPJ	P,		;RETURN
APRTAB:
	XWD	ER.USR,[FIVBIT (Integer overflow)]	;(0)
	XWD	ER.USR,[FIVBIT (Integer divide check)];(1)
	XWD	ER.USR,[FIVBIT (Illegal APR trap)]	;(2)
	ARG	ER.USR,@APRTAB+2			;(3)
	XWD	ER.USR,[FIVBIT (Floating overflow)]	;(4)
	XWD	ER.USR,[FIVBIT (Floating divide check)];(5)
	XWD	ER.USR,[FIVBIT (Floating underflow)]	;(6)
	ARG	ER.USR,@APRTAB+2			;[335] (7)
;**; [527] INSERT @ ER%LIB - 1/2	CLRH	26-MAR-76
	APR.MX==.-APRTAB-1		; [527] LENGTH OF APRTAB
	PAGE
	SUBTTL LIB LIBRARY ERROR FAULT PROCESSOR
ER%LIB:				;ENTRY POINT
	SOSGE	ERRMX.(P4)	;COUNT THE LIB ERROR
	JRST	USRRET		;IGNORE THE ERROR MESSAGE
	PUSHJ	P,TY%HDR	;TYPE THE HEADER
	MOVE	T5,@-NN.(P)	;[200] GET THE MESSAGE ADDRESS
	OUTSTR	0(T5)		;[200] TYPE THE MESSAGE
;**; [712] @ER%LIB + 5  SJW  23-SEP-77
	MOVE	G1,USR.PC(P4)	;[712] SAVE OLD STKPTR ON FOROTS ENTRY
				;[712] CAN'T SAVE ON STK OR TRACE WILL FIND IT
	MOVE	T5,-<NN.+1>(P)	;[712] GET TOP OF STK ON FORERR ENTRY
	MOVEM	T5,USR.PC(P4)	;[712] USE IT TO START TRACEBACK
	PUSHJ	P,TRAC%%	;[200] TRACE THE ERROR
	MOVEM	G1,USR.PC(P4)	;[712] RESTORE OLD STKPTR
	JRST	USRRET		;[200] RETURN TO THE USER
	PAGE
	SUBTTL DAT DATA ERROR FAULT PROCESSOR
ER%DAT:				;ENTRY POINT
	HRRZ	T5,-1(P)	;GET THE TYPE CODE
	CAILE	T5,DAT.MX	;IN THE TABLE RANGE
	JRST	ERCALL		;NO, TYPE A MESSAGE
	PUSHJ	P,DAT%V2	;[564] SET ERR.V & CHECK ERR=
	MOVE	T5,DATTAB(T5)	;GET THE DISPATCH ENTRY
	TLNE	T5,ER.HDR	;TYPE A HEADER
	PUSHJ	P,TY%HDR	;YES
	PJRST	EROPN%		;USE COMMON DISPATCH ROUTINE

ER%DA1:	SETZB	T5,T5		;[424] ASSUME BINARY
	TLNE	P3,IO.FMT	;[424][450] IS IT FORMATTED I/O?
	MOVEI	T5,1		;[424] YES
	MOVE	T5,RANTAB(T5)	;[424] GET CORRECT MESSAGE
	TYPSTR	(@T5)		;[330] OUTPUT MESSAGE
	SKIPN	DD.LIM(P3)	;[330] IS THERE A RECORD NUMBER
	PJRST	TY%DDB		;[330] NO - DO NOT TYPE #
	TLNN	P3,IO.FMT	;[424][450] IS IT FORMATTED I/O
	OUTSTR	[ASCIZ /
	or unwritten or destroyed record number:  /];[330]
	TLNE	P3,IO.FMT	;[424] [515] IS IT FORMATTED I/O
	OUTSTR	[ASCIZ /:  /]	;[424] SO RECORD NO. LOOKS NICE
	MOVE	T0,DD.LIM(P3)	;[330] GET RECORD NUMBER
	PUSHJ	P,TY%DEC	;[330] TYPE IT
	PJRST	TY%DDB		;[330] TYPE DDB INFO.

DATTAB:
XWD	,ERCALL							;(0)
XWD ER.HDR,DAT1							;(1)
;EDIT	424	DATTAB+2	DPL	22-JAN-75
XWD ER.HDR,ER%DA1						;[424] (2)
XWD ER.HDR!ER.DDB!ER.MSG,
[FIVBIT (Check sum error reading binary records)]		;(3)
XWD ER.HDR!ER.DDB!ER.MSG,
[FIVBIT (Input output list greater than record size)]		;(4)
XWD ,DAT5							;(5)
XWD ER.HDR!ER.DDB!ER.MSG,
[FIVBIT (Input output list without data conversion in format)]	;(6)
XWD ER.HDR!ER.DDB!ER.EDB,DAT7					;(7)
XWD ER.HDR!ER.DDB!ER.MSG,
[FIVBIT (Attempt to READ beyond valid input)]	;(10)
;**;[626] CHANGE XWD AT DATTAB+15 SWG 1-DEC-1976
XWD ER.HDR!ER.DDB,DAT11			;[626] (11)
XWD ER.HDR!ER.MSG,
[FIVBIT (REREAD before first READ is illegal)]		;(12)
XWD ER.HDR!ER.MSG,
[FIVBIT (can not RANDOM ACCESS a SEQUENTIAL file)]		;(13)
XWD ER.HDR!ER.MSG!ER.DDB,
[FIVBIT (BACKSPACE illegal for device)]			;(14)
XWD ER.HDR!ER.DDB!ER.EDB,DAT15					;(15)
XWD ER.HDR!ER.DDB!ER.EDB,DAT16					;(16)
XWD ER.HDR!ER.MSG,
[FIVBIT (can not do SEQUENTIAL ACCESS to a  RANDOM file)]		;[375] (17)
DAT.MX==.-DATTAB-1	;DEFINE THE TABLE SIZE
RANTAB:				;[424] 
XWD ER.MSG,[FIVBIT (LSCW Illegal in binary record or reading ASCII)]	;[424] (0)
XWD ER.MSG,[FIVBIT (Attempt to read unwritten ASCII RANDOM ACCESS record)]	;[424] (1)
	PAGE
	SUBTTL	SPECIAL DATA ERROR FAULT PROCESSING

DAT1:				;TYPE 1 ENTRY POINT
	TYPSTR	DAT1C		;TYPE THE MESSAGE
	PUSHJ	P,OPN11C	;[237] LOAD AND TYPE CHRACTER
	PUSHJ	P,TY%DDB	;GIVE THE UNIT NUMBER
	MOVE	T3,FBG.BP(P4)	;GET THE POINTER TO THE BEGINNING OF THE FORMAT
	MOVEI	T2,0		;[212] CLEAR CHARACTER COUNTER
DAT1A:	ILDB	T0,T3		;DUMP THE FORMAT STATEMENT
	OUTCHR	T0		;OUTPUT THE FORMAT STATEMENT
	CAMN	T3,G2		;IS THIS THE BAD CHARACTER
	HRLI	T2,0(T2)	;[212] YES - SAVE THE CHARACTER POSITION
	CAME	T3,FEN.BP(P4)	;END OF FORMAT?
	AOJA	T2,DAT1A	;NO, CONTINUE
	OUTSTR	[ASCIZ/
/]				;YES, FINISH THE LINE
	TLNE	T2,-1		;[212] COMPUTE BAD CHARACTER POSITION
	HLRZ	T2,T2		;[212] COMPUTE BAD CHARACTER POSITION
MARKCH:	MOVEI	T0," "		;GET A BLANK
	SOJL	T2,DAT1B	;COLUMN COUNTER
DAT1D:	OUTCHR	T0		;OUTPUT A SPACE
	SOJGE	T2,DAT1D	;CONTINUE UNTIL UNDER BAD CHARACTER
DAT1B:	OUTSTR	[ASCIZ/^
/]				;DUMP AN UP ARROW
	POPJ	P,		;RETURN

DAT1C:	FIVBIT (Illegal character in FORMAT statement)

DAT5:				;ASTERICK FILL ROUTINE FOR OUTPUT
IFE ASTFL,<JRST	ERCALL		;ASTERFIL IS TURNED OFF>

IFN ASTFL,<
	LDB	T1,W.PNTR##	;[265] GET THE FIELD WIDTH
	MOVEI	T0,"*"		;GET AN ASTERICK TO FILL WITH
	JSP	P1,OBYTE.##	;OUTPUT AN ASTERICK
	SOJG	T1,OBYTE.##	;CONTINUE FILLING
	POPJ	P,		;RETURN TO ROUTINE>

DAT7:				;ILLEGAL CHARACTER IN INPUT ROUTINE
	TYPSTR	DAT7A		;TYPE THE MEGGAGE 
DAT7F:	PUSHJ	P,OPN11B	;[347] [237] LOAD AND TYPE DELIMITED CHARACTER
	PUSHJ	P,TY%DDB	;GIVE THE UNIT NUMBER
	TLNN	P2,FT.LSD!FT.NML	;[354][347][451] LIST-DIRECTED I/O
	PUSHJ	P,DATFMT	;[354] NO - TYPE FORMAT
DAT7G:	MOVE	T1,DD.HRI(P3)	;[347] GET THE CURRENT BUFFER
;**; [636] INSERT @ DAT7G+1/2	CLRH	6-JAN-77
	TLNE	P3,IO.STR	;[636] ARE WE IN A STRING BUFFER?
	JRST	DAT7H		;[636] YES, HANDLE SEPARATELY
	TLNE	P3,IO.EDC	;[277] IN CASE OF ENCODE/DECODE
	JRST	DAT7E		;[277] USE START OF BUFFER
	HRRZ	T4,DD.BUF(P3)	;GET THE BUFFER SIZE
	ADDI	T4,-2(T1)	;GET THE END OF THE BUFFER
	MOVE	T3,POS.TB+1(P4)	;GET THE BEGINNING OF THE RECORD
	CAIG	T1,(T3)		;CHECK FOR BEGINNING OF BUFFER
	CAIGE	T4,(T3)		;[414] CHECK FOR THE END
DAT7E:	HRRZI	T3,1(T1)	;[414] [277]
				;NO, START PRINTING AT THE BEGINNING OF THE BUFFER
	TLNN	T3,-1		;[414] BYTE SIZE SET FROM POS.TB ?
	TLO	T3,(POINT 7,0,35);[414] NO - SET UP THE BYTE SIZE
	SETZ	T2,		;COUNT THE COLUMNS
DAT7B:	ILDB	T0,T3		;GET A CHARACTER
	OUTCHR	T0		;TYPE IT
	CAME	T3,DD.HRI+1(P3)	;IS THIS THE CHARACTR
	JRST	DAT7C		;NO
	PUSH	P,T2		;SAVE THE POSITION
	MOVN	T2,DD.HRI+2(P3)	;GET THE REMAINING CHARACTER COUNT
	SUBI	T2,1		;[277] TO GET ALL CHARS IN CASE OF ENC/DEC
;**;[474] Delete @ DAT7C	JNG	20-Nov-75
DAT7C:	AOJN	T2,DAT7B	;[474] END OF BUFFER OR LINE FEED
	POP	P,T2		;GET THE SPACING COUNT
	CAIE	T0,12		;LINE FEED ALREADY OUT
	OUTSTR	[ASCIZ /
/]				;NO, DUMP IT
	PUSHJ	P,MARKCH	;[212] MARK BAD CHARACTER
	JRST	SYSRET		;TAKE SYSTEM RETURN


DATFMT:	MOVE	T2,FST.DY(P4)	;[354] GET THE CURRENT ENCODED FORMAT STATEMENT
	MOVE	T2,-1(T2)	;GET THE ASCII FORMAT POINTER
	HLRZ	T1,T2		;GET THE WORD IN THE FORMAT
	ANDI	T1,377777	;[212] CLEAR THE ENCODING FLAG
	IMULI	T1,5		;FIVE CHARACTR/WORD
	HRLI	T2,(POINT 7,0);GET A BYTE POINTER TO THE STRING
DAT7D:	ILDB	T0,T2		;GET A CHARACTER
	OUTCHR	T0		;TYPE IT
	SOJG	T1,DAT7D	;CONTINUE THRU THE FORMAT
	OUTSTR	[ASCIZ /
/]
	POPJ	P,		;[354] RETURN
;MARK BAD CHARACTER

DAT7A:	FIVBIT	(Illegal character in data)
;**; [636] INSERT AFTER DAT7A	CLRH	6-JAN-77
DAT7H:	HLRZ	T1,T1		;[636] GET FIRST STRING BUFFER
	HLRZ	T3,0(T1)	;[636] GET WORD COUNT OF FIRST STRING
	MOVE	T4,T1		;[636] SAVE LINK WORD TO NEXT STRING
	SUBI	T3,3		;[636] SUBTRACT LENGTH OF REAL HEADER
	ADDI	T1,3		;[636] MOVE UP TO REAL BUFFER
	SETZ	T2,		;[636] CLEAR CHARACTER COUNT
DAT7I:	HRRZI	T1,1(T1)	;[636] MOVE TO FIRST DATA WORD
	SUBI	T3,1		;[636] ACCOUNT FOR IT IN WORD COUNT
	IMULI	T3,5		;[636] CONVERT TO ASCII BYTES
	TLO	T1,440700	;[636] MAKE BYTE POINTER
DAT7J:	ILDB	T0,T1		;[636] GET A CHARACTER
	OUTCHR	T0		;[636] OUTPUT IT
	CAMN	T1,DD.HRI+1(P3)	;[636] IS THIS THE CHARACTER?
	PUSH	P,T2		;[636] YES, SAVE POSITION
	AOS	T2		;[636] INCREMENT COLUMN COUNTER
	SOJG	T3,DAT7J	;[636] LOOP ON THIS STRING
	HRRZ	T4,0(T4)	;[636] GET NEXT STRING
	MOVE	T1,T4		;[636] SET UP NEW POINTER
	HLRZ	T3,0(T4)	;[636] GET LENGTH FIELD OF NEXT STRING
	SKIPE	T4		;[636] IF ANY
	JRST	DAT7I		;[636] LOOP UNTIL NO MORE STRINGS
	POP	P,T2		;[636] RETRIEVE CHARACTER COUNT
	CAIE	T0,12		;[636] LINEFEED ALREADY?
	OUTSTR	[ASCIZ /
/]				;[636] NO, OUTPUT ONE
	PUSHJ	P,MARKCH	;[636] MARK BAD CHARACTER
;**; [650] CHANGE @ DAT7J+15	SWG	21-MAR-77
	PUSHJ	P,DMPST.##	;[650][636] GET RID OF STRING
	JRST	SYSRET		;[636] TAKE SYSTEM RETURN

;**; [626] INSERT AT DAT15-1 SWG 1-DEC-1976
DAT11:	TYPSTR	DAT11A			;[626] PRINT 1ST PRT OF MESSAGE
	OUTSTR	[ASCII / /]		;[626] A SPACE
	MOVE	T1,-10(P)		;[626] OFFENDING NAME IS 10 FRAMES FROM TOP OF STACK
					;[626] *** BE CAREFUL OF THIS REF OF R17
	PUSHJ	P,TY%SIX		;[626] TYPE IT OUT 
	OUTSTR	[ASCII / /]		;[626] A SPACE
	TYPSTR	DAT11B			;[626] REST OF MESSAGE
	OUTSTR	[ASCII / /]		;[626] SPACE BEFORE NAMELIST NAME
	MOVE	T1,@P2			;[626] P2 POINTS TO NAMELIST NAME
	PUSHJ	P,TY%SIX		;[626] PRINT IT OUT
	POPJ	P,			;[626] RETURN
DAT11A:	FIVBIT	(Variable )		;[626]
DAT11B:	FIVBIT	( cannot be found in NAMELIST block )	;[626] REST OF MESSAGE
DAT15:	TYPSTR	DAT15M		;[347] TYPE THE MESSAGE
	JRST	DAT7F		;[347] AND OTHER INFORMATION
DAT15M:	FIVBIT	(Illegal delimiter in LIST DIRECTED input)
DAT16:	TYPSTR	DAT16M		;[354] TYPE MESSAGE
	PUSHJ	P,TYPDD6	;[354] TYPE CR-LF
	PJRST	DATFMT		;[354] FORMAT AND RETURN
DAT16M:	FIVBIT	(Missing WIDTH FIELD for A or R on input)	;[354]
	PAGE
	SUBTTL DEV DEVICE ERROR FAULT PROCESSOR
ER%DEV:
	HRRZ	T5,-1(P)	;[564]GET THE TYPE CODE
	JUMPN	T5,ERDEV1	;[564]CHECK FOR GETSTS UUO CALL
	HLLZ	T1,DD.UNT(P3)	;GET THE CHANNEL NUMBER
	TLO	T1,(GETSTS)	;GET A STATUS UUO
	XCT	T1		;GET THE DEVICE STATUS
;**; [552] INSERT @ ER@DEV  + 4 1/2	CLRH	9-JUN-76
	TRZ	T0,10000	;[552] CLEAR THE ACTIVE BIT -- NO ERROR
	JFFO	T0,ERDEV7	;GET THE MESSAGE INDEX
ERDEV7:	HRRZI	T5,-^D18(T1)	;[564] GET THE MESSAGE INDEX
ERDEV1:	PUSHJ	P,DEV%V2	;[564] SET ERR.V & CHECK ERR= (RETURN IF EOF)
	MOVE	T4,T5		;[564] PUT ERR NUM WHERE IT'S EXPECTED
	CAILE	T4,^D4		;[564] IS THE INDEX IN RANGE
	JRST	ERDEV6		;[211][564] CHECK FOR END OF TAPE
	MOVE	T1,DD.STS(P3)	;[211][564] GET DEVICE CHARACTERISTICS
	TLC	T1,DV.CDR!DV.IN	;[211] BLOCK
	TLCN	T1,DV.CDR!DV.IN	;[211] TOO LARGE
	CAIE	T4,3		;[211] ON CDR?
	SKIPA	T5,DEVTAB(T4)	;[211] NO - LOAD ERROR FLAGS
	MOVEI	T5,[FIVBIT (Nonexistent CDR file)]	;[211] - YES - LOAD ERROR FLAGS
	CAIE	T4,4		;END OF FILE CALL?
	JRST	ERDEV2		;NO, MUST BE AN ERROR CALL
;**; [711] @ERDEV1 + 14 (OCTAL)  SJW  23-SEP-77
	TLNE	T1,DV.DSK!DV.DTA!DV.TTA	;[711] ONE OF THESE DEVICES ?
	  JRST	ERDEV3		;[711] NO: DON'T CLOSE
	MOVE	T1,P		;[711] SAVE STKPTR+1 SO ERROR IN CLOSI.
	ADD	T1,[1,,1]	;[711]   WILL NOT RECURSE
	MOVEM	T1,ERR.SP(P4)	;[711]
	PUSHJ	P,CLOSI.##	;DO INPUT CLOSE
ERDEV3:	HRRZ	T1,ERR.PC(P4)	;[711] END = ADDRESS SPECIFIED?
	JUMPE	T1,ERDEV2	;[564] NO => CHECK ERR=
ERDEV4:	MOVEM	T1,USR.PC(P4)	;[225][447] CHANGE THE USR'S PC ADDRESS
;**;[510] Insert @ ERDEV4+1L	JNG	5-Dec-75
	MOVEM	T1,ALT.PC(P4)	;[510] STORE AGAIN AS EOF FLAG
	POPJ	P,		;[211] RETURN
ERDEV2:	HLRZ	T1,ERR.PC(P4)	;ERR = ADDRESS SPECIFIED?
	JUMPN	T1,ERDEV4	;[211] YES - TAKE ERROR RETURN
ERDEV5:	PUSH	P,T5		;[262] NO - SAVE T5
;**; [711] @ERDEV5 + 1  SJW  23-SEP-77
	TLZN	P3,IO.OPN	;[711] CLEAR THE OPEN BIT, OPEN ?
	  JRST	ERDEV8		;[711] NO: NO RELEASE
	MOVE	T1,P		;[711] SAVE STKPTR+1 SO ERROR IN RELE%%
	ADD	T1,[1,,1]	;[711]   WILL NOT RECURSE
	MOVEM	T1,ERR.SP(P4)	;[711]
	PUSHJ	P,RELE%%##	;RELEASE THE CHANNEL
ERDEV8:	POP	P,T5		;[711] RESTORE T5
	PUSHJ	P,TY%HDR	;[262] TYPE THE HEADER
	TYPSTR	(@T5)		;TYPE THE MESSAGE
	PUSHJ	P,TY%DDB	;TYPE THE DEVICE INFO
	JRST	SYSRET		;TAKE THE SYSTEM RETURN

; DEVICE DEPENDENT ERRORS

ERDEV6:	MOVE	T2,DD.STS(P3)	;[211] LOAD DEVICE CHARACTERISTICS
	CAIN	T1,^D25		;[211] END OF TAPE
	TLNN	T2,DV.MTA	;[211] ON MAGTAPE?
	POPJ	P,		;[211] NO - EXIT
	MOVEI	T5,[FIVBIT (End of tape)]	;[211] LOAD MESSAGE
	JRST	ERDEV2		;[564] ERR= OR ABORT


DEVTAB:			;DEVICE ERROR MESSAGE TABLE
	XWD	,[FIVBIT (Write protected)]			;(0)
	XWD	,[FIVBIT (Device error)]			;(1)
	XWD	,[FIVBIT (Parity error)]			;(2)
;**; [524] CHANGE @ DEVTAB + 4L	CLRH	17-MAR-76
	XWD	,[FIVBIT (Block too large quota exceeded or file structure full)]	; [524] (3)
	XWD	,[FIVBIT (End of file)]				;(4)
	PAGE
	SUBTTL MSG TYPE A MESSAGE OUT
ER%MSG:
	MOVE	T5,@-NN.(P)	;GET THE MESSAGE ADDRESS
	OUTSTR	(T5)		;OUTPUT THE MESSAGE
	OUTSTR	[ASCIZ /
/]
	JRST	USRRET		;RETURN TO THE ERROR MACRO
	PAGE
	SUBTTL	ERROR MESSAGE FOR ARRAY OUT OF BOUNDS

;ROUTINE TO GIVE A MESSAGE WHEN AN ARRAY BOUNDS VIOLATION IS
; DETECTED BY "PROAR."
;CALLED VIA FORER% WITH:
;	T1 - NAME OF THE ARRAY IN SIXBIT
;	T2 - LINE NUMBER OF THE STATEMENT IN THE
;		FORTRAN SOURCE THAT CONTAINS THE ARRAY REFERENCE
;	T4 - THE VALUE OF THE ILLEGAL SUBSCRIPT
;	T3 - THE DIMENSION THAT WAS VIOLATED
;     (THESE PARAMETERS WILL HAVE BEEN STORED ON THE STACK UPON
;	 ENTRY TO %FORER - WHERE "-NN.+1+TN(P)" IS THE
;	 ADDRESS AT WHICH TN IS SAVED)

ER%SRE:	PUSHJ	P,TY%HDR	;[250] TYPE ERROR HEADER
	OUTSTR	[ASCIZ/Subscript range error on line /]
	MOVE	T0,-NN.+1+T2(P)	;[250] LINE NUMBER ON WHICH ERROR
				;[250]  OCCURRED
	PUSHJ	P,TY%DEC	;[250] TYPE IT
	OUTSTR	[ASCIZ/ of /]
				;[250] FIND THE NAME OF THE ROUTINE
				;[250]  THAT CONTAINED THE
				;[250]  ARRAY REFERENCE. DO THIS BY
				;[250]  LOOKING BACK UP THE STACK FOR
				;[250]  THE CALL THAT PRECEEDED THE CALL
				;[250]  TO "PROAR." THE LOCATION BEFORE
				;[250]  THE ENTRY POINT WILL CONTAIN THE
				;[250]  FUNCTION NAME IN SIXBIT
	MOVEI	T5,-NN.(P)	;[250] STACK LOC BEFORE THE CALL TO %FORER
	PUSHJ	P,GETCAL	;[250] GET 1ST CALL BACK ON THE STACK -
				;[250]  THIS IS THE CALL TO PROAR.
	XCT	FORER%		;[250] ERROR IF AT TOP OF STACK
	CAI			;[250] SIMULATE ERROR(SYS,0,0) CALL
	SUBI	T5,1		;[250] SET PARAM FOR "GETCAL" TO STACK LOC 
				;[250]  PRECEEDING LOC FOR CALL TO PROAR.
	PUSHJ	P,GETCAL	;[250] 2ND CALL BACK IS CALL TO THE ROUTINE
				;[250]  IN QUESTION
	SKIPA	T1,[SIXBIT/MAIN./]	;[250] IF ARE AT TOP OF STACK, WERE
				;[250]  IN THE MAIN PROGRAM
	MOVE	T1,-1(T3)	;[250] OTHERWISE, T3 CONTAINS THE PUSHJ INSTR
				;[250]  GET THE CONTENTS OF THE LOC BEFORE
				;[250]  THE ENTRY POINT TRANSFERRED TO
	PUSHJ	P,TY%SIX	;[250] TYPE OUT THE ROUTINE NAME
	OUTSTR	[ASCIZ/
		Subscript /]
	MOVE	T0,-NN.+1+T3(P)	;[250] DIMENSION FOR WHICH BOUNDS
				;[250]  WERE EXCEEDED
	PUSHJ	P,TY%DEC	;[250]  TYPE IT
	OUTSTR	[ASCIZ/ of array /]
	MOVE	T1,-NN.+1+T1(P)	;[250] NAME OF ARRAY IN SIXBIT
	PUSHJ	P,TY%SIX	;[250] TYPE IT

	OUTSTR	[ASCIZ/ = /]
	MOVE	T0,-NN.+1+T4(P)	;[250] SUBSCRIPT VALUE
	PUSHJ	P,TY%DEC	;[250]  TYPE IT
	OUTSTR	[ASCIZ/
/]
	POPJ	P,		;[250] RETURN TO PROAR.

	PAGE
SUBTTL	FORTRAN TRACE ROUTINES
		ENTRY	TRACE%
	SIXBIT	/TRACE./	;NAME FOR TRACE
TRACE%:
	PUSHJ	P,SAVE.##	;SAVE THE AC'S FOR USER CALL
TRAC%%:				;FOROTS ENTRY WHEN AC'S ARE SAVED
	MOVEI	T5,(P)		;GET THE CURRENT STACK POSITION
;	MOVEI	T5,(P)		;[200] GET THE CURRENT STACK POINTER
TRACE1:	HRRZ	T4,USR.PC(P4)	;GET THE USER'S CALLING ADDRESS
	PUSHJ	P,GETCAZ	;ADDRESS CHECK IT
	POPJ	P,		;RETURNS T3= PUSHJ ADDRESS+1
	OUTSTR	[ASCIZ/
Name	(Loc)	 <<---	Caller	(Loc)	<#Args>	[Arg Types]
/]
TRACE2:	MOVE	T1,-1(T3)	;YES, GET THE SIXBIT SUBROUTINE NAME
	PUSHJ	P,TY%SIX	;TYPE THE SUBROUTINE NAME OUT
	OUTSTR	[ASCIZ/	(/]
	MOVEI	T0,(T3)		;ENTRY POINT TO THE SUBROUTINE
	PUSHJ	P,TY%OCT
	OUTSTR	[ASCIZ /)/]	;[211] TYPE A CLOSING PAREN
	TRNN	T3,700000	;[211] 6 DIGIT ADR?
	OUTSTR	[ASCIZ /	/];[211] NO - POSITION ON LINE
	OUTSTR	[ASCIZ/ <<---	 /]	;[211] FINISH CALLEE
	PUSH	P,T4		;SAVE THE ADDRESS OF THE PUSHJ +1
	SUBI	T5,1		;SET THE STACK BACK ONE
	PUSHJ	P,GETCAL	;GET THE NEXT CALL
	JRST	TRACE3		;END OF TRACE TO THE MAIN PROGAM
	EXCH	T4,(P)		;GET THE OLD PUSHJ+1 ADDRESS
	PUSHJ	P,TYPTRC	;TYPE THE TRACE
	POP	P,T4		;RESTORE THE NEW POINTER
	JRST	TRACE2		;CONTINUE
TRACE3:
	POP	P,T4		;RESTORE THE OLD POINTER
;**; [600] CHANGE @ TRACE3+1	CLRH	24-SEP-76
	HRRZ	T3,SA.ADR(P4)	;[600] GET THE STRATING ADDRESS
	SKIPA	T1,[SIXBIT /MAIN./]	;MAIN PROGRAM CALL
TYPTRC:	MOVE	T1,-1(T3)	;GET THE CALLING SUBROUTINE NAME
	PUSHJ	P,TY%SIX	;TYPE THE NAME
	OUTSTR	[ASCIZ/+/]	;
	MOVEI	T0,(T4)		;GET THE CALFER ADDRESS
	SUBI	T0,1(T3)	;MINUS THE ENTRY POINT
	PUSHJ	P,TY%OCT	;TYPE THE OFFSET FROM THE ENTRY
	OUTSTR	[ASCIZ/(/]	;LEFT PAREN
	MOVEI	T0,-1(T4)	;GET THE PUSHJ ADDRESS
	PUSHJ	P,TY%OCT	;TYPE IT
	OUTSTR	[ASCIZ /)	<#/];#ARGUEMENTS
	MOVE	T4,-2(T4)	;GET THE MOVEI ADDRESS
	HLL	T4,-1(T4)	;BUILD AN AOBJN POINTER
	HLRE	T0,T4		;GET THE ARGUMENT COUNT
	MOVMS	T0		;MAKE POSITIVE
	PUSHJ	P,TY%DEC	;TYPE IT OUT
	OUTSTR	[ASCIZ />	[/]	;TYPE A CLOSING BRACKET
	JUMPGE	T4,TYPTR2	;JUP IF NO ARGUMENTS
TYPTR1:	LDB	T1,[POINT 4,(T4),12]	;GET THE ARGUMENT TYPE
	IDIVI	T1,5		;FIVE ENTRIES / WORD
;**; [546] CHANGE @ TYPTR1 + 2	CLRH	18-MAY-76
	MOVE	T0,TYPCOD(T1)	;[546] GET THE ASCII TYPE CODE
	IMULI	T2,7		;GET THE SHIFT COUNT
	ROT	T0,7(T2)	;POSITION THE CHARACTER
	OUTCHR	T0		;OUTPUT THE ASCII CHARACTER
	AOBJN	T4,TYPTR1	;CONTINUE THRU THE ARGLIST
TYPTR2:	OUTSTR	[ASCII/]
/]				;CLOSING BRACKET
	POPJ	P,		;RETURN
;		 0123456701234567
TYPCOD:	ASCII	/ULIUFUOSDUUUCUUK/
;ROUTINE TO NEXT THE NEXT SUBROUTINE CALL FROM THE STACK
;	ENTRY		T5=THE STACK ADDRESS TO START THE SEARCH
;			PUSHJ	P,GETCAL
;	RETURN		(NON-SKIP)	;END OF STACK
;			(SKIP)		;T4= THE ADDRESS+1 OF THE PUSHJ
;					;T3=THE PUSHJ INSTRUCTION
GETCAL:
	CAIGE	T5,STK.SV(P4)	;IS THE THE BEGINNING OF THE STACK
	POPJ	P,		;YES, END OF SEARCH
	HRRZ	T4,(T5)		;GET THE STACK ENTRY
GETCAZ:	PUSHJ	P,ADRCHK	;IS THIS A VALID ADDRESS
	SOJA	T5,GETCAL	;NO, GET THE NEXT ENTRY
	MOVE	T3,-1(T4)	;GET THE CALLING INSTRUCTION
	HLRZ	T1,T3		;GET THE OP CODE
	CAIN	T1,(PUSHJ P,@)	;[412] IS IT AN INDIRECT CALL
	SKIPA	T3,(T3)		;[412] YES GET ADDRESS OF ROUTINE
	CAIN	T1,(PUSHJ P,)	;[412] IS IT A PUSHJ P,
	SKIPA			;[412] YES IT IS
	SOJA	T5,GETCAL	;NO, GET THE NEXT ENTRY
	HLRZ	T1,-2(T4)	;GET THE INSTRUCTION BEFORE THE PUSHJ
	CAIE	T1,(MOVEI L,)	;MUST LOAD THE ARGUMENT LIST
	SOJA	T5,GETCAL	;NO, GET THE NEXT ENTRY
	HLRZ	T1,(T3)		;GET THE TARGET INSTRUCTION
;**;[713] INSERT @GETCAZ + 15L  SJW  26-SEP-77
	CAIE	T1,(JSP 1,)	;[713] IS IT OVERLAY CALL ?
	  JRST	GETCA1		;[713] NO
	HRRZ	T1,(T3)		;[713] GET WORD BEFORE ROUTINE
	MOVE	T1,-1(T1)	;[713]   JSP'ED TO
	CAME	T1,[SIXBIT '.OVRLA']	;[713] LINK SETS UP ROUTINE NAME
	  SOJA	T5,GETCAL	;[713] NOT AN OVERLAY CALL
	HRRZ	T3,@1(T3)	;[713] GET ADR OF ROUTINE ENTRY
	HLRZ	T1,(T3)		;[713] GET 1ST INSTRUCTION LH
GETCA1:	CAIN	T1,(JRST 1,)	;[713] CHECK FOR CONCEALED ENTRY
	HRR	T3,(T3)		;YES, GO TO THE TRUE ENTRY
	JRST	CPOPJ1		;SKIP RETURN


;ROUTINE TO ADDRESS CHECK THE CONTENTS OF AC T4
;	ENTRY		MOVE	T4,ADDRESS TO BE CHACKED
;			PUSHJ	P,ADRCHK
;	RETURN		(NON-SKIP)	;INVALID ADDRESS
;			(SKIP)		;VALID ADDRESS

ADRCHK:				;ENTRY POINT
	CAIG	T4,140		;CHECK THE LIMITS OF THE LOW SEGMENT
	POPJ	P,		;BELOW THE LOW SEGMENT EXIT
	CAMG	T4,.JBREL	;CHECK FOR A VALID LOW SEG ADDRESS
	JRST	CPOPJ1		;YES, GIVE A SKIP RETURN
	SKIPN	T1,.JBHRL	;IS THERE A HIGH SEGMENT
	POPJ	P,		;NO, ERROR
	CAIGE	T4,400010	;ABOVE THE BEGINNING OF THE HIGH SEGMENT
	POPJ	P,		;NO, EXIT
	CAIGE	T4,(T1)		;BELOW THE END OF THE HIGH SEGMENT
CPOPJ1:	AOS	(P)		;YES, SKIP RETURN
CPOPJ:	POPJ	P,		;ERROR RETURN


	PAGE
	SUBTTL ERROR RECOVERY ROUTINES

;	ENTERED VIA PUSHJ P,<CLASS>%V2
;	  WITH <CLASS> ERROR VALUE IN T5
;	USES T1, T2, T3

;	SET T1 = NORMALIZING ERROR FACTOR FOR ERROR NUMBER
;	SET T2 = V1 # FOR UNCLASSIFIABLE <CLASS> ERROR


SYS%V2:	MOVEI	T1,^D100	;[564]
	MOVEI	T2,^D999	;[564]
	JRST	ERR%V2		;[564]

OPN%V2:	MOVEI	T1,^D250	;[564]
	MOVEI	T2,^D699	;[564]
	JRST	ERR%V2		;[564]

DAT%V2:	MOVEI	T1,^D300	;[564]
	MOVEI	T2,^D799	;[564]
	JRST	ERR%V2		;[564]

DEV%V2:	MOVEI	T1,^D400	;[564]
	MOVEI	T2,^D899	;[564]
	JRST	ERR%V2		;[564]

;	T1 = NORMALIZING ERROR FACTOR
;	T2 = V1 # FOR UNCLASSIFIABLE <CLASS> ERROR
;	   = SCRATCH IN/AFTER ERROR-SEARCH
;	T3 = SCRATCH

;	DON'T TOUCH T5 (OR T4) SO CAN CONTINUE NORMAL ERROR
;	  PROCESSING IF NECESSARY

;	IF ERR.V2 ALREADY SET THEN GOT HERE ON ERROR INSIDE
;	  CLEANUP => V2 GETS +2000 TO MARK FAILURE OF CLEANUP &
;	  EXIT (SINCE ERR= BRANCH ALREADY SET UP)
;	IF EOF (DEV #404) => EXIT SO ER%DEV CAN HANDLE END= THEN ERR=
;	IF NO ERR= THEN SHOULDN'T HANDLE => EXIT
;	IF NO CLEANUP ROUTINE THEN CAN'T HANDLE => EXIT
;	OTHERWISE:
;	  FIX ERR= TO BE RETURN POINT
;	  SET ERR.V2 AND LOOK UP V2 TO SET ERR.V1
;	    ERR.V1 := T2 (UNCLASSIFIABLE ERROR) IF V2 NOT FOUND
;	  CUT STACK BY RESTORING P FROM ERR.SP
;	  CALL CLEANUP ROUTINE
;	    SKIP RETURN ON SUCCESS => EXIT
;	    FAILURE => V2 GETS +1000 TO FLAG FAILURE & EXIT

ERR%V2:	ADD	T1,T5		;[564] NORMALIZE ERROR NUMBER
	SKIPE	0,ERR.V2(P4)	;[564] ALREADY AN ERROR SET ?
	JRST	ERR%ER		;[564] YES => CLEANUP FAILS

;	SEARCH ERROR TABLE FOR V2 TO SET V1

	MOVEM	T2,ERR.V1(P4)	;[564] DEFAULT IS "UNCLASSIFIABLE ERROR"
	MOVEM	T1,ERR.V2(P4)	;[564] STORE NORMALIZED ERROR NUMBER
	MOVEI	T2,ERR.CT	;[564] GET COUNT OF ERROR TABLE ENTRIES
ERRSE1:	HLRZ	T3,ERR.TB(T2)	;[564] GET NEXT V2 VALUE IN TABLE
	CAMN	T3,ERR.V2(P4)	;[564] MATCH ?
	JRST	ERRSE2		;[564] YES
	SOJGE	T2,ERRSE1	;[564] NEXT ENTRY INDEX & LOOP
	JRST	ERRSE3		;[564] NO MATCH => DEFAULT ALREADY SET
ERRSE2:	HRRZ	T3,ERR.TB(T2)	;[564] ERR.V2 FOUND =>
	MOVEM	T3,ERR.V1(P4)	;[564] SET ERR.V1
ERRSE3:
	CAIN	T1,^D404	;[564] EOF DEVICE ERR ?
	POPJ	P,		;[564] YES => EXIT BACK TO ER%DEV
	HLRZ	T2,ERR.PC(P4)	;[564] ERR= PRESENT ?
	CAIN	T2,0		;[564]
	POPJ	P,		;[564] NO => EXIT
;**;[714] DELETE  @ERRSE3 + 6  SJW  27-SEP-77
	MOVEM	T2,USR.PC(P4)	;[564] SET UP RETURN TO ERR=
	MOVEM	T2,ALT.PC(P4)	;[564]
;**;[714] @ERR%ER-4  SJW  27-SEP-77
	SKIPN	0,ERR.RT(P4)	;[714][564] CLEANUP ROUTINE ?
	  JRST	ERR%ER		;[714] NO:  REPORT FAILURE
	MOVE	P,ERR.SP(P4)	;[564] CUT THE STACK
	PUSHJ	P,@ERR.RT(P4)	;[564] CLEANUP HOPEFULLY
	JRST	ERR%FA		;[564] CLEANUP FAILED
	POPJ	P,		;[564] CLEANUP OK => EXIT TO USER

;**;  [711] @ERR%ER  SJW  23-SEP-77
;**;[714] @ERR%ER  SJW  27-SEP-77
ERR%ER:	SKIPE	ERR.SP(P4)	;[714] IS THERE A STK PTR SAVED ?
	  MOVE	P,ERR.SP(P4)	;[714][711] YES: CUT STACK TO ORIGINAL CALLER
	MOVEI	T2,^D2000	;[564] ERROR DURING CLEANUP
	JRST	ERRADD		;[564]

ERR%FA:	MOVEI	T2,^D1000	;[564] MARK CLEANUP FAILED
ERRADD:	ADDM	T2,ERR.V2(P4)	;[564]
	POPJ	P,		;[564] EXIT TO USER

ERR.TB:	ERRTBL			;[564] THE ERROR V2,,V1 TABLE

	END