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