/ERROR.V03
/8K FORTRAN LIBRARY
/COPYRIGHT 1969
/DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
/
/
/	ERROR ROUTINES
/
	ENTRY	SETERR
	ENTRY	CLRERR
	ENTRY	ERROR
	DUMMY	TEM1
/
/	SET UP IN CASE OF ERROR
/
SETERR,	BLOCK	2
	ISZ	ERDCTR	/ARE WE TRYING TO PUSH TOO MUCH
	SKP CLA		/NO
	HLT		/YES ... ERROR
	INC	ERUCTR	/INCREMENT ERROR UP COUNTER
	TAD I	SETERR	/CDF TO ERROR VECTOR
	DCA I	PTR	/TO ERROR PUSH STACK
	INC	PTR
	INC	SETERR#
	TAD I	SETERR	/ADDRESS OF ERROR VECTOR
	DCA I	PTR	/TO ERROR PUSH STACK
	INC	PTR
	INC	SETERR#
	RETRN	SETERR	/EXIT
PTR,	EVEC
ERUCTR,	0
ERDCTR,	-10
/
/	CLEAR LAST ITEM OFF ERROR PUSH STACK
/
CLRERR,	BLOCK	2
	CLA
	TAD	ERUCTR	/ERROR VECTOR UP COUNTER
	SNA CLA		/IS IT ZERO
	JMP	CLRIGN	/YES ... IGNORE CALL
	CLA CMA		/DECREMENT UP COUNTER
	TAD	ERUCTR
	DCA	ERUCTR
	CLA CMA		/DECREMENT DOWN COUNTER
	TAD	ERDCTR
	DCA	ERDCTR
	TAD	PTR	/DECREMENT POINTER
	TAD	(-2
	DCA	PTR
CLRIGN,	RETRN	CLRERR
/
/	FORMAT(/20H"XXXX" ERROR AT LOC 5I1)
/
	CPAGE	17
FMT,	5057
	6260
	1042
ERC1,	7777
ERC2,	7777
	4240
	0522
	2217
	2240
	0124
	4014
	1703
	4065
	1161
	5140
CALLIO,	BLOCK	1
	AND	(7
	DCA	CLTMP
	CALL	1,IOH
	ARG	CLTMP
	JMP I	CALLIO
CLTMP,	BLOCK	1
/
/	ERROR ROUTINE
/
ERROR,	BLOCK	2
ER1,	CLA
	TAD	ERUCTR	/HOW MANY ITEMS IN PUSH LIST
	SNA CLA
	JMP	ER2	/NONE
	CLA CMA
	TAD	ERUCTR	/DECREMENT LIST COUNT
	DCA	ERUCTR
	CLA CMA
	TAD	PTR	/DECREMENT POINTER
	DCA	PTR
	TAD I	PTR	/IT NOW POINTS TO ADDRESS
	DCA	TEM1#	/SAVE ADDRESS
	CLA CMA
	TAD	PTR	/DECREMENT POINTER
	DCA	PTR
	TAD I	PTR	/IT NOW POINTS TO CDF
	DCA	TEM1	/SAVE BANK
	TAD I	TEM1	/PICK UP FIRST 2 CHARACTERS OF ERROR VECTOR
	DCA	ERC1
	INC	TEM1#
	TAD I	TEM1	/PICK UP NEXT 2 CHAR
	DCA	ERC2
	INC	TEM1#
	TAD I	TEM1	/PICK UP FIELD OF LAST CALL
	RTR		/SHIFT BANK TO LOW AC
	RAR
	DCA	TEM2	/SAVE IT
	CALL	2,WRITE	/CALL TO WRITE ROUTINE
	ARG	(1	/ERROR COMMENTS ON TTY
	ARG	FMT	/ERROR COMMENT FORMAT
	TAD	TEM2	/BANK OF ERROR
	JMS	CALLIO	/MASK,SAVE AND OUTPUT
	ISZ	TEM1#	/INCREMENT TO ADDRESS
	TAD I	TEM1	/PICK UP ADDRESS
	DCA	TEM1
	TAD	TEM1	/ADDRESS OF ERROR
	RTL
	RTL
	JMS	CALLIO
	TAD	TEM1
	RTR
	RTR
	RTR
	JMS	CALLIO
	TAD	TEM1
	RTR
	RAR
	JMS	CALLIO
	TAD	TEM1
	JMS	CALLIO
	CALL	1,IOH
	ARG	0
	JMP	ER1
ER2,	HLT
	JMP	ER2
TEM1,	BLOCK	2
TEM2,	BLOCK	1
EVEC,	BLOCK	20
	END