Google
 

Trailing-Edge - PDP-10 Archives - BB-4157E-BM - fortran-ots-debugger/fortrp.mac
There are 3 other files named fortrp.mac in the archive. Click here to see a list.
	SEARCH	FORPRM
	TV	FORTRP	ARITHMETIC TRAP HANDLER,6(2033)
	SUBTTL	CHRIS SMITH/CKS		31-Jul-79

;COPYRIGHT (C) 1981  BY  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;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 *****

Modified from LIB40 TRAPS version 32A(444)

1100	CKS	10-Aug-79
	Rewrite for version 6
	Remove KA code and fixups for KA-format double precision instructions
	Add integer fixups (not enabled)
	Change UTRP instruction to JSR (can't use PUSHJ because DDT's stack
	 pointer is AC 1)
	Reorder stuff to optimize for SWTRP and UTRP
	Add fixups for G-format DP numbers

1217	JLC	09-Dec-80
	Fix integer divide check so it "patches" the answer

1464	DAW	12-May-81
	Error messages.

1466	CKS	18-May-81
	Use XSIR-format tables if the monitor supports them

1526	BL	9-Jul-81
	Make %PSIINI 'IF20'-conditional.

1531	JLC	10-Jul-81
	Typo in edit 1526.

1572	JLC	31-Jul-81	Q10-6348
	Setup F before calling trap error typeout.

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

1662	DAW	4-Sep-81
	New routine %CALU.

1700	BL	10-Sep-81
	Remove INTERN %CALU from 'IF20'.

1731	DAW	21-Sep-81
	Overflows not filling in the right stuff.

1753	DAW	29-Sep-81
	Don't call %TRACE on LERR's - PC is part of message now.

2033	DAW	19-Nov-81
	Don't do XSIR% unless FOROTS is running in a non-zero section;
	otherwise the Release 4 EXEC gets confused.

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

\

	SEGMENT	CODE

	ENTRY	%TRPINI,%APRTXT
IF20,	<INTERN	%PSIINI>
	INTERN	%CALU
	EXTERN	%APRCT,%APRSB,%APRLM,%TRACE
	EXTERN	I.XSIR,I.FLAG,%LEVTAB,%CHNTAB,%PC1,%PC2,%PC3
REPEAT 0,<

DESCRIPTION OF "TRAPS" PROGRAM FOR LIB40-

I. THE PURPOSE OF THE TRAPS PROGRAM IS DO ERROR DETECTION,
   CORRECTION, AND REPORTING WHEN ARITHMETIC FAULTS OCCUR
   DURING THE EXECUTION OF FORTRAN PROGRAMS.

