TITLE TRAPS	V.021	15 NOVEMBER 1969
SUBTTL	OVER/UNDERFLOW TRAP ROUTINE	T. EGGERS

T=14	;WORKING ACCUMULATOR
TT=1
Q=16	;AC FOR JSA'S
P=17	;PUSH DOWN POINTER
FXU=1B11	;FLOATING EXPONENT UNDERFLOW FLAG
FOV=1B3		;FLOATING OVERFLOW BIT
NDV=1B12	;NO DIVIDE BIT

OPDEF DDTOUT [CALLI 3]
OPDEF APRENB [CALLI 16]	;TO SET UP APR TRAPPING
OVE=10		;ENABLE INTEGER OVERFLOW TRAPS

;RESTRICTIONS ON OVTRAP ROUTINE:
;	1- NO ANSWER FOR A TRAPPING INSTRUCTION MUST BE STORED
;	   INDEXED BY 17 (PUSH DOWN LIST)
;	2- OVTRAP DOES NOT TRACE XCT OR UUO CHAINS
;	3- THERE ARE NO FIXUPS FOR INTEGER TRAPS
;	4- MOVNX AND MOVMX ARE CONSIDERED INTEGER INSTRUCTIONS
;	5- TRAPPING INSTRUCTION MUST NOT BE IN ACCUMULATOR T=14

ENTRY TRPINI,OVERFL,OVTRAP,OVPCWD,OVCNT
EXTERNAL JOBTPC,JOBAPR,ERRMSG

MLON	;ENABLE MULTI LINE LITERALS

			;PUSHJ P,TRPINI	TO INITIALIZE ALL TRAPPING
TRPINI:	MOVEI TT,OVTRAP
	HRRZM TT,JOBAPR		;INIT OVERFLOW TRAP ADDRESS
; PDL OVERFLOW ADDED FOR SNOBOL TO GIVE A PROPER ERROR MESSAGE
	MOVEI TT,OVE+200000+400000
	JRSTF @[XWD 004000,.+1]		;CLEAR APR FLAGS
	APRENB TT,		;INIT OVERFLOW TRAPPING
	SETZM OVCNT		;INIT # OVERFLOWS TO 0
	POPJ	P,		;RETURN

;ARITHMETIC OVEFLOW TESTING PROGRAM
;THIS ROUTINE IS CALLED IN THE FOLLOWING MANNER:
;	JSA	Q,OVERFL
;	EXP	J
;IF OVERFLOWS HAVE OCCURRED, THE ANSWER IS SET TO 1, AND THE
;COUNTER IS CLEARED. IF THE OVERFLOW COUNTER IS 0, THE ANSWER
;IS SET TO 2.

	SIXBIT /OVERFL/
OVERFL:	0
	SETZM	@(Q)		;CLEAR OUT ANSWER WORD
	AOS	@(Q)		;SET ANSWER TO 1
	SKIPN	OVCNT		;ANY OVERFLOWS?
	AOS	@(Q)		;NO, SET ANSWER TO 2
	SETZM	OVCNT		;RESET OVERFLOW COUNTER
	JRA	Q,1(Q)		;RETURN
OVTRAP:	MOVEM T,TSAVE		;SAVE AC T

; FOLLOWING ADDED TO CHECK FOR PDL OVERFLOWS
	EXTERN OVER,JOBCNI
	MOVE T,JOBCNI
	TRNE T,1B19	;PDL OVERFLOW FLAG
	JRST OVER
; END OF PDL TRAPS CODE
; CHANGE MADE FOR SNOBOL SO IT CAN WORK WITH 4S50 MONITORS

	MOVEI T,110+600000
	APRENB T,

