Trailing-Edge
-
PDP-10 Archives
-
decus_20tap1_198111
-
decus/20-0003/fordum.mac
There are 15 other files named fordum.mac in the archive. Click here to see a list.
TITLE FORDUM %4.(405) ERROR PROCESSING MODULE FOR THE FOROTS SYSTEM
SUBTTL D. TODD/DRT/MD 02-OCT-74
;**;[405],DUMMY ERROR ROUTINE WHEN FOROTS NOT USED
search monsym
define outstr(x) <
push p,1
hrroi 1,x
psout
pop p,1>
define outchr(x) <
push p,1
move 1,x
pbout
pop p,1>
define skpinc <
push p,1
push p,2
movei 1,.priou
rfmod
tlz 2,(tt%osp)
sfmod
pop p,2
pop p,1>
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (C) 1974,1977 BY DIGITAL EQUIPMENT CORPORATION
SUBTTL REVISION HISTORY
;405 14115 CREATION
ENTRY FORER. ;[405] DEFINE IT
ENTRY FORER% ;ENTRY POINT TO FORERR - MUST BE DEFINED BEFORE
SEARCH FORPRM ;GLOBAL SYMBOLS DEFINED IN FORPRM
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
SUBTTL FORERR ENTRY POINTS DEFINED BY ERRDIR IN (FORRM)
ERDIR%: ;DEFINE THE BEGINNING OF THE DISPATCH TABLE
SALL
ERRDIR
FORER.: ;**;[405], DEFINE FORER.
FORER%: PUSHJ P,.+1 ;SAVE THE CALLING PC
ADD P,[XWD HGH.AC+1,HGH.AC+1] ;MAKE ROOM TO SAVE THE AC'S
MOVEM HGH.AC,(P) ;SAVE THE LAST AC
MOVEI HGH.AC,-HGH.AC(P) ;GET THE BEGINNING OF THE SAVE AREA
BLT HGH.AC,-1(P) ;SAVE THE AC'S
N.==HGH.AC+1 ;DEFINE THE STACK DEPTH
;**;[405],DO NOT USE P4 (.JBOPS)
MOVE T3,-N.(P) ;GET THE XCT ADDR +1
HLRZ T4,(T3) ;GET THE TYPE AND SEVERITY CODE
ANDI T4,757 ;SAVE THE INDEX AND AC FIELD
ROT T4,-5 ;POSITION THE AC FIELD
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
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
;**;[405], DO NOT CALL TRACE
FORRT0: MOVEI T3,EXIT.## ;[405] 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
;**;[405], DO NOT USE P4
MOVSI HGH.AC,-HGH.AC(P) ;SET A BLT POINT TO RESTORE THE AC'S
BLT HGH.AC,HGH.AC ;RESTORE THE AC'S
SUB P,[XWD HGH.AC+1,HGH.AC+1] ;MAKE THE STACK RIGHT
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
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
;**;[405], DO NOT NEED TY%XWD
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
;**;[405], DO NOT NEED TY%TIM
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,
;**;[405], DEFINE THE DUMMY ENTRIES WHICH SHOULD NOT BE USED
ER%OPN: ER%DEV: ER%DAT: ;[405]
PUSHJ P,TY%HDR ;[405] TYPE HEADER
TYPSTR [FIVBIT (Undefined ENTRY in FORLIB without FOROTS)]
POPJ P, ;[405]
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
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)
SYS.MX==.-SYSTAB-1 ;SYSTBL SIZE
SYS01: ;PRINT THE TIMES OUT
SKPINC ;KILL ^O TYPE OUT
JFCL
OUTSTR [ASCIZ /
END OF EXECUTION
/] ;[405] DO NOT TIME MISSING INFO
; CALLI 12 ;EXIT TO MONITOR
haltf
hrroi 1,[asciz / Can't continue
/]
esout
jrst .-3
;**;[405], DO NOT NEED ER%OPN
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
;**;[405], DO NOT COUNT ERRORS
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
ERAPR1: MOVE T5,APRTAB(T5) ;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)
SUBTTL LIB LIBRARY ERROR FAULT PROCESSOR
ER%LIB: ;ENTRY POINT
;**;[405], DO NOT COUNT LIB ERRORS
PUSHJ P,TY%HDR ;TYPE THE HEADER
MOVE T5,@-NN.(P) ;[200] GET THE MESSAGE ADDRESS
OUTSTR 0(T5) ;[200] TYPE THE MESSAGE
;**;[405], DO NOT CALL TRACE
JRST USRRET ;[200] RETURN TO THE USER
;**;[405], DO NOT NEED ER%DAT
;**;[405], DO NOT NEED ER%DEV
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
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
;**;[405], DO NOT SEARCH NAME OF ROUTINE
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.
;**;[405], DO NOT NEED TRACE% ROUTINE
if2 ,<purge pbout,psout,rfmod,sfmod>
END