II. THE TRAPS PROGRAM CONSISTS OF THREE DISTINCT PARTS:

	A. TRPINI
		1. CALLING SEQUENCE- PUSHJ P,TRPINI
						;RETURN
		2. THE OVERFLOW COUNTER, OVCNT, (USED BY THE OVERFL
		      FUNCTION) AND THE PC WORD FLAGS ARE CLEARED
		3. PROCESSOR AND MONITOR TRAPPING ON OVERFLOW (PC WORD
		      BIT 0) IS ENNABLED

	B. "OVERFL" IS THE STANDARD FORTRAN OVERFLOW FUNCTION
	   (BUT EXISTS AS A SEPARATE FORTRAN PROGRAM ELSEWHERE
	    IN THE FORTRAN LIBRARY).
		1. CALLING SEQUENCE-	JSA 16,OVERFL
					ARG	J
						;RETURN
		2. IF OVCNT. .EQ. 0 , THEN J_1
		3. IF OVCNT. .NE. 0, THEN J_2
		4. THE OVERFLOW COUNTER, OVCNT., IS CLEARED TO 0

	C. OVTRAP IS A USER-MODE INTERRUPT ROUTINE WHICH IS STARTED
	   BY THE MONITOR WHEN AN ARITHMETIC FAULT OCCURS
		1. The PC word (with the address+1 of the instruction
		      causing the trap) is stored in PC.
		2. FOR FLOATING POINT INSTRUCTIONS
			A. FOR OVERFLOWS AND DIVIDE CHECKS,
			   THE FAULTY ANSWER IS PATCHED
			   TO BE PLUS OR MINUS (THE SIGN WILL BE THAT
			   OF THE CORRECT ANSWER)THE LARGEST POSSIBLE
			   NUMBER.
			B. FOR UNDERFLOWS, THE FAULTY ANSWER IS NORMALLY
			   PATCHED TO BE 0. HOWEVER, IF THE INSTRUCTION
			   FOLLOWING THE TRAPPING INSTRUCTION IS A JFCL
			   WITH BIT 16 (XR2) SET, THE ANSWER WILL BE
			   UN-NORMALIZED ENOUGH TO BRING THE EXPONENT
			   BACK INTO RANGE.
		3. For integer instructions, no attempt is made to fix
		   up the faulty result.  Code is present to do this,
		   but is assembled out.  The problem is with the instructions
		   AOJX, AOSX, SOJX, and SOSX.  These can modify the PC
		   and overflow.  The new PC stored by the overflow trap
		   does not point to the instruction that overflowed, so
		   the recovery code will "fix" up a random instruction.  The
		   probability of this occurrence is small, but if it does
		   happen there is no way to limit the consequences.
		   The only available solution is to not touch any integer	
		   overflow.  Future versions of TOPS-20 microcode will fill
		   in the SWTRP block with the instruction that caused the
		   overflow, and then integer fixups can safely be enabled.

		4. IF THE INSTRUCTION AFTER THE TRAPPING INSTRUCTION
		      IS JFCL
		      A. DO NOT TYPE AN ERROR MESSAGE
			 UNLESS BIT 9 (AR OV TEST BIT) OR 17 (XR1) IS 1
		      B. DO NOT INDEX THE OVERFLOW COUNTER OVCNT
		      C. IF THE ADDRESS (BITS 18-35) OF THE JFCL
			 ARE NON-ZERO, THE INTERRUPTED PROGRAM WILL
			 BE RESTARTED AT THE ADDRESS OF THE JFCL
			  (THE @ AND INDEX FIELDS ARE IGNORED).
		      D. IF THE ADDRESS OF THE JFCL IS ZERO, THE
			 INTERRUPTED PROGRAM WILL BE RESTARTED AT
			 THE JFCL
		      E. IF BIT 16 (XR2) IS A 1, UN-NORMALIZE THE
			 FRACTION BITS FOR UNDERFLOWS IN ORDER TO
			 BRING THE EXPONENT BACK INTO RANGE.
		      F. IF BIT 15(XR4) IS A 1, TREAT THE RESULT AS
			 D.P. (WORKS FOR FSC ONLY)
		5. IF THE INSTRUCTION AFTER THE TRAPPING INSTRUCTION
		      IS NOT JFCL
		      A. INDEX THE OVERFLOW COUNTER, OVCNT
		      B. TYPE AN ERROR MESSAGE, USING SUBROUTINE "ERRMSG",
			 WITH THE FOLLOWING INFORMATION:
				FLOATING OR INTEGER FAULT
				OVERFLOW, UNDERFLOW, OR DIVIDE CHECK
				ADDRESS OF FAULTING INSTRUCTION

		      C. THE INTERRUPTED PROGRAM WILL BE RESTARTED AT
			 THE INSTRUCTION AFTER THE TRAPPING INSTRUCTION
		6. THE PROCESSOR FLAGS (PC WORD FLAGS) ARE CLEARED
			EXCEPT FOR CRY0, CRY1, AND USER IOT.
		7. THE INTERRUPTED PROGRAM IS RESTARTED
III. LIMITATIONS

	A. OVTRAP FIXUPS WILL NOT WORK ON THE PDP-6 FOR-
		1. THE LOW ORDER WORD OF FXXRL OR FXXL INSTRUCTIONS
		2. EXPONENT UNDERFLOW OR DIVIDE CHECK TRAPS

	A1.  Fixups are not made for KA-format double precision
		numbers.  The instructions FADL, FSBL, FMPL, FDVL,
		UFA, and DFN are not recognized as requiring fixups.

	B. FLOATING POINT FIX UPS WILL NOT OCCUR FOR INSTRUCTIONS
	   THAT ARE EXECUTED BY AN XCT OR A UUO

	C. THE MEMORY FIX UPS FOR THE FLOATING POINT INSTRUCTIONS
	   WILL NOT WORK PROPERLY IF THE ANSWER IS STORED INDEXED
	   BY 17 (THE PUSH DOWN POINTER). EXAMPLES:

			FADRM AC,(17)
			FMPRB AC,-2(17)
			FDVM  AC,+1(17)

	D. MOVNX and MOVMX are integer instructions and will have
	   get integer fixups if they cause overflow.  These
	   instructions can't overflow when dealing with normalized
	   floating point numbers.

	E. TRAPPING INSTRUCTION MUST NOT BE IN AC 0.

	F. THE SIGN OF F.P. DIVIDE CHECK FIX UPS WILL BE CORRECT
	    ONLY WHEN DIVIDING BY ZERO. (THIS IMPLIES THAT THE
	    ARGUMENTS FOR DIVIDE CHECKS SHOULD BE NORMALIZED.)

>	;END REPEAT 0
;PC FLAGS

PC.OVF==1B0			;OVERFLOW
PC.FXO==1B3			;FLOATING OVERFLOW
PC.FXU==1B11			;FLOATING UNDERFLOW
PC.NDV==1B12			;NO DIVIDE

IF20,<
	DDTBEG==764000		;LOWEST ADDRESS IN DDT
>






;ENTRY POINT TO INITALIZE TRAP HANDLER

%TRPINI:
IF20,<
	STKVAR	<DWPCF,>	;Allocate doubleword for PC and flags
	XMOVEI	T1,.		;Get section number
	TLNN	T1,-1		; Are we running in section 0?
	 JRST	JSTF1W		;No, have to do "JRSTF"
	HRRI	T1,JSTF1W+1	;Place to go
	MOVEM	T1,1+DWPCF	;Save in 2nd word
	MOVE	T1,[014000,,0] ;Flags
	MOVEM	T1,DWPCF	;Save in 1st word
	XJRSTF	DWPCF		;** Clear arithmetic flags **