; END OF CHANGE

	SOS T,JOBTPC		;MAKE JOBTPC POINT TO INSTRUCTION
	MOVEM T,OVPCWD		;SAVE PC WORD
	TLNN T,(FXU)		;FLOATING POINT UNDERFLOW?
	JRST OVTRP1

	LDB T,[POINT 9,(T),8]	;GET INSTRUCTION
	CAILE T,177		;POSSIBLE FLOATING POINT?
	JRST TJFCL1		;NO
	CAIGE T,140		;BETWEEN 140 AND 177?
	JRST	[CAIN T,(<FSC>_-9)	;NO, FSC?
		JRST UAC		;YES
					;(UFA AND DFN CAN'T CAUSE UNDERFLOW)
		JRST TJFCL1]		;NO, PRINT ERROR MESSAGE
	ANDI T,7		;MASK TO MODE BITS
	JRST UTBL(T)		;DISPATCH ON INSTRUCTION TYPE


OVTRP1:	TLNN T,(FOV)		;FLOATING OVERFLOW OR FLOATING DIVIDE CHECK?
	JRST TJFCL1		;NO, INTEGER OVERFLOW OR DIVIDE CHECK
	LDB T,[POINT 4,@JOBTPC,12]	;GET AC FIELD
	MOVEM T,ACFLD		;SAVE AC FIELD
	MOVE T,@JOBTPC		;GET INSTRUCTION
	MOVEM T,INST
	MOVE T,TSAVE
	MOVEI T,@INST		;GET EFFECTIVE ADDRESS
	EXCH T,INST		; AND SAVE. PICK UP INSTRUCTION
	TLC T,(042B8)		;CHANGE "MODE 2" TO "MODE 0"
				; AND CHANGE 140-177 TO 100-137
	HLR T,JOBTPC		;GET FLAGS IN RIGHT HALF
	TDNE T,[643B8+<NDV_-^D18>]	;SKIP FOR "TO MEMORY" AND NO NDV
				; NO SKIP FOR INSTRUCTIONS OUTSIDE 140-177(E.G. FSC,XCT,UFA)
	SKIPA T,ACFLD		;GET CORRECT SIGN FROM AC
	MOVE T,INST		;GET CORRECT SIGN FROM MEMORY
	MOVEM T,ACDATA		;SAVE ADDRESS FOR SIGN OF CORRECT RESULT
	MOVE T,TSAVE
	SKIPGE @ACDATA		;SKIP IF CORRECT RESULT IS POSITIVE
	SKIPA T,[XWD 400000,1]	;NO, NEGATIVE
	HRLOI T,377777		;YES
	PUSH P,T		;SAVE OVERFLOW FIX UP
	LDB T,[POINT 9,@JOBTPC,8]	;GET INSTRUCTION
	CAIG T,177
	CAIGE T,140		;NORMAL FLOATING POINT INSTRUCTION
	JRST	[CAIN T,(<FSC>_-9)	;NO, FSC?
		JRST AC		;YES
		CAIN T,(<UFA>_-9)	;UFA?
		JRST AC1
		POP P,ACDATA	;GET ITEM OFF PDL
		JRST TJFCL1]	;PROBABLY AN XCT
	ANDI T,7
	JRST TBL(T)
;THIS PAGE FOR OVERFLOWS AND DIVIDE CHECKS

TBL:	JRST AC
	JRST ACLONG
	JRST MEMORY
	JRST BOTH
	JRST AC
	JRST AC
	JRST MEMORY
	;JRST BOTH

BOTH:	PUSH P,(P)		;SAVE ANOTHER COPY
BOTH1:	MOVE T,TSAVE
	POP P,@ACFLD		;LOAD AC
	POP P,@INST		;LOAD MEMORY
	JRST TJFCL

AC1:	AOS T,ACFLD
	ANDI T,17		;MASK AC+1 TO 4 BITS
	MOVEM T,ACFLD
AC:	MOVE T,TSAVE
	POP P,@ACFLD		;LOAD AC
	JRST TJFCL

ACLONG:	MOVE T,ACFLD		;GET AC
	ADDI T,1
	ANDI T,17
	MOVEM T,INST		;PUT AC+1 INTO MEMORY ADDRESS
	POP P,ACDATA		;GET SIGN OF ANSWER INTO BETTER PLACE
	PUSH P,[XWD 344777,-1]	;SAVE A POS LOW WORD
	HRLOI T,377777		;ASSUME A POSITIVE HIGH WORD
	SKIPGE ACDATA		;SHOULD RESULT BE POSITIVE?
	DFN T,(P)		;NO, NEGATE IT
	PUSH P,T		;PUT OTHER ARG ON PDL
	JRST BOTH1

MEMORY:	MOVE T,TSAVE
	POP P,@INST
	JRST TJFCL
;THIS PAGE FOR UNDERFLOWS ONLY

UTBL:	JRST UAC		;ZERO AC
	JRST UACLNG		;ZERO AC, AC+1
	JRST UMEMRY		;ZERO E
	JRST UBOTH		;ZERO AC,E
	JRST UAC
	JRST UAC
	JRST UMEMRY
	;JRST UBOTH

UBOTH:	MOVE T,@JOBTPC		;GET OFFENDING INSTRUCTION
	TLZ T,777000		;ZERO OP CODE
	TLO T,(SETZB)		;CHANGE TO "SETZB AC,E"
	JRST UAC2

UMEMRY:	MOVE T,@JOBTPC
	TLZ T,777740		;ZERO OP CODE, AC FIELD
	TLO T,(SETZM)		;CHANGE TO "SETZM E"
	JRST UAC2

UACLNG:	LDB T,[POINT 4,@JOBTPC,12]	;GET AC FIELD
	DPB T,[POINT 4,T,12]	;COPY INTO AC FIELD
	ADDI T,1		;CHANGE AC TO AC+1
	TRZ T,20		;MASK TO 4 BITS
	TLO T,(SETZB)		;CHANGE TO "SETZB AC,AC+1"
	JRST UAC2

UAC:	HLLZ T,@JOBTPC		;GET OFFENDING INSTRUCTION
	TLZ T,777037		;ZERO OP CODE, XR,@, LEAVE AC
	TLO T,(SETZ)		;CHANGE TO "SETZ AC,"
UAC2:	EXCH T,TSAVE		;SAVE INSTRUCTION, RESTORE T
	XCT TSAVE		;CLEAR THE REQUIRED REGISTERS

TJFCL:	MOVEM T,TSAVE		;SAVE T AGAIN
TJFCL1:	AOS JOBTPC		;JOBTPC POINTS TO NEXT INSTRUCTION
	MOVE T,@JOBTPC		;GET NEXT INSTRUCTION
	TLC T,(<JFCL>)		;COMPLEMENT "JFCL" BITS
	TLNE T,777000		;JFCL INSTRUCTION?
	JRST ERRPNT		;NO, PRINT ERROR MESSAGE
	TRNE T,-1		;ADDRESS SPECIFIED ON JFCL?
	MOVEM T,JOBTPC		;YES, GO THERE
	TLNE T,(<JFCL 17,>)	;IS OVERFLOW BIT SET IN JFCL?
	JRST ERRPNT		;YES, TYPE ERROR MESSAGE
RETURN:	JRSTF @[XWD 004000,.+1]	;CLEAR APR FLAGS, LEAVE "USER IOT" SET
	MOVE T,TSAVE		;RESTORE T
	JRST @JOBTPC
ERRPNT:	MOVE T,OVPCWD		;GET FLAGS
	TLNN T,(FXU)
	AOS OVCNT		;COUNT OVERFLOWS AND DIVIDE CHECKS
	TLNN T,(FOV)		;FLOATING POINT TRAP?
	JRST	[HRRI T,1	;NO, ASSUME INTEGER OVERFLOW
		TLNE T,(NDV)	;INTEGER DIVIDE CHECK?
		MOVEI T,2	;YES
		JRST MSG2]
	HRRI T,3		;ASSUME FLOATING POINT OVERFLOW
	TLNE T,(NDV)		;FLOATING DIVIDE CHECK?
	MOVEI T,5		;YES
	TLNE T,(FXU)		;FLOATING UNDERFLOW?
	MOVEI T,4		;YES
MSG2:	HRL T,MTABLE-1(T)	;GET ADDRESS OF MESSAGE, AND
	MOVSM T,MSG4		;SAVE IT FOR ERROR MESSAGE PRINTOUT
	MOVE T,MBTAB-1(T)	;GET BYTE POINTER FOR STORING PC
	MOVEM T,PSTO		;SAVE IT
	PUSH P,T+1		;SAVE ANOTHER AC
	HRLO T+1,OVPCWD		;GET PC, PUT 1'S IN RIGHT HALF
MSG3:	MOVEI T,0		;CONVERT BINARY TO OCTAL AND STORE IN MESSAGE
	LSHC T,3
	ADDI T,"0"
	IDPB T,PSTO
	TRNE T+1,-1
	JRST MSG3

	POP P,T+1		;RESTORE AC
	JSA 16,ERRMSG		;GET MESSAGE PRINTED
MSG4:	.-.			;# OF MESSAGE, ADDRESS OF MESSAGE
	JRST RETURN

MTABLE:	MINOV
	MINNDV
	MFOV
	MFXU
	MFNDV

MBTAB:	POINT 7,MINOV1,-1
	POINT 7,MINDC1,27
	POINT 7,MFOV1,6
	POINT 7,MFXU1,13
	POINT 7,MFNDV1,-1

MINOV:	ASCII /INTEGER OVERFLOW	PC=/
MINOV1:	ASCIZ /000000/

MINNDV:	ASCII /INTEGER DIVIDE CHECK/
MINDC1:	ASCIZ /	PC=000000/

MFOV:	ASCII /FLOATING OVERFLOW	PC/
MFOV1:	ASCIZ /=000000/

MFXU:	ASCII /FLOATING UNDERFLOW	P/
MFXU1:	ASCIZ /C=000000/

MFNDV:	ASCII /FLOATING DIVIDE CHECK	PC=/
MFNDV1:	ASCIZ /000000/

PSTO:	BLOCK 1		;BYTE POINTER

OVPCWD:	BLOCK 1		;PC WORD WHEN TRAP OCCURS
OVCNT:	BLOCK 1		;COUNT OVERFLOWS
TSAVE:	BLOCK 1		;TEMP FOR AC T
ACFLD:	BLOCK 1		;ADDRESS OF ACCUMULATOR
ACDATA:	BLOCK 1		;HOLDS SIGN OF CORRECT ANSWER
INST:	BLOCK 1		;HOLDS INSTRUCTION OR "E"

REPEAT 0,<

DESCRIPTION OF "TRAPS" PROGRAM FOR LIB40-

I. THE PURPOSE OF THE TRAPS PROGRAM IS DO ERROR DETECTION
   AND CORRECTION 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
		1. CALLING SEQUENCE-	JSA 16,OVERFL
					ARG	J
						;RETURN
		2. IF OVCNT=0, THEN J_1
		3. IF OVCNT=/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 OF THE INSTRUCTION
		      CAUSING THE TRAP) IS STORED IN OVPCWD
		2. FOR FLOATING POINT INSTRUCTIONS
		      A. THE FAULTY ANSWER IS PATCHED TO BE 0
			 FOR UNDERFLOWS, OR PLUS OR MINUS (THE
			 SIGN WILL BE THAT OF THE CORRECT ANSWER)
			 THE LARGEST POSSIBLE NUMBER
			 FOR OVERFLOWS OR DIVIDE CHECKS
		3. (FOR INTEGER INSTRUCTIONS, NO PATCHING OF ANSWERS
		      IS DONE.)
		4. IF THE INSTRUCTION AFTER THE TRAPPING INSTRUCTION
		      IS JFCL
		      A. DO NOT TYPE AN ERROR MESSAGE
			 UNLESS BIT 9 (AR OV TEST BIT) 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 EFFECTIVE ADDRESS OF
			 THE JFCL
		      D. IF THE ADDRESS OF THE JFCL IS ZERO, THE
			 INTERRUPTED PROGRAM WILL BE RESTARTED AT
			 THE JFCL
		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",
			 OF THE FOLLOWING FORM:

			INTEGER     OVERFLOW
			FLOATING    UNDERFLOW	PC=NNNNNN
				    DIVIDE CHECK

		      C. THE INTERRUPTED PROGRAM WILL BE RESTARTED AT
			 THE INSTRUCTION AFTER THE TRAPPING INSTRUCTION
		6. THE PROCESSOR FLAGS (PC WORD FLAGS) ARE CLEARED
		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

	B. FLOATING POINT FIX UPS WILL NOT OCCUR FOR INSTRUCTIONS
	   THAT ARE EXECUTED BY AN XCT OR A UUO, OR FOR INSTRUCTIONS
	   THAT ARE IN ACCUMULATOR T=14


	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
	   NO FLOATING POINT FIX UPS IF THEY CAUSE OVERFLOW
	E. TRAPPING INSTRUCTION MUST NOT BE IN ACCUMULATOR T=14
	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

END