JSTF1W:	JRSTF	@[014000,,.+1]	;Section 0 JRSTF
	UNSTK			;Discard stkvars
> ;IF20
IF10,<
	JRSTF	@[014000,,.+1]	;MAKE SURE ALL ARITHMETIC FLAGS ARE OFF
> ;IF10
	MOVSI	T1,-<.ETNUM>	;GET AOBJN POINTER FOR ERROR TABLE
	MOVEI	T2,WRNCNT	;SET ALL ERROR LIMITS TO WRNCNT
	MOVEM	T2,%APRLM(T1)
	AOBJN	T1,.-1
IF20,<
	XMOVEI	T1,OVTRP	;SET TRAP ADDRESS IN CONTROL BLOCK
	MOVEM	T1,NPC

	MOVEI	T1,.FHSLF	;THIS FORK
	MOVEI	T2,.SWART	;SET ARITHMETIC TRAP ADDRESS
	XMOVEI	T3,TRPBLK	;POINT TO CONTROL BLOCK
	SWTRP%			;TELL MONITOR
	  ERJMP	NSWTRP		;NO SWTRP, GO USE INTERRUPT SYSTEM
	POPJ	P,		;DONE

NSWTRP:	MOVE	T1,[1,,OVINT]	;SET OVERFLOW INTERRUPT ON LEVEL 1
	SKIPE	I.XSIR		;DIFFERENT FORMAT FOR XSIR TABLE
	  MOVE	T1,[1B5 + OVINT]
	MOVEM	T1,%CHNTAB+.ICAOV

	MOVEI	T1,.FHSLF	;ACTIVATE OVERFLOW INTERRUPT
	MOVSI	T2,(1B<.ICAOV>)
	AIC%

	POPJ	P,		;DONE


;HERE FROM MONITOR ON OVERFLOW SOFTWARE INTERRUPT
;FAKE THINGS AS IF SWTRP HAD SET THEM UP

OVINT:	DMOVEM	T0,ACS		;SAVE T0-T1
	XMOVEI	T0,OVTRP	;GET ADDRESS TO DEBRK TO
	SKIPN	I.XSIR		;XSIR format?
	 JRST	OVINT1		;No, SIR format
	EXCH	T0,%PC1+1	;Yes, use doubleword PC
	MOVEM	T0,PC		;Save PC of trapped inst. + 1
	JRST	OVINT2

OVINT1:	EXCH	T0,%PC1		;Save it, get PC+1 of trap
	HRRZM	T0,PC

OVINT2:	HLLZ	T1,%PC1		;Get flags
	HLLM	T1,FLGS		; Store

	SUBI	T0,1		;DECREMENT PC TO POINT TO TRAP INST
	MOVE	T0,@T0		;GET TRAP INSTRUCTION
	XMOVEI	T1,@T0		;GET EFFECTIVE ADDRESS OF INSTRUCTION
	MOVEM	T1,E		;Store it
	TLZ	T0,37		;CLEAR INDIRECT AND INDEX BITS OF INST
	HLRM	T0,INST		;STORE INSTRUCTION CAUSING TRAP

	DMOVE	T0,ACS		;RESTORE T0-T1
	DEBRK%			;TAKE ANOTHER TRIP THROUGH MONITOR,
				; COME OUT AT OVTRP

;HERE ON OVERFLOW TRAP WITH TRPBLK FILLED IN

OVTRP:	DMOVEM	T0,ACS		;SAVE T0-T1
	HRRZ	T0,PC		;Get PC+1 of trap (18 bits only)
	CAILE	T0,DDTBEG	;IS TRAP FROM INSIDE DDT?
	  JRST	DDTRET		;YES, RETURN
;STILL IF20

	SEGMENT	DATA


;SWTRP BLOCK, FILLED IN BY MONITOR OR MICROCODE ON OVERFLOW TRAP

TRPBLK:!
FLGS:!				;LH = PC FLAGS
INST:	BLOCK	1		;RH = LH(TRAP INSTRUCTION)
PC:	BLOCK	1		;PC+1 OF TRAP INSTRUCTION
E:	BLOCK	1		;E OF TRAP INSTRUCTION
NPC:	BLOCK	1		;NEW PC TO USE AT TRAP

>;END IF20
IF10,<

	MOVE	T1,[JRST OVINT]	;SET UP JRST TO HIGH SEG
	MOVEM	T1,LTRAP+1	;STORE IN WRITABLE MEMORY FOR JSR

	MOVE	T1,[1,,[2	;SET TRAP,,BLOCK LENGTH
			.UTAOF	;TRAP ON ARITHMETIC OVERFLOW
			JSR LTRAP]] ;INSTRUCTION TO EXECUTE ON TRAP
	UTRP.	T1,		;SET INSTRUCTION TO EXECUTE
	  JRST	NUTRP		;CAN'T, USE APRENB

	POPJ	P,		;DONE

NUTRP:	MOVEI	T1,APRTRP	;GET TRAP ADDRESS
	HRRZM	T1,.JBAPR	;STORE IN JOBDAT
	MOVEI	T1,AP.REN+AP.AOV+AP.FOV	;TRAP ON OVERFLOW
	APRENB	T1,		;ENABLE TRAPS
	POPJ	P,		;DONE


;HERE FROM MONITOR ON APRENB TRAP
;MOVE PC TO WHERE UTRP WOULD HAVE PUT IT

APRTRP:	PORTAL	.+1		;OK TO ENTER HERE FROM PUBLIC PAGE
	DMOVEM	T0,ACS		;SAVE T0-T1
	MOVE	T0,.JBTPC	;GET TRAP PC
	MOVEM	T0,PC		;STORE IT IN RIGHT PLACE
	JRST	OVINT1		;JOIN UTRP CODE

;HERE FROM JSR ON DIRECT OVERFLOW TRAP

OVINT:	PORTAL	.+1		;OK TO ENTER HERE FROM PUBLIC PAGE
	DMOVEM	T0,ACS		;SAVE T0-T1
	MOVE	T0,LTRAP	;GET TRAP PC
OVINT1:	SUBI	T0,1		;DECREMENT TO POINT AT TRAP INSTRUCTION
	MOVE	T0,@T0		;GET TRAP INSTRUCTION
	XMOVEI	T1,@T0		;GET ITS EFFECTIVE ADDRESS
	MOVEM	T1,E		;STORE IT
	TLZ	T0,37		;CLEAR INDIRECT & INDEX BITS
	HLRZM	T0,INST		;STORE TRAP INSTRUCTION

	HRRZ	T0,.JBDDT	;GET DDT START ADDRESS
	HLRZ	T1,.JBDDT	;AND END ADDRESS
	CAIG	T0,@PC		;INSIDE DDT?
	CAIGE	T1,@PC
	  JRST	.+2	   	;NO, FINE
	JRST	DDTRET		;IGNORE TRAP IF FROM DDT
;STILL IF10

	SEGMENT	DATA		;TO LOW SEG
PC:
FLGS:!
LTRAP:!	BLOCK	2		;JSR HERE ON OVERFLOW

INST:	BLOCK	1		;TRAP INSTRUCTION
E:	BLOCK	1		;ITS EFFECTIVE ADDRESS

>;END IF10


AC:	BLOCK	1		;AC FIELD OF TRAP INSTRUCTION
ACS:	BLOCK	4		;TEMP SPACE FOR T0-T3
ERRN:	BLOCK	1		;TEMP FOR ERROR MESSAGE TYPER
UPC:	BLOCK	1		;TEMP FOR ERROR MESSAGE TYPER

	SEGMENT	CODE
;HERE ON ANY APR TRAP
;ACS T0-T1 ARE SAVED

OVTRAP:	DMOVEM	T2,ACS+T2	;SAVE T2-T3
	LDB	T1,[POINT 9,INST,26] ;GET OPCODE OF TRAP INSTRUCTION
	CAIL	T1,100		;OUTSIDE TABLE RANGE?
	CAILE	T1,377
	  MOVEI	T1,100		;YES, SET TO KNOWN, INNOCUOUS INSTRUCTION
	IDIVI	T1,9		;9 BYTES PER WORD
	LDB	T1,BPTAB(T2)	;GET FLAG BITS FOR THIS INSTRUCTION

	JUMPE	T1,XRET		;INSTRUCTION CAN'T OVERFLOW, DON'T TRY FIXUPS

	LDB	T2,[POINT 4,INST,30] ;GET AC FIELD OF INSTRUCTION
	CAIG	T2,T3		;DOES INST USE ACS T0-T3?
	 XMOVEI	T2,ACS(T2)	;YES, RELOCATE TO SAVED ACS
	MOVEM	T2,AC		;SAVE AC ADDRESS OF INSTRUCTION

	MOVE	T2,E		;GET EFFECTIVE ADDRESS
	CAIG	T2,T3		;IN SAVED ACS?
	 XMOVEI	T2,ACS(T2)	;YES, RELOCATE
	MOVEM	T2,E

	CAIN	T1,SP		;SPECIAL INSTRUCTION?
	  JRST	SPINST		;YES, HANDLE SEPARATELY
SPCONT:	HLLZ	T0,FLGS		;GET PC FLAGS
	TLNN	T0,(PC.FXU)	;FLOATING UNDERFLOW?
	  JRST	OV		;NO, GO HANDLE OVERFLOW

	MOVE	T2,@PC		;GET INSTRUCTION AFTER TRAP INST
	TLC	T2,(JFCL (2))	;IS IT A JFCL (2)?
	TLNN	T2,777002
	  JRST	UNNORM		;YES, GO UNNORMALIZE RESULT

	SETZB	T2,T3		;NORMAL CASE, JUST STORE ZERO
	JRST	STRET		;DONE

UNNORM:	XCT	XLOAD(T1)	;GET RESULT STORED BY THE HARDWARE, HAS
				;CORRECT FRACTION AND EXPONENT TOO LARGE
				;BY 400
	PUSH	P,T1		;SAVE T1
	HLRE	T1,T2		;GET EXPONENT AND SIGN AND SOME FRACTION BITS
	ASH	T1,-9		;GET RID OF FRACTION BITS
	TSCE	T1,T1		;GET ABS(EXPONENT), SKIP IF POSITIVE FRACTION
	  TLOA	T2,777000	;NEGATIVE FRACTION, SET EXPONENT TO ALL ONES
	TLZ	T2,777000	;POSITIVE FRACTION, SET EXPONENT TO ALL ZEROS
	CAME	T1,[377,,377]	;SUPPRESS ZERO-BIT SHIFT (-0 IS -256)
	  ASHC	T2,400001(T1)	;UNNORMALIZE FRACTION, KEEP 1 BIT FOR ROUNDING
	POP	P,T1		;GET FLAG BITS BACK
	TRNE	T1,DPBIT	;WAS TRAP INSTRUCTION DOUBLE PRECISION?
	  JRST	DROUND		;YES, GO ROUND DP NUMBER
	ADDI	T2,1		;ROUND HIGH WORD OF FRACTION
	ASH	T2,-1		;DISCARD ROUNDING BIT
	JRST	STRET		;DONE

DROUND:	TLO	T3,(1B0)	;PREVENT INTEGER OVERFLOW WHEN WE ROUND
	ADDI	T3,1		;ROUND LOW WORD
	TLZN	T3,(1B0)	;DID FRACTION OVERFLOW INTO SIGN BIT?
	  ADDI	T2,1		;YES, PROPAGATE CARRY TO HIGH WORD
	ASHC	T2,-1		;DISCARD ROUNDING BIT
	JRST	STRET		;DONE
;HERE ON FLOATING & INTEGER OVERFLOW AND DIVIDE CHECK

OV:	TLNE	T0,(PC.NDV)	;NO DIVIDE?
	  JRST	DIVCHK		;YES. CHECK FOR 0/0
	TLNN	T0,(PC.FXO)	;NO. FLOATING OVERFLOW?
	  JRST	OVRET		;NO. INTEGER FIXUP IS DANGEROUS
	JRST	NDVCHK		;YES. GO ON WITH FIXUP

DIVCHK:	SKIPN	@AC		;YES, ZERO DIVIDEND?
	  JRST	OVRET		;0/0, CAN'T DETERMINE SIGN SO LEAVE 0 RESULT


NDVCHK:	TRNN	T1,ACBIT	;DID INST STORE ITS RESULT IN THE AC?
	TLNE	T0,(PC.NDV)	;YES, NO-DIVIDE, WHICH STORES NO RESULT?
	  SKIPA	T2,@AC		;NO, GET RESULT FROM AC
	MOVE	T2,@E		;ELSE GET RESULT FROM E

	TRZE	T1,WRONGBIT	;DID INST STORE WRONG SIGN?
	  TLC	T2,(1B0)	;YES, SET CORRECT SIGN

	JUMPL	T2,NEGOV	;IF CORRECT ANSWER NEGATIVE, GO SET -INF
	DMOVE	T2,[OCT 377777777777,377777777777] ;GET +INFINITY
	JRST	STRET

NEGOV:	TLNN	T0,(PC.FXO)	;FLOATING OVERFLOW?
	  JRST	INTOV		;NO, USE INTEGER -INFINITY

	MOVN	T2,[OCT 377777777777] ;FLOATING, GET FLOATING -INFINITY
	TRNE	T1,DPBIT	;WAS INSTRUCTION DOUBLE PRECISION?
	  DMOVN	T2,[OCT 377777777777,377777777777] ;YES, GET IT IN DP
	JRST	STRET		;GO STORE RESULT AND RETURN

INTOV:	DMOVE	T2,[OCT 400000000000,0] ;GET INTEGER -INFINITY

STRET:	XCT	XSTORE(T1)	;STORE ANSWER

OVRET:	MOVE	T1,@PC		;GET INSTRUCTION FOLLOWING ONE THAT TRAPPED
	TLC	T1,(JFCL)	;IS IT JFCL?
	TLNE	T1,777401	;CHECK FOR JOV OR JFCL (1) OR ANYTHING BUT JFCL
	  JRST	ERRPNT		;GO TYPE ERROR MESSAGE
	TRNE	T1,-1		;IS IT JFCL ADDR?
	  HRRM	T1,PC		;YES, RETURN TO THAT ADDRESS

XRET:	DMOVE	T2,ACS+T2	;RESTORE T2-T3
DDTRET:	MOVSI	T1,(PC.OVF+PC.FXO+PC.FXU+PC.NDV) ;CLEAR OV, FXO, FXU, NDV
	ANDCAB	T1,FLGS
IF20,<
	XMOVEI	T0,.		;In extended addressing?
	TLNN	T0,-1		;Skip if yes
	 JRST	DDTRT0		;No
	DMOVE	T0,ACS		;RESTORE T0-T1
	XJRSTF	FLGS		;Return to user.
>;END IF20

DDTRT0:	HLLM	T1,PC		;STORE FLAGS FOR JRSTF
	DMOVE	T0,ACS		;RESTORE T0-T1
	JRSTF	@PC
;SPECIAL CASES

SPINST:	LDB	T1,[POINT 9,INST,26] ;GET OPCODE AGAIN
	CAIN	T1,(EXTEND_-9)	;EXTEND?
	  JRST	SPEXT		;YES, GO HANDLE
	CAIN	T1,(XCT_-9)	;EXECUTE?
	  JRST	SPXCT		;YES, GO HANDLE

				;MUST BE FIX OR FIXR
	MOVE	T1,@E		;GET OPERAND
	MOVEM	T1,@AC		;STORE IN AC FOR SIGN FIXUP
	MOVEI	T1,SA		;INST IS SINGLE PRECISION, STORES IN AC
	JRST	OV		;GO HANDLE OVERFLOW

SPEXT:	MOVE	T1,ACS+T1	;RESTORE NONZERO ACS
	DMOVE	T2,ACS+T2
	MOVE	T0,@E		;GET EXTENDED INST
	XMOVEI	T1,@T0		;GET ITS EFFECTIVE ADDRESS
	CAIG	T1,T3		;IN SAVED ACS?
	 XMOVEI	T1,ACS(T1)	;YES, RELOCATE
	MOVEM	T1,E		;Store real E

	LDB	T1,[POINT 9,T0,8] ;GET EXTEND OPCODE
	CAIL	T1,020		;OUTSIDE TABLE RANGE?
	CAILE	T1,031
	  MOVEI	T1,020		;YES, SET TO KNOWN INNOCUOUS INSTRUCTION
	ADDI	T1,400-020	;OFFSET TO END OF MAIN TABLE
	IDIVI	T1,9		;9 BYTES PER WORD
	LDB	T1,BPTAB(T2)	;GET FLAG BITS FOR INSTRUCTION
	JUMPE	T1,XRET		;IF INST CAN'T OVERFLOW, DON'T TRY FIXUP

	TRZN	T1,WRONGBIT	;DOES INST LEAVE RESULT IN WRONG OPERAND?
	  JRST	SPCONT		;NO, FINE
	MOVE	T0,@E		;GET OPERAND
	MOVEM	T0,@AC		;STORE IN AC FOR SIGN FIXUP
	JRST	SPCONT		;GO CONTINUE AS IF NORMAL INST

SPXCT:	MOVE	T1,ACS+T1	;RESTORE NONZERO ACS
	DMOVE	T2,ACS+T2
	MOVE	T0,@E		;GET XCTED INST
	XMOVEI	T1,@T0		;GET ITS EFFECTIVE ADDRESS
	CAIG	T2,T3		;IN SAVED ACS?
	 XMOVEI	T2,ACS(T2)	;YES, RELOCATE
	HLRM	T0,INST		;STORE INST
	MOVEM	T1,E		;Store E
	JRST	OVTRAP		;START OVER
;ERROR MESSAGE TYPER

ERRPNT:	PUSH	P,PC		;SAVE RETURN PC
	TLNN	T1,777000	;WAS INST FOLLOWING TRAP INST A JFCL?
	TRNN	T1,777777	;YES, WAS IT JFCL ADDR?
	  TRNA			;NO
	HRRM	T1,(P)		;YES, CHANGE PC TO RETURN TO

	LDB	T1,[POINT 10,FLGS,12] ;GET PC FLAGS
	TRZ	T1,774		;CLEAR ALL BUT FXO, FXU, NDV
	TRZE	T1,1000		;MOVE FXO NEXT TO THE OTHER TWO
	  TRO	T1,4

	SOS	T2,PC		;DECREMENT PC TO POINT TO FAILING INSTRUCTION
	AOS	T3,%APRCT(T1)	;INCREMENT COUNT
	CAMLE	T3,%APRLM(T1)	;COMPARE WITH LIMIT
	  JRST	URET		;TOO MANY, SUPPRESS MESSAGE

	MOVE	T3,%APRTXT(T1)	;Get address of message text
	PUSH	P,F		;SAVE WHAT'S IN F
	MOVE	F,I.FLAG	;GET THE F FLAGS
;	ERR	(APR,,,%,$A at $1L,<T3,T2>)
	$ECALL	APR
	POP	P,F		;RESTORE F

;Here with T1= err #, T2= PC of trapped instruction

URET:	MOVE	T3,T2		;T3= PC to tell user about (maybe)
	MOVE	T2,T1		;T2= err #
	POP	P,PC		;RESTORE REAL PC TO RETURN TO
	SKIPN	T1,%APRSB(T1)	;IS THERE A USER TRAP ROUTINE FOR THIS ERROR?
	  JRST	XRET		;NO, DONE

	PUSHJ	P,%CALU		;** Call user routine **
	JRST	XRET		; and return from error


;%CALU - calls user routine for handling error message
;Input:
;	T1/ Addr to call
;	T2/ err # (e.g. .ETLRE)
;	T3/ PC to tell user.

%CALU:	MOVEM	T2,ERRN		;SAVE ERROR NUMBER
	MOVEM	T3,UPC		;Save PC to tell user
	PUSH	P,ACS		;SAVE ACS 0-3
	PUSH	P,ACS+1
	PUSH	P,ACS+2
	PUSH	P,ACS+3
	MOVSI	T0,T4		;SAVE ACS 4-16
	HRRI	T0,1(P)
	ADJSP	P,13
	BLT	T0,(P)

	MOVEI	L,1+[-2,,0	;POINT TO ARGS
		     IFIW TP%INT,ERRN
		     IFIW TP%INT,UPC]
	PUSHJ	P,(T1)		;CALL USER'S ROUTINE

	ADJSP	P,-13		;RESTORE ACS
	MOVSI	T0,1(P)
	HRRI	T0,T4
	BLT	T0,16
	POP	P,ACS+3
	POP	P,ACS+2
	POP	P,ACS+1
	POP	P,ACS
	POPJ	P,		;Done
;NAMES OF TRAPS FOR ERROR MESSAGES

%APRTXT:
	[ASCIZ /Integer overflow/]		;000
	[ASCIZ /Integer divide check/]		;001  NDV
	[ASCIZ /Floating underflow/]		;010  FXU 	(impossible)
	[ASCIZ /Floating divide check/]		;011  FXU,NDV	(impossible)
	[ASCIZ /Floating overflow/]		;100  FXO
	[ASCIZ /Floating divide check/]		;101  FXO,NDV
	[ASCIZ /Floating underflow/]		;110  FXO,FXU
	[ASCIZ /Floating divide check/]		;111  FXO,FXU,NDV (impossible)

;The following are used only for err summary at exit.

	[ASCIZ /Library routine error/]		;.ETLRE
	[ASCIZ /Output field width overflow/]	;.ETOFW (messy toilet?)
.XXXX==.-%APRTXT				;Number of messages

IFN <.XXXX-.ETNUM>,< PRINTX ?%APRTXT - wrong number of messages>
	PURGE .XXXX
;FLAG BITS FOR EVERY INSTRUCTION THAT CAN OVERFLOW

	DPBIT==1		;1 IF INST STORES 2-WORD RESULT
	ACBIT==2		;1 IF INST STORES RESULT IN AC
	MEMBIT==4		;1 IF INST STORES RESULT IN MEMORY
	WRONGBIT==10		;1 IF INST STORES RESULT WITH WRONG SIGN,
				;  FOR EXTEND MEANS RESULT NOT STORED IN AC
	SA==ACBIT		;SINGLE PRECISION, RESULT IN AC
	SM==MEMBIT		;SINGLE PRECISION, RESULT IN MEMORY
	SB==ACBIT+MEMBIT	;SINGLE PRECISION, RESULT IN BOTH
	DA==SA+DPBIT		;DOUBLE PRECISION, RESULT IN AC
	DM==SM+DPBIT		;DOUBLE PRECISION, RESULT IN MEMORY
	DB==SB+DPBIT		;DOUBLE PRECISION, RESULT IN BOTH
	SAW==SA+WRONGBIT	;SA, RESULT HAS WRONG SIGN
	SMW==SM+WRONGBIT	;SM, RESULT HAS WRONG SIGN
	SBW==SB+WRONGBIT	;SB, RESULT HAS WRONG SIGN
	DAW==DA+WRONGBIT	;DA, RESULT HAS WRONG SIGN
	DMW==DM+WRONGBIT	;DM, RESULT HAS WRONG SIGN
	SP==1			;SPECIAL CASE, NOT COVERED ABOVE

BITS:	BYTE (4) 0,  0,  DA, DA, 0,  0,  DA, DA, DA    ;OPCODE  100 UJEN-DFAD
	BYTE (4) DA, DA, DA, DAW,DAW,DAW,DA, 0,  DAW   ;	111 DFSB-DMOVN
	BYTE (4) SP, SP, 0,  DMW,SP, 0,  0,  0,  SA    ;	122 FIX-FSC
	BYTE (4) 0,  0,  0,  0,  0,  SA, 0,  SM, SB    ;	133 IBP-FADB
	BYTE (4) SA, SA, SM, SB, SA, 0,  SM, SB, SA    ;	144 FADR-FSBR
	BYTE (4) SA, SM, SB, SA, 0,  SM, SB, SA, SA    ;	155 FSBRI-FMPRI
	BYTE (4) SM, SB, SA, 0,  SM, SB, SA, SA, SM    ;	166 FMPRM-FDVRM
	BYTE (4) SB, 0,  0,  0,  0,  0,  0,  0,  0     ;	177 FDVRB-MOVSS
	BYTE (4) SAW,0,  SMW,SMW,SAW,0,  SMW,SMW,SA    ;	210 MOVN-IMUL
	BYTE (4) SA, SM, SB, DA, DA, DM, DB, SA, SA    ;	221 IMULI-IDIVI
	BYTE (4) SM, SB, SA, SA, SM, SB, SA, 0,  0     ;	232 IDIVM-LSH
	BYTE (4) 0,  DA, 0,  0,  0,  0,  0,  0,  0     ;	243 JFFO-AOBJN
	BYTE (4) 0,  0,  SP, 0,  0,  0,  0,  0,  0     ;	254 JRST-JSR
	BYTE (4) 0,  0,  0,  SAW,SAW,SMW,SBW,SAW,SAW   ;	265 JSP-SUBI
	BYTE (4) SMW,SBW,0,  0,  0,  0,  0,  0,  0     ;	276 SUBM-CAIN
	BYTE (4) 0,  0,  0,  0,  0,  0,  0,  0,  0     ;	307 CAIG-CAMG
	BYTE (4) 0,  0,  0,  0,  0,  0,  0,  0,  0     ;	320 JUMP-SKIP
	BYTE (4) 0,  0,  0,  0,  0,  0,  0,  SAW,SAW   ;	331 SKIPL-AOJL
	BYTE (4) SAW,SAW,SAW,SAW,SAW,SAW,SBW,SAW,SAW   ;	342 AOJE-AOSE
	BYTE (4) SAW,SAW,SAW,SAW,SAW,SAW,SAW,SAW,SAW   ;	353 AOSLE-SOJLE
	BYTE (4) SAW,SAW,SAW,SAW,SBW,SAW,SAW,SAW,SAW   ;	364 SOJA-SOSA
	BYTE (4) SAW,SAW,SAW,0,  SAW,0,  DAW,SAW,DAW   ;	375 SOSGE-SOSG AND 020 XBLT-DGFIXR
      <	BYTE (4) SAW,0,  0,  DA >		       ;	026 GFIXR-GFSC

BPTAB:	POINT	4,BITS-10(T1),35 ;BYTE POINTERS, OFFSET BY 100 OCTAL
	POINT	4,BITS-7(T1),3
	POINT	4,BITS-7(T1),7
	POINT	4,BITS-7(T1),11
	POINT	4,BITS-7(T1),15
	POINT	4,BITS-7(T1),19
	POINT	4,BITS-7(T1),23
	POINT	4,BITS-7(T1),27
	POINT	4,BITS-7(T1),31
;TABLES INDEXED BY T1 (WITH FLAG BITS IN IT) TO ACCESS INSTRUCTION OPERANDS

XLOAD=.-2
	MOVE	T2,@AC		;SA
	DMOVE	T2,@AC		;DA
	MOVE	T2,@E		;SM
	DMOVE	T2,@E		;DM
	MOVE	T2,@AC		;SB
	DMOVE	T2,@AC		;DB

XSTORE=.-2
	MOVEM	T2,@AC		;SA
	DMOVEM	T2,@AC		;DA
	MOVEM	T2,@E		;SM
	DMOVEM	T2,@E		;DM
	PUSHJ	P,[MOVEM T2,@AC	;SB
		   MOVEM T2,@E
		   POPJ P,]
	PUSHJ	P,[DMOVEM T2,@AC ;DB
		   DMOVEM T2,@E
		   POPJ P,]
;ROUTINE TO INIT PSI SYSTEM

IF20,<
%PSIINI:
	MOVEI	T1,%PC1		;SET UP LEVTAB
	MOVEM	T1,%LEVTAB
	MOVEI	T1,%PC2
	MOVEM	T1,%LEVTAB+1
	MOVEI	T1,%PC3
	MOVEM	T1,%LEVTAB+2

;Release 4 systems don't document XRIR%, needed with XSIR%.
;  So FORTRAN V6 which must work with TOPS-20 R4 must jump around
;the XSIR% code.

	MOVEI	T1,.FHSLF	;THIS FORK
	XMOVEI	T2,.		;Get current section number
	TLNN	T2,-1		; Section 0? (Typical user site..)
	 JRST	NOXSIR		;Yes, assume a TOPS-20 release 4 system.

	MOVEI	T2,[EXP 3,%LEVTAB,%CHNTAB] ;ADDRESS OF ARG BLOCK
	XSIR%			;SET INTERRUPT TABLE ADDRESSES
	  ERJMP	NOXSIR		;XSIR DIDN'T WORK
	SETOM	I.XSIR		;REMEMBER WE ARE USING XSIR-FORMAT TABLES
	JRST	PIINI1		;JOIN COMMON CODE

NOXSIR:	SETZM	I.XSIR		;NOT USING XSIR-FORMAT TABLES
	MOVE	T2,[%LEVTAB,,%CHNTAB] ;SET LEVTAB AND CHNTAB
	SIR%			;SET INTERRUPT TABLES

PIINI1:	EIR%			;ENABLE INTERRUPT SYSTEM
	POPJ	P,		;DONE
>				;IF20
	PURGE	$SEG$
	END