Trailing-Edge
-
PDP-10 Archives
-
AP-D480B-SB_1978
-
forerr.mac
There are 27 other files named forerr.mac in the archive. Click here to see a list.
TITLE FORERR %5A(714) ERROR PROCESSING MODULE FOR THE FOROTS SYSTEM
SUBTTL D. TODD/DRT/HPW/SRM/MD/DPL/JNG/CLRH/SJW/SWG 27-SEP-77
;***COPYRIGHT 1972,1973,1974,1975,1976,1977 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
SUBTTL REVISION HISTORY
;250 ----- IMPLEMENT BOUNDS CHECKING ERROR MODULE ER%SRE
;347 ----- ADD ERROR MESSAGE FOR LIST-DIRECTED INPUT
;354 ----- FIX FREE FORMAT INPUT
;375 ----- DO NOT ALLOW SEQUENTIAL ACCESS TO RANDOM FILE
;412 14525 TRACE DOES NOT NAME ROUTINES CALLED INDIRECTLY
;414 14602 TYPING ILLEGAL CHAR IN DATA MAY OUTPUT
; A LOT OF GARBAGE.
;415 14823 REMOVE EXTRA END STATEMENT
;424 14996 ADD ERROR MESSAGE FOR ATTEMPT TO READ UNWRITTEN ASCII
; RANDOM ACCESS RECORD
;432 15764 FIX PRINTING OF PPN IN FORM OF <X0Y>
;435 ----- FIX FORER% TO CHECK OPCODE FIELD OF ERROR MACRO AND ADD
; PROPER OFFSET TO AC FIELD TO ALLOW UP TO 48 MSGS/CLASS.
;447 16733 FIX ER%DEV TO PUT END= AND ERR= ADDR'S IN USR.PC SO
; EOF TAKES AFFECT IMMEDIATELY AND NO IO VARIABLES GET
; CLEARED
;450 ----- FIX EDIT 424 IN ER%DA1 TO CHECK P3 NOT P2 FOR IO.FMT
;451 ----- FIX DAT7 SO NO ATTEMPT IS MADE TO PRINT A FORMAT
; STATEMENT WHEN ILLEGAL CHAR IS FOR NAMELIST INPUT
;****************BEGINNING OF VERSION 4C
;463 16661 CHANGE 'ILLEGAL MODE FOR DEVICE' MESSAGE TO SAY MORE
; CORRECTLY 'ILLEGAL MODE OR MODE SWITCH' IN ER%OPN
;474 17648 DON'T STOP PRINTING RECORD ON LF IF ERROR.
;510 17898 STORE NEW PC IN BOTH USR.PC AND ALT.PC AS EOF FLAG.
;515 18756 FIX EDIT 424 AT ER%DA1+10 TO CHECK P3 NOT P2 FOR IO.FMT
;524 18699 FIX QUOTA EXCEEDED MESSAGE
;527 19205 FIX ILL MEM REFS IN DISPATCH TABLES
;546 15285 FIX TRACE% TO OUTPUT CORRECT TYPES FOR ROUTINE
; ARGUMENTS
;547 ----- ADD ERROR MESSAGE FOR MEMORY MANAGEMENT ERRORS
;552 19131 CLEAR IO ACTIVE BIT AFTER GETSTS BEFORE JFFO IN ER%DEV
;*** BEGIN VERSION 5
;564 VER5 ADD ERR= CLEANUP/RETURN PROCESSOR
;600 Q00573 ADD STATIC WORD FOR MAIN. ADDRESS FOR TRACE%
;603 Q00820 ADD ERROR MESSAGE FOR ILLEGAL SEQUENCE OF UUOS
;612 Q00839 ERR%OPN 5 <- "ILLEGAL SEQUENCE OF MONITOR CALLS"
;
; BEGIN VERSION 5A, 7-NOV-76
;
;626 ----- CHANGE DATA ERROR 11 TO SPECIFY NAMELIST NAME
; AND INVALID VARIABLE NAME
;636 Q1037 FIX DAT7 TO UNDERSTAND ILLEGAL CHARACTER IN DATA WITH
; T FORMAT
;650 ----- CHANGE REF TO EXTERNAL DMPSTR TO DMPST.
;711 ----- STOP RECURSIVE ERROR CALLS IN ER%DEV
;712 ----- FIX TRACEBACK IN ER%LIB TO USE CORRECT STARTING STKPTR
;713 ----- FIX TRACEBACK OVER OVERLAYS IN TRACE%
;714 ----- FIX ERROR RECOVERY AT ERR%ER TO RETURN "RECOVERY FAILED"
; IF THERE IS AN ERR= BUT NO RECOVERY ROUTINE SPECIFIED
;*** END OF REVISION HISTORY ******
ENTRY FORER% ;ENTRY POINT TO FORERR - MUST BE DEFINED BEFORE
SEARCH FORPRM ;GLOBAL SYMBOLS DEFINED IN FORPRM
VERNO==5 ;MAJOR VERSION NUMBER
VEDIT==714 ;MAJOR EDIT NUMBER
VMINOR==1 ;MINOR EDIT NUMBER
VWHO==0 ;WHO EDITED LAST
VERERR==BYTE (3)VWHO(9)VERNO(6)VMINOR(18)VEDIT
; DEFINE THE LOADING
SEGMEN
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
PAGE
SUBTTL FORERR ENTRY POINTS DEFINED BY ERRDIR IN (FORRM)
ERDIR%: ;DEFINE THE BEGINNING OF THE DISPATCH TABLE
SALL
ERRDIR
FORER%: PUSHJ P,.+1 ;SAVE THE CALLING PC
;**; [527] CHANGE AT FORER% + 1 CLRH 26-MAR-76
PUSH P,T0 ; [527] SAVE THE AC'S
PUSH P,T1 ; [527]
PUSH P,T2 ; [527]
PUSH P,T3 ; [527]
PUSH P,T4 ; [527]
PUSH P,T5 ; [527]
N.==HGH.AC+1 ;DEFINE THE STACK DEPTH
PUSH P,P4 ;SAVE P4 FOR A BASE REGISTER
N.=N.+1 ;ACCOUNT FOR IT
;THE AC'S PLUS RETURN ADDRESS
HRRZ P4,.JBOPS ;GET THE LOW SEGMENT POINTER
MOVE T3,-N.(P) ;GET THE XCT ADDR +1
HLRZ T4,(T3) ;GET THE TYPE AND SEVERITY CODE
HLRZ T1,(T3) ;[435] GET OPCODE
ANDI T1,70000 ;[435] ISOLATE SECOND DIGIT
LSH T1,-10 ;[435] POSITION FOR ADDING TO TYPE
ANDI T4,757 ;SAVE THE INDEX AND AC FIELD
ROT T4,-5 ;POSITION THE AC FIELD
ADD T4,T1 ;[435] ADD OFFSET TO GET REAL TYPE
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
;**; [527] INSERT @ FORRTN - 4 1/2 CLRH 26-MAR-76
CAILE T4,ERD.MX ; [527] IN RANGE ?
MOVEI T4,12 ; [527] NO -- UNDEFINED
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
FORRT0: PUSHJ P,TRAC%% ;GIVE A USERS TRACE
MOVEI T3,EXIT%## ;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
POP P,P4 ;RESTORE THE BASE REG
N.=N.-1 ;ACCOUNT
;**; [527] CHANGE @ FORRT1 + 4L CLRH 26-MAR-76
POP P,T5 ; [527] RESTORE REGISTERS
POP P,T4 ; [527]
POP P,T3 ; [527]
POP P,T2 ; [527]
POP P,T1 ; [527]
POP P,T0 ; [527]
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
PAGE
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
TY%XWD: HRLM T0,(P) ;SAVE THE RIGHT HALF
HLRZS T0 ;GET THE LEFT HALF
PUSHJ P,TY%OCT ;TYPE IT
OUTSTR [ASCIZ/,/] ;TYPE A COMMA
HLRZ T0,(P) ;GET THE RIGHT HALF
; PJRST TY%OCT ;TYPE IT
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
TY%TIM: ;PRINT THE TIME IN TO "HH:MM:SS.HH"
ADDI T0,5 ;ROUND OFF THE HUNDREDTHS OF SECONDS
IDIVI T0,^D1000 ;COMPUTE SECONDS
PUSH P,T1 ;SAVE THOUSANDS OF A SECOND
IDIVI T0,^D60 ;COMPUTE MINUTES
PUSH P,T1 ;SAVE MINUES
JUMPE T0,TY%TI2 ;SKIP IF NO MINUTES
IDIVI T0,^D60 ;COMPUTE HOURS
PUSH P,T1 ;SAVE THE MINUTES
JUMPE T0,TY%TI1 ;SKIP IF NO HOURS
PUSHJ P,TY%DEC ;TYPE THE HOURS
OUTSTR [ASCIZ /:/] ;TYPE A SEPERATOR
TY%TI1: POP P,T0 ;GET THE MINUTES BACK
PUSHJ P,TY%DEC ;TYPE THE MINUTES
OUTSTR [ASCIZ /:/] ;TYPE A SEPERATOR
TY%TI2: POP P,T0 ;GET THE SECONDS BACK
PUSHJ P,TY%DEC ;TYPE THE SECONDS
OUTSTR [ASCIZ /./] ;TYPE A SEPERATOR
POP P,T0 ;GET THE THOUSANDS BACK
IDIVI T0,^D10 ;CHANGE TO HUNDREDTHS
IDIVI T0,^D10
IORI T0,"0" ;CONVERT TO ASCII
OUTCHR T0 ;TYPE IT
MOVEI T0,(T1)
PJRST TY%DEC ;TYPE THE HUNDREDTHS
PAGE
SUBTTL TY%DDB ROUTINE TO DUMP THE DEVICE BLOCK INFO.
TY%DDB:: ;ROUTINE TO OUTPUT THE DEVICE DATA BLOCK
TLNE P3,IO.EDC ;ENCODE/DECODE ERROR
JRST TYPDD7 ;[211] YES - INDICATE ENCODE/DECODE ERROR
OUTSTR [ASCIZ/
Unit=/] ;TYPE A LABEL
HRRE T0,DD.UNT(P3) ;GET THE FLU
PUSHJ P,TY%DEC ;TYPE THE FLU
OUTSTR [ASCIZ/ /] ;SPACE
MOVE T1,DD.DEV(P3) ;GET THE DEVICE NAME
PUSHJ P,TY%SIX ;TYPE OUT THE DEVICE IF ONE
OUTSTR [ASCIZ/:/] ;TYPE A COLON
TYPDD1: SKIPN T1,DD.NAM(P3) ;GET THE FILE NAME
JRST TYPDD5 ;NO FILE NAME
PUSHJ P,TY%SIX ;TYPE THE FILE NAME
HLLZ T1,DD.EXT(P3) ;GET THE EXTENSION
JUMPE T1,TYPDD2 ;NULL EXTENSION
OUTSTR [ASCIZ/./] ;TYPE A PERIOD
PUSHJ P,TY%SIX ;TYPE OUT THE EXTENSION
TYPDD2: SKIPN T3,DD.PPN(P3) ;GET THE PPN
JRST TYPDD4 ;NO PPN SKIP
OUTSTR [ASCIZ/[/] ;TYPE A LEFT BRACKET
MOVE T0,T3 ;GET THE PPN FOR XWD PRINT
TLNN T3,-1 ;IS THIS A PPN OR A POINTER
MOVE T0,2(T3) ;THIS IS A SFD LIST, GET PPN
PUSHJ P,TY%XWD ;TYPE OUT THE HALF WORDS
TLNE T3,-1 ;CKECK FOR SFD LIST
JRST TYPDD3 ;NO QUIT
TYPDD8: SKIPN T1,3(T3) ;YES, GET SFD NAME
JRST TYPDD3 ;NONE LEFT
OUTSTR [ASCIZ/,/] ;TYPE A COMMA
PUSHJ P,TY%SIX ;TYPE OUT SFD ENTRY
AOJA T3,TYPDD8 ;CONTINUE UNTIL LIST TERNIMATOR
TYPDD3: OUTSTR [ASCIZ/]/] ;TYPE A CLOSING BRACKET
TYPDD4: LDB T1,[POINT 9,DD.PRV(P3),8] ;GET THE PROTECTION CODE
JUMPE T1,TYPDD5 ;NO PROTECTION, SKIP IT
OUTSTR [ASCIZ/</] ;TYPE A <
MOVE T0,T1 ;ALIGN THE PROTECTION
TRNN T0,700 ;CHECK THE OWNER'S FIELD
OUTSTR [ASCIZ /0/] ;ZERO, TYPE A ZERO
TRNN T0,770 ;[432] CHECK THE PROJECT FIELD
OUTSTR [ASCIZ /0/] ;ZERO, TYPE A ZERO
PUSHJ P,TY%OCT ;TYPE IT
OUTSTR [ASCIZ/>/] ;GET CLOSING BRACKET
TYPDD5: OUTSTR [ASCIZ \/\] ;TYPE A SLASH
TYPSTR OP.SWT##+2 ;TYPE /ACCESS
OUTSTR [ASCIZ /=/] ;TYPE =
LDB T1,[POINT 4,DD.BLK(P3),9];GET THE ACCESS INDEX
TYPSTR ACC.TB##(T1) ;TYPE THE VALUE
OUTSTR [ASCIZ \/\] ;TYPE A SLASH
TYPSTR OP.SWT##+12 ;TYPE /MODE
OUTSTR [ASCIZ /=/] ;TYPE =
LDB T1,[POINT 4,DD.BLK(P3),13];GET THE MODE INDEX
TYPSTR MOD.TB##(T1) ;TYPE THE VALUE
TYPDD6: OUTSTR [ASCIZ/
/] ;END THIS LINE
POPJ P, ;RETURN
TYPDD7: OUTSTR [ASCIZ \
ENCODE/DECODE ERROR
\] ;[211] INDICATE ENCODE/DECODE
POPJ P, ;[211] RETURN
PAGE
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,
PAGE
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
PUSHJ P,SYS%V2 ;[564] SET ERR.V &CHECK ERR=
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)
XWD ER.HDR!ER.MSG,[FIVBIT (Runtime memory management error)] ;(6) [547]
SYS.MX==.-SYSTAB-1 ;SYSTBL SIZE
SYS01: ;PRINT THE TIMES OUT
SKPINC ;KILL ^O TYPE OUT
JFCL
OUTSTR [ASCIZ /
END OF EXECUTION
CPU TIME: /]
SETZ T0, ;ASK FOR OUT RUNTIME
RUNTIME T0, ;GET THE TOTAL RUNTIME
SUB T0,RUN.TM(P4) ;MINUS THE STARTING TIME
PUSHJ P,TY%TIM ;TYPE THE TIME OUT
OUTSTR [ASCIZ / ELAPSED TIME: /]
MSTIME T0, ;GET THE TIME OF DAY
SUB T0,DAY.TM(P4) ;GET THE STARTING TIME
JUMPGE T0,.+2 ;CHECK FOR AFTER MIDNIGHT
ADD T0,[^D1000*^D3600*^D24] ;ADD MILLISECONDS IN A DAY
JUMPL T0,.-1 ;MAY BE MANYS DAY OF RUNNING
PUSHJ P,TY%TIM ;TYPE THE TIME OUT
CALLI 12 ;EXIT TO MONITOR
PAGE
SUBTTL OPN ERROR PROCESSOR
ER%OPN:
HRRZ T5,-1(P) ;GET THE TYPE CODE
MOVNS T5 ;NEGATE THE TYPE CODE
JUMPN T5,EROPN1 ;JUMP IF NO ZERO
HRRZ T5,DD.EXT(P3) ;GET THE ERROR CODE
;**; [527] INSERT @ EROPN1 CLRH 26-MAR-76
EROPN1: CAILE T5,OPN.MX ; [527] IN RANGE ?
MOVEI T5,OPN.MX+1 ; [527] NO, SET BAD VALUE
PUSHJ P,OPN%V2 ;[564] SET ERR.V & CHECK ERR=
MOVE T5,OPNTAB(T5) ; [527]GET THE DISPATCH ENTRY
PUSHJ P,TY%HDR ;TYPE THE HEADER ALWAYS
EROPN%: TLNN T5,ER.MSG ;TYPE A MESSAGE
JRST EROPN2 ;ERROR ROUTINE
TYPSTR (@T5) ;YES, TYPE THE ERROR MESSAGE
JRST EROPN3
EROPN2: PUSHJ P,@T5 ;PROCESS THE ERROR ROUTINE
OPNNN.==NN.+1 ;COUNT THE PUSHJ ON THE STACK
EROPN3: TLNE T5,ER.DDB ;DD.BLK TO BE TYPED
PJRST TY%DDB ;YES, TELL THE USER THE DEVICE AND FILE
POPJ P, ;RETURN
XWD ER.MSG!ER.DDB,[FIVBIT (Dump Mode Random or Append Access unimplemented try Image Mode)] ;[257] (-15)
XWD ER.MSG!ER.DDB,[FIVBIT (Dialog file can not be opened)] ;(-14)
XWD ,OPN13 ;[270] (-13)
XWD ER.MSG!ER.DDB,[FIVBIT (Record length missing for RANDOM access)] ;(-12)
XWD ,OPN11 ;(-11)
XWD ER.MSG,[FIVBIT (Too many devices open FIFTEEN MAX)] ;(-10)
XWD ER.MSG!ER.DDB,@DATTAB ;(-7)
XWD ER.MSG!ER.DDB,@OPNTAB+12 ;(-6)
XWD ER.MSG!ER.DDB,@OPNTAB+11 ;(-5)
XWD ER.MSG!ER.DDB,@DATTAB ;(-4)
XWD ER.MSG!ER.DDB,@SYSTAB;(ENTRY NOT USED) ;(-3)
XWD ER.MSG!ER.DDB,[FIVBIT (Illegal ACCESS for device)] ;(-2)
;**;[463],OPNTAB-1,DPL,04-AUG-75
XWD ER.MSG!ER.DDB,[FIVBIT (Illegal MODE or MODE switch)] ;[463](-1)
OPNTAB:
XWD ER.MSG!ER.DDB,[FIVBIT (File was not found)] ;(0)
XWD ER.MSG!ER.DDB,[FIVBIT (No directory for project programmer number)] ;(1)
XWD ER.DDB,OPN02 ;(2)
XWD ER.MSG!ER.DDB,[FIVBIT (File was being modified)] ;(3)
XWD ER.MSG!ER.DDB,[FIVBIT (Rename file name already exists)] ;(4)
;**; [603] CHANGE @ OPNTAB+5 CLRH 8-OCT-76
;**; [612] CHANGE @ OPNTAB+5 SJW 26-OCT-76
XWD ER.MSG!ER.DDB,[FIVBIT (Illegal Sequence of Monitor Calls)] ;(5) [612][603]
XWD ER.MSG!ER.DDB,[FIVBIT (Bad UFD or bad RIB)] ;(6)
XWD ER.MSG!ER.DDB,@SYSTAB ;(7)
XWD ER.MSG!ER.DDB,@SYSTAB ;(10)
XWD ER.MSG!ER.DDB,[FIVBIT (Device not available)] ;(11)
XWD ER.MSG!ER.DDB,[FIVBIT (No such device)] ;(12)
XWD ER.MSG!ER.DDB,@SYSTAB+2 ;(13)
XWD ER.MSG!ER.DDB,[FIVBIT (No room or quota exceeded)] ;(14)
XWD ER.MSG!ER.DDB,[FIVBIT (Write lock error)] ;(15)
XWD ER.MSG!ER.DDB,[FIVBIT (Not enough monitor table space)] ;(16)
XWD ER.MSG!ER.DDB,[FIVBIT (Partial allocation only)] ;(17)
XWD ER.MSG!ER.DDB,[FIVBIT (Block not free on allocation)] ;(20)
XWD ER.MSG!ER.DDB,[FIVBIT (Can not supersede an existing directory)] ;(21)
XWD ER.MSG!ER.DDB,[FIVBIT (Can not delete or rename a non empty directory)];(22)
XWD ER.MSG!ER.DDB,[FIVBIT (SFD not found)] ;(23)
XWD ER.MSG!ER.DDB,[FIVBIT (Search list empty)] ;(24)
XWD ER.MSG!ER.DDB,[FIVBIT (SFD nested too deeply)] ;(25)
XWD ER.MSG!ER.DDB,[FIVBIT (No create on for specified SFD path)] ;(26)
;**; [527] INSERT @ OPN02 - 1 1/2 CLRH 26-MAR-76
XWD ER.MSG!ER.DDB,@SYSTAB ; (27) [527]
XWD ER.MSG!ER.DDB,[FIVBIT (File cannot be updated)] ; (30) [527]
XWD ER.MSG!ER.DDB,@SYSTAB ; (31) [527]
XWD ER.MSG!ER.DDB,@SYSTAB ; (32) [527]
OPN.MX==.-OPNTAB-1 ; [527]
XWD ER.MSG!ER.DDB,[FIVBIT (LOOKUP ENTER or RENAME error)] ;(??)
OPN02: ;PROTECTION OR DTA FULL ERROR
MOVE T1,DD.STS(P3) ;GET THE DEVICE STATUS
TLNE T1,DV.DTA ;DTA DEVICE
TYPSTR ([FIVBIT (DTA Directory is full)])
TLNE T1,DV.DSK ;DSK DEVICE
TYPSTR ([FIVBIT (Protection failure)])
POPJ P, ;RETURN
OPN11: ;OPEN STATEMENT ERROR
TYPSTR OPN11Z ;TYPE OPEN ERROR
OUTSTR [ASCII/
/]
JUMPN G3,OPN112 ;JUMP IF ARG ERROR
SKIPN T4,-OPNNN.+1+T1(P) ;[237] RELOAD AC T1
JRST OPN11A ;[237] INVALID DELIMITER
TYPSTR T4 ;TYPE THE SWITCH NAME
OUTSTR [ASCIZ /= is not /]
MOVEI T1,[ASCIZ /unique/]
SKIPN -OPNNN.+1+T4(P) ;SKIP IF NOT UNIQUE
MOVEI T1,[ASCIZ /defined/]
OUTSTR (T1) ;TYPE IT
EXCH P2,P3 ;SWAP THE DEVICE POINTER
PUSHJ P,TY%DDB ;TYPE WHAT WE HAVE
EXCH P2,P3 ;SWAP IT BACK
POPJ P,
OPN112: TYPSTR OP.SWT##(G3) ;TYPE THE SWITCH NAME
OUTSTR [ASCIZ /=/]
MOVE T0,-OPNNN.+1+T1(P) ;GET THE SWITCH VALUE
MOVE T1,T0 ;COPY INCASE SIXBIT
LDB T4,[POINT 3,OP.DSP##(G3),8] ;GET THE VALUE TYPE
CAIN T4,5 ;DECIMAL
PUSHJ P,TY%DEC
CAIN T4,4 ;OCTAL
PUSHJ P,TY%OCT
CAIN T4,1 ;FIVBIT
TYPSTR T0
CAIN T4,2 ;SIXBIT
PUSHJ P,TY%SIX
OUTSTR [ASCIZ / is an invalid argument/]
POPJ P, ;RETURN
OPN11A: TYPSTR ([FIVBIT (Invalid delimiter)]) ;[237]***
JUMPL P2,OPN11B ;[237] LOCATE CHARACTER
SKIPA G2,G1 ;[237] CHARACTER IN CORE
OPN11B: MOVE G2,DD.HRI+1(P3) ;[237] CHARACTER IN BUFFER
OPN11C: LDB T0,G2 ;[237] LOAD THE CHARACTER
OUTSTR [ASCIZ \ [ \] ;[237] DELIMIT CHARACTER
OUTCHR T0 ;[237] TYPE CHARACTER
OUTSTR [ASCIZ \ ]\] ;[237] DELIMIT CHARACTER
POPJ P, ;[237] RETURN
OPN11Z: FIVBIT (Switch error during DIALOG or OPEN statement scan) ;(-11)
OPN13: TYPSTR OPN13A ;[270] GIVE MESSAGE
OUTSTR [ASCIZ / (/] ;[270] TYPE A "("
MOVE T0,G2 ;[270] LOAD ILLEGAL UNIT NUMBER
PUSHJ P,TY%DEC ;[270] TYPE ILLEGAL UNIT #
OUTSTR [ASCIZ /)
/] ;[270] DELIMIT MESSAGE
POPJ P, ;[270] RETURN
;[270] MESSAGE TEXT
OPN13A: FIVBIT (Illegal FORTRAN unit number)
PAGE
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
AOS OVCNT.(P4) ;COUNT THE APR FAULT
SOSGE ERRMX.(P4) ;COUNT THE ERRORS
POPJ P, ;TOO MANY DON'T PRINT
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
;**; [527] INSERT @ ERAPR1 CLRH 26-MAR-76
ERAPR1: CAILE T5,APR.MX ; [527] IN RANGE ?
MOVEI T5,APR.MX ; [527] NO, SET AS LAST
MOVE T5,APRTAB(T5) ; [527] 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)
;**; [527] INSERT @ ER%LIB - 1/2 CLRH 26-MAR-76
APR.MX==.-APRTAB-1 ; [527] LENGTH OF APRTAB
PAGE
SUBTTL LIB LIBRARY ERROR FAULT PROCESSOR
ER%LIB: ;ENTRY POINT
SOSGE ERRMX.(P4) ;COUNT THE LIB ERROR
JRST USRRET ;IGNORE THE ERROR MESSAGE
PUSHJ P,TY%HDR ;TYPE THE HEADER
MOVE T5,@-NN.(P) ;[200] GET THE MESSAGE ADDRESS
OUTSTR 0(T5) ;[200] TYPE THE MESSAGE
;**; [712] @ER%LIB + 5 SJW 23-SEP-77
MOVE G1,USR.PC(P4) ;[712] SAVE OLD STKPTR ON FOROTS ENTRY
;[712] CAN'T SAVE ON STK OR TRACE WILL FIND IT
MOVE T5,-<NN.+1>(P) ;[712] GET TOP OF STK ON FORERR ENTRY
MOVEM T5,USR.PC(P4) ;[712] USE IT TO START TRACEBACK
PUSHJ P,TRAC%% ;[200] TRACE THE ERROR
MOVEM G1,USR.PC(P4) ;[712] RESTORE OLD STKPTR
JRST USRRET ;[200] RETURN TO THE USER
PAGE
SUBTTL DAT DATA ERROR FAULT PROCESSOR
ER%DAT: ;ENTRY POINT
HRRZ T5,-1(P) ;GET THE TYPE CODE
CAILE T5,DAT.MX ;IN THE TABLE RANGE
JRST ERCALL ;NO, TYPE A MESSAGE
PUSHJ P,DAT%V2 ;[564] SET ERR.V & CHECK ERR=
MOVE T5,DATTAB(T5) ;GET THE DISPATCH ENTRY
TLNE T5,ER.HDR ;TYPE A HEADER
PUSHJ P,TY%HDR ;YES
PJRST EROPN% ;USE COMMON DISPATCH ROUTINE
ER%DA1: SETZB T5,T5 ;[424] ASSUME BINARY
TLNE P3,IO.FMT ;[424][450] IS IT FORMATTED I/O?
MOVEI T5,1 ;[424] YES
MOVE T5,RANTAB(T5) ;[424] GET CORRECT MESSAGE
TYPSTR (@T5) ;[330] OUTPUT MESSAGE
SKIPN DD.LIM(P3) ;[330] IS THERE A RECORD NUMBER
PJRST TY%DDB ;[330] NO - DO NOT TYPE #
TLNN P3,IO.FMT ;[424][450] IS IT FORMATTED I/O
OUTSTR [ASCIZ /
or unwritten or destroyed record number: /];[330]
TLNE P3,IO.FMT ;[424] [515] IS IT FORMATTED I/O
OUTSTR [ASCIZ /: /] ;[424] SO RECORD NO. LOOKS NICE
MOVE T0,DD.LIM(P3) ;[330] GET RECORD NUMBER
PUSHJ P,TY%DEC ;[330] TYPE IT
PJRST TY%DDB ;[330] TYPE DDB INFO.
DATTAB:
XWD ,ERCALL ;(0)
XWD ER.HDR,DAT1 ;(1)
;EDIT 424 DATTAB+2 DPL 22-JAN-75
XWD ER.HDR,ER%DA1 ;[424] (2)
XWD ER.HDR!ER.DDB!ER.MSG,
[FIVBIT (Check sum error reading binary records)] ;(3)
XWD ER.HDR!ER.DDB!ER.MSG,
[FIVBIT (Input output list greater than record size)] ;(4)
XWD ,DAT5 ;(5)
XWD ER.HDR!ER.DDB!ER.MSG,
[FIVBIT (Input output list without data conversion in format)] ;(6)
XWD ER.HDR!ER.DDB!ER.EDB,DAT7 ;(7)
XWD ER.HDR!ER.DDB!ER.MSG,
[FIVBIT (Attempt to READ beyond valid input)] ;(10)
;**;[626] CHANGE XWD AT DATTAB+15 SWG 1-DEC-1976
XWD ER.HDR!ER.DDB,DAT11 ;[626] (11)
XWD ER.HDR!ER.MSG,
[FIVBIT (REREAD before first READ is illegal)] ;(12)
XWD ER.HDR!ER.MSG,
[FIVBIT (can not RANDOM ACCESS a SEQUENTIAL file)] ;(13)
XWD ER.HDR!ER.MSG!ER.DDB,
[FIVBIT (BACKSPACE illegal for device)] ;(14)
XWD ER.HDR!ER.DDB!ER.EDB,DAT15 ;(15)
XWD ER.HDR!ER.DDB!ER.EDB,DAT16 ;(16)
XWD ER.HDR!ER.MSG,
[FIVBIT (can not do SEQUENTIAL ACCESS to a RANDOM file)] ;[375] (17)
DAT.MX==.-DATTAB-1 ;DEFINE THE TABLE SIZE
RANTAB: ;[424]
XWD ER.MSG,[FIVBIT (LSCW Illegal in binary record or reading ASCII)] ;[424] (0)
XWD ER.MSG,[FIVBIT (Attempt to read unwritten ASCII RANDOM ACCESS record)] ;[424] (1)
PAGE
SUBTTL SPECIAL DATA ERROR FAULT PROCESSING
DAT1: ;TYPE 1 ENTRY POINT
TYPSTR DAT1C ;TYPE THE MESSAGE
PUSHJ P,OPN11C ;[237] LOAD AND TYPE CHRACTER
PUSHJ P,TY%DDB ;GIVE THE UNIT NUMBER
MOVE T3,FBG.BP(P4) ;GET THE POINTER TO THE BEGINNING OF THE FORMAT
MOVEI T2,0 ;[212] CLEAR CHARACTER COUNTER
DAT1A: ILDB T0,T3 ;DUMP THE FORMAT STATEMENT
OUTCHR T0 ;OUTPUT THE FORMAT STATEMENT
CAMN T3,G2 ;IS THIS THE BAD CHARACTER
HRLI T2,0(T2) ;[212] YES - SAVE THE CHARACTER POSITION
CAME T3,FEN.BP(P4) ;END OF FORMAT?
AOJA T2,DAT1A ;NO, CONTINUE
OUTSTR [ASCIZ/
/] ;YES, FINISH THE LINE
TLNE T2,-1 ;[212] COMPUTE BAD CHARACTER POSITION
HLRZ T2,T2 ;[212] COMPUTE BAD CHARACTER POSITION
MARKCH: MOVEI T0," " ;GET A BLANK
SOJL T2,DAT1B ;COLUMN COUNTER
DAT1D: OUTCHR T0 ;OUTPUT A SPACE
SOJGE T2,DAT1D ;CONTINUE UNTIL UNDER BAD CHARACTER
DAT1B: OUTSTR [ASCIZ/^
/] ;DUMP AN UP ARROW
POPJ P, ;RETURN
DAT1C: FIVBIT (Illegal character in FORMAT statement)
DAT5: ;ASTERICK FILL ROUTINE FOR OUTPUT
IFE ASTFL,<JRST ERCALL ;ASTERFIL IS TURNED OFF>
IFN ASTFL,<
LDB T1,W.PNTR## ;[265] GET THE FIELD WIDTH
MOVEI T0,"*" ;GET AN ASTERICK TO FILL WITH
JSP P1,OBYTE.## ;OUTPUT AN ASTERICK
SOJG T1,OBYTE.## ;CONTINUE FILLING
POPJ P, ;RETURN TO ROUTINE>
DAT7: ;ILLEGAL CHARACTER IN INPUT ROUTINE
TYPSTR DAT7A ;TYPE THE MEGGAGE
DAT7F: PUSHJ P,OPN11B ;[347] [237] LOAD AND TYPE DELIMITED CHARACTER
PUSHJ P,TY%DDB ;GIVE THE UNIT NUMBER
TLNN P2,FT.LSD!FT.NML ;[354][347][451] LIST-DIRECTED I/O
PUSHJ P,DATFMT ;[354] NO - TYPE FORMAT
DAT7G: MOVE T1,DD.HRI(P3) ;[347] GET THE CURRENT BUFFER
;**; [636] INSERT @ DAT7G+1/2 CLRH 6-JAN-77
TLNE P3,IO.STR ;[636] ARE WE IN A STRING BUFFER?
JRST DAT7H ;[636] YES, HANDLE SEPARATELY
TLNE P3,IO.EDC ;[277] IN CASE OF ENCODE/DECODE
JRST DAT7E ;[277] USE START OF BUFFER
HRRZ T4,DD.BUF(P3) ;GET THE BUFFER SIZE
ADDI T4,-2(T1) ;GET THE END OF THE BUFFER
MOVE T3,POS.TB+1(P4) ;GET THE BEGINNING OF THE RECORD
CAIG T1,(T3) ;CHECK FOR BEGINNING OF BUFFER
CAIGE T4,(T3) ;[414] CHECK FOR THE END
DAT7E: HRRZI T3,1(T1) ;[414] [277]
;NO, START PRINTING AT THE BEGINNING OF THE BUFFER
TLNN T3,-1 ;[414] BYTE SIZE SET FROM POS.TB ?
TLO T3,(POINT 7,0,35);[414] NO - SET UP THE BYTE SIZE
SETZ T2, ;COUNT THE COLUMNS
DAT7B: ILDB T0,T3 ;GET A CHARACTER
OUTCHR T0 ;TYPE IT
CAME T3,DD.HRI+1(P3) ;IS THIS THE CHARACTR
JRST DAT7C ;NO
PUSH P,T2 ;SAVE THE POSITION
MOVN T2,DD.HRI+2(P3) ;GET THE REMAINING CHARACTER COUNT
SUBI T2,1 ;[277] TO GET ALL CHARS IN CASE OF ENC/DEC
;**;[474] Delete @ DAT7C JNG 20-Nov-75
DAT7C: AOJN T2,DAT7B ;[474] END OF BUFFER OR LINE FEED
POP P,T2 ;GET THE SPACING COUNT
CAIE T0,12 ;LINE FEED ALREADY OUT
OUTSTR [ASCIZ /
/] ;NO, DUMP IT
PUSHJ P,MARKCH ;[212] MARK BAD CHARACTER
JRST SYSRET ;TAKE SYSTEM RETURN
DATFMT: MOVE T2,FST.DY(P4) ;[354] GET THE CURRENT ENCODED FORMAT STATEMENT
MOVE T2,-1(T2) ;GET THE ASCII FORMAT POINTER
HLRZ T1,T2 ;GET THE WORD IN THE FORMAT
ANDI T1,377777 ;[212] CLEAR THE ENCODING FLAG
IMULI T1,5 ;FIVE CHARACTR/WORD
HRLI T2,(POINT 7,0);GET A BYTE POINTER TO THE STRING
DAT7D: ILDB T0,T2 ;GET A CHARACTER
OUTCHR T0 ;TYPE IT
SOJG T1,DAT7D ;CONTINUE THRU THE FORMAT
OUTSTR [ASCIZ /
/]
POPJ P, ;[354] RETURN
;MARK BAD CHARACTER
DAT7A: FIVBIT (Illegal character in data)
;**; [636] INSERT AFTER DAT7A CLRH 6-JAN-77
DAT7H: HLRZ T1,T1 ;[636] GET FIRST STRING BUFFER
HLRZ T3,0(T1) ;[636] GET WORD COUNT OF FIRST STRING
MOVE T4,T1 ;[636] SAVE LINK WORD TO NEXT STRING
SUBI T3,3 ;[636] SUBTRACT LENGTH OF REAL HEADER
ADDI T1,3 ;[636] MOVE UP TO REAL BUFFER
SETZ T2, ;[636] CLEAR CHARACTER COUNT
DAT7I: HRRZI T1,1(T1) ;[636] MOVE TO FIRST DATA WORD
SUBI T3,1 ;[636] ACCOUNT FOR IT IN WORD COUNT
IMULI T3,5 ;[636] CONVERT TO ASCII BYTES
TLO T1,440700 ;[636] MAKE BYTE POINTER
DAT7J: ILDB T0,T1 ;[636] GET A CHARACTER
OUTCHR T0 ;[636] OUTPUT IT
CAMN T1,DD.HRI+1(P3) ;[636] IS THIS THE CHARACTER?
PUSH P,T2 ;[636] YES, SAVE POSITION
AOS T2 ;[636] INCREMENT COLUMN COUNTER
SOJG T3,DAT7J ;[636] LOOP ON THIS STRING
HRRZ T4,0(T4) ;[636] GET NEXT STRING
MOVE T1,T4 ;[636] SET UP NEW POINTER
HLRZ T3,0(T4) ;[636] GET LENGTH FIELD OF NEXT STRING
SKIPE T4 ;[636] IF ANY
JRST DAT7I ;[636] LOOP UNTIL NO MORE STRINGS
POP P,T2 ;[636] RETRIEVE CHARACTER COUNT
CAIE T0,12 ;[636] LINEFEED ALREADY?
OUTSTR [ASCIZ /
/] ;[636] NO, OUTPUT ONE
PUSHJ P,MARKCH ;[636] MARK BAD CHARACTER
;**; [650] CHANGE @ DAT7J+15 SWG 21-MAR-77
PUSHJ P,DMPST.## ;[650][636] GET RID OF STRING
JRST SYSRET ;[636] TAKE SYSTEM RETURN
;**; [626] INSERT AT DAT15-1 SWG 1-DEC-1976
DAT11: TYPSTR DAT11A ;[626] PRINT 1ST PRT OF MESSAGE
OUTSTR [ASCII / /] ;[626] A SPACE
MOVE T1,-10(P) ;[626] OFFENDING NAME IS 10 FRAMES FROM TOP OF STACK
;[626] *** BE CAREFUL OF THIS REF OF R17
PUSHJ P,TY%SIX ;[626] TYPE IT OUT
OUTSTR [ASCII / /] ;[626] A SPACE
TYPSTR DAT11B ;[626] REST OF MESSAGE
OUTSTR [ASCII / /] ;[626] SPACE BEFORE NAMELIST NAME
MOVE T1,@P2 ;[626] P2 POINTS TO NAMELIST NAME
PUSHJ P,TY%SIX ;[626] PRINT IT OUT
POPJ P, ;[626] RETURN
DAT11A: FIVBIT (Variable ) ;[626]
DAT11B: FIVBIT ( cannot be found in NAMELIST block ) ;[626] REST OF MESSAGE
DAT15: TYPSTR DAT15M ;[347] TYPE THE MESSAGE
JRST DAT7F ;[347] AND OTHER INFORMATION
DAT15M: FIVBIT (Illegal delimiter in LIST DIRECTED input)
DAT16: TYPSTR DAT16M ;[354] TYPE MESSAGE
PUSHJ P,TYPDD6 ;[354] TYPE CR-LF
PJRST DATFMT ;[354] FORMAT AND RETURN
DAT16M: FIVBIT (Missing WIDTH FIELD for A or R on input) ;[354]
PAGE
SUBTTL DEV DEVICE ERROR FAULT PROCESSOR
ER%DEV:
HRRZ T5,-1(P) ;[564]GET THE TYPE CODE
JUMPN T5,ERDEV1 ;[564]CHECK FOR GETSTS UUO CALL
HLLZ T1,DD.UNT(P3) ;GET THE CHANNEL NUMBER
TLO T1,(GETSTS) ;GET A STATUS UUO
XCT T1 ;GET THE DEVICE STATUS
;**; [552] INSERT @ ER@DEV + 4 1/2 CLRH 9-JUN-76
TRZ T0,10000 ;[552] CLEAR THE ACTIVE BIT -- NO ERROR
JFFO T0,ERDEV7 ;GET THE MESSAGE INDEX
ERDEV7: HRRZI T5,-^D18(T1) ;[564] GET THE MESSAGE INDEX
ERDEV1: PUSHJ P,DEV%V2 ;[564] SET ERR.V & CHECK ERR= (RETURN IF EOF)
MOVE T4,T5 ;[564] PUT ERR NUM WHERE IT'S EXPECTED
CAILE T4,^D4 ;[564] IS THE INDEX IN RANGE
JRST ERDEV6 ;[211][564] CHECK FOR END OF TAPE
MOVE T1,DD.STS(P3) ;[211][564] GET DEVICE CHARACTERISTICS
TLC T1,DV.CDR!DV.IN ;[211] BLOCK
TLCN T1,DV.CDR!DV.IN ;[211] TOO LARGE
CAIE T4,3 ;[211] ON CDR?
SKIPA T5,DEVTAB(T4) ;[211] NO - LOAD ERROR FLAGS
MOVEI T5,[FIVBIT (Nonexistent CDR file)] ;[211] - YES - LOAD ERROR FLAGS
CAIE T4,4 ;END OF FILE CALL?
JRST ERDEV2 ;NO, MUST BE AN ERROR CALL
;**; [711] @ERDEV1 + 14 (OCTAL) SJW 23-SEP-77
TLNE T1,DV.DSK!DV.DTA!DV.TTA ;[711] ONE OF THESE DEVICES ?
JRST ERDEV3 ;[711] NO: DON'T CLOSE
MOVE T1,P ;[711] SAVE STKPTR+1 SO ERROR IN CLOSI.
ADD T1,[1,,1] ;[711] WILL NOT RECURSE
MOVEM T1,ERR.SP(P4) ;[711]
PUSHJ P,CLOSI.## ;DO INPUT CLOSE
ERDEV3: HRRZ T1,ERR.PC(P4) ;[711] END = ADDRESS SPECIFIED?
JUMPE T1,ERDEV2 ;[564] NO => CHECK ERR=
ERDEV4: MOVEM T1,USR.PC(P4) ;[225][447] CHANGE THE USR'S PC ADDRESS
;**;[510] Insert @ ERDEV4+1L JNG 5-Dec-75
MOVEM T1,ALT.PC(P4) ;[510] STORE AGAIN AS EOF FLAG
POPJ P, ;[211] RETURN
ERDEV2: HLRZ T1,ERR.PC(P4) ;ERR = ADDRESS SPECIFIED?
JUMPN T1,ERDEV4 ;[211] YES - TAKE ERROR RETURN
ERDEV5: PUSH P,T5 ;[262] NO - SAVE T5
;**; [711] @ERDEV5 + 1 SJW 23-SEP-77
TLZN P3,IO.OPN ;[711] CLEAR THE OPEN BIT, OPEN ?
JRST ERDEV8 ;[711] NO: NO RELEASE
MOVE T1,P ;[711] SAVE STKPTR+1 SO ERROR IN RELE%%
ADD T1,[1,,1] ;[711] WILL NOT RECURSE
MOVEM T1,ERR.SP(P4) ;[711]
PUSHJ P,RELE%%## ;RELEASE THE CHANNEL
ERDEV8: POP P,T5 ;[711] RESTORE T5
PUSHJ P,TY%HDR ;[262] TYPE THE HEADER
TYPSTR (@T5) ;TYPE THE MESSAGE
PUSHJ P,TY%DDB ;TYPE THE DEVICE INFO
JRST SYSRET ;TAKE THE SYSTEM RETURN
; DEVICE DEPENDENT ERRORS
ERDEV6: MOVE T2,DD.STS(P3) ;[211] LOAD DEVICE CHARACTERISTICS
CAIN T1,^D25 ;[211] END OF TAPE
TLNN T2,DV.MTA ;[211] ON MAGTAPE?
POPJ P, ;[211] NO - EXIT
MOVEI T5,[FIVBIT (End of tape)] ;[211] LOAD MESSAGE
JRST ERDEV2 ;[564] ERR= OR ABORT
DEVTAB: ;DEVICE ERROR MESSAGE TABLE
XWD ,[FIVBIT (Write protected)] ;(0)
XWD ,[FIVBIT (Device error)] ;(1)
XWD ,[FIVBIT (Parity error)] ;(2)
;**; [524] CHANGE @ DEVTAB + 4L CLRH 17-MAR-76
XWD ,[FIVBIT (Block too large quota exceeded or file structure full)] ; [524] (3)
XWD ,[FIVBIT (End of file)] ;(4)
PAGE
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
PAGE
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
OUTSTR [ASCIZ/ of /]
;[250] FIND THE NAME OF THE ROUTINE
;[250] THAT CONTAINED THE
;[250] ARRAY REFERENCE. DO THIS BY
;[250] LOOKING BACK UP THE STACK FOR
;[250] THE CALL THAT PRECEEDED THE CALL
;[250] TO "PROAR." THE LOCATION BEFORE
;[250] THE ENTRY POINT WILL CONTAIN THE
;[250] FUNCTION NAME IN SIXBIT
MOVEI T5,-NN.(P) ;[250] STACK LOC BEFORE THE CALL TO %FORER
PUSHJ P,GETCAL ;[250] GET 1ST CALL BACK ON THE STACK -
;[250] THIS IS THE CALL TO PROAR.
XCT FORER% ;[250] ERROR IF AT TOP OF STACK
CAI ;[250] SIMULATE ERROR(SYS,0,0) CALL
SUBI T5,1 ;[250] SET PARAM FOR "GETCAL" TO STACK LOC
;[250] PRECEEDING LOC FOR CALL TO PROAR.
PUSHJ P,GETCAL ;[250] 2ND CALL BACK IS CALL TO THE ROUTINE
;[250] IN QUESTION
SKIPA T1,[SIXBIT/MAIN./] ;[250] IF ARE AT TOP OF STACK, WERE
;[250] IN THE MAIN PROGRAM
MOVE T1,-1(T3) ;[250] OTHERWISE, T3 CONTAINS THE PUSHJ INSTR
;[250] GET THE CONTENTS OF THE LOC BEFORE
;[250] THE ENTRY POINT TRANSFERRED TO
PUSHJ P,TY%SIX ;[250] TYPE OUT THE ROUTINE NAME
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.
PAGE
SUBTTL FORTRAN TRACE ROUTINES
ENTRY TRACE%
SIXBIT /TRACE./ ;NAME FOR TRACE
TRACE%:
PUSHJ P,SAVE.## ;SAVE THE AC'S FOR USER CALL
TRAC%%: ;FOROTS ENTRY WHEN AC'S ARE SAVED
MOVEI T5,(P) ;GET THE CURRENT STACK POSITION
; MOVEI T5,(P) ;[200] GET THE CURRENT STACK POINTER
TRACE1: HRRZ T4,USR.PC(P4) ;GET THE USER'S CALLING ADDRESS
PUSHJ P,GETCAZ ;ADDRESS CHECK IT
POPJ P, ;RETURNS T3= PUSHJ ADDRESS+1
OUTSTR [ASCIZ/
Name (Loc) <<--- Caller (Loc) <#Args> [Arg Types]
/]
TRACE2: MOVE T1,-1(T3) ;YES, GET THE SIXBIT SUBROUTINE NAME
PUSHJ P,TY%SIX ;TYPE THE SUBROUTINE NAME OUT
OUTSTR [ASCIZ/ (/]
MOVEI T0,(T3) ;ENTRY POINT TO THE SUBROUTINE
PUSHJ P,TY%OCT
OUTSTR [ASCIZ /)/] ;[211] TYPE A CLOSING PAREN
TRNN T3,700000 ;[211] 6 DIGIT ADR?
OUTSTR [ASCIZ / /];[211] NO - POSITION ON LINE
OUTSTR [ASCIZ/ <<--- /] ;[211] FINISH CALLEE
PUSH P,T4 ;SAVE THE ADDRESS OF THE PUSHJ +1
SUBI T5,1 ;SET THE STACK BACK ONE
PUSHJ P,GETCAL ;GET THE NEXT CALL
JRST TRACE3 ;END OF TRACE TO THE MAIN PROGAM
EXCH T4,(P) ;GET THE OLD PUSHJ+1 ADDRESS
PUSHJ P,TYPTRC ;TYPE THE TRACE
POP P,T4 ;RESTORE THE NEW POINTER
JRST TRACE2 ;CONTINUE
TRACE3:
POP P,T4 ;RESTORE THE OLD POINTER
;**; [600] CHANGE @ TRACE3+1 CLRH 24-SEP-76
HRRZ T3,SA.ADR(P4) ;[600] GET THE STRATING ADDRESS
SKIPA T1,[SIXBIT /MAIN./] ;MAIN PROGRAM CALL
TYPTRC: MOVE T1,-1(T3) ;GET THE CALLING SUBROUTINE NAME
PUSHJ P,TY%SIX ;TYPE THE NAME
OUTSTR [ASCIZ/+/] ;
MOVEI T0,(T4) ;GET THE CALFER ADDRESS
SUBI T0,1(T3) ;MINUS THE ENTRY POINT
PUSHJ P,TY%OCT ;TYPE THE OFFSET FROM THE ENTRY
OUTSTR [ASCIZ/(/] ;LEFT PAREN
MOVEI T0,-1(T4) ;GET THE PUSHJ ADDRESS
PUSHJ P,TY%OCT ;TYPE IT
OUTSTR [ASCIZ /) <#/];#ARGUEMENTS
MOVE T4,-2(T4) ;GET THE MOVEI ADDRESS
HLL T4,-1(T4) ;BUILD AN AOBJN POINTER
HLRE T0,T4 ;GET THE ARGUMENT COUNT
MOVMS T0 ;MAKE POSITIVE
PUSHJ P,TY%DEC ;TYPE IT OUT
OUTSTR [ASCIZ /> [/] ;TYPE A CLOSING BRACKET
JUMPGE T4,TYPTR2 ;JUP IF NO ARGUMENTS
TYPTR1: LDB T1,[POINT 4,(T4),12] ;GET THE ARGUMENT TYPE
IDIVI T1,5 ;FIVE ENTRIES / WORD
;**; [546] CHANGE @ TYPTR1 + 2 CLRH 18-MAY-76
MOVE T0,TYPCOD(T1) ;[546] GET THE ASCII TYPE CODE
IMULI T2,7 ;GET THE SHIFT COUNT
ROT T0,7(T2) ;POSITION THE CHARACTER
OUTCHR T0 ;OUTPUT THE ASCII CHARACTER
AOBJN T4,TYPTR1 ;CONTINUE THRU THE ARGLIST
TYPTR2: OUTSTR [ASCII/]
/] ;CLOSING BRACKET
POPJ P, ;RETURN
; 0123456701234567
TYPCOD: ASCII /ULIUFUOSDUUUCUUK/
;ROUTINE TO NEXT THE NEXT SUBROUTINE CALL FROM THE STACK
; ENTRY T5=THE STACK ADDRESS TO START THE SEARCH
; PUSHJ P,GETCAL
; RETURN (NON-SKIP) ;END OF STACK
; (SKIP) ;T4= THE ADDRESS+1 OF THE PUSHJ
; ;T3=THE PUSHJ INSTRUCTION
GETCAL:
CAIGE T5,STK.SV(P4) ;IS THE THE BEGINNING OF THE STACK
POPJ P, ;YES, END OF SEARCH
HRRZ T4,(T5) ;GET THE STACK ENTRY
GETCAZ: PUSHJ P,ADRCHK ;IS THIS A VALID ADDRESS
SOJA T5,GETCAL ;NO, GET THE NEXT ENTRY
MOVE T3,-1(T4) ;GET THE CALLING INSTRUCTION
HLRZ T1,T3 ;GET THE OP CODE
CAIN T1,(PUSHJ P,@) ;[412] IS IT AN INDIRECT CALL
SKIPA T3,(T3) ;[412] YES GET ADDRESS OF ROUTINE
CAIN T1,(PUSHJ P,) ;[412] IS IT A PUSHJ P,
SKIPA ;[412] YES IT IS
SOJA T5,GETCAL ;NO, GET THE NEXT ENTRY
HLRZ T1,-2(T4) ;GET THE INSTRUCTION BEFORE THE PUSHJ
CAIE T1,(MOVEI L,) ;MUST LOAD THE ARGUMENT LIST
SOJA T5,GETCAL ;NO, GET THE NEXT ENTRY
HLRZ T1,(T3) ;GET THE TARGET INSTRUCTION
;**;[713] INSERT @GETCAZ + 15L SJW 26-SEP-77
CAIE T1,(JSP 1,) ;[713] IS IT OVERLAY CALL ?
JRST GETCA1 ;[713] NO
HRRZ T1,(T3) ;[713] GET WORD BEFORE ROUTINE
MOVE T1,-1(T1) ;[713] JSP'ED TO
CAME T1,[SIXBIT '.OVRLA'] ;[713] LINK SETS UP ROUTINE NAME
SOJA T5,GETCAL ;[713] NOT AN OVERLAY CALL
HRRZ T3,@1(T3) ;[713] GET ADR OF ROUTINE ENTRY
HLRZ T1,(T3) ;[713] GET 1ST INSTRUCTION LH
GETCA1: CAIN T1,(JRST 1,) ;[713] CHECK FOR CONCEALED ENTRY
HRR T3,(T3) ;YES, GO TO THE TRUE ENTRY
JRST CPOPJ1 ;SKIP RETURN
;ROUTINE TO ADDRESS CHECK THE CONTENTS OF AC T4
; ENTRY MOVE T4,ADDRESS TO BE CHACKED
; PUSHJ P,ADRCHK
; RETURN (NON-SKIP) ;INVALID ADDRESS
; (SKIP) ;VALID ADDRESS
ADRCHK: ;ENTRY POINT
CAIG T4,140 ;CHECK THE LIMITS OF THE LOW SEGMENT
POPJ P, ;BELOW THE LOW SEGMENT EXIT
CAMG T4,.JBREL ;CHECK FOR A VALID LOW SEG ADDRESS
JRST CPOPJ1 ;YES, GIVE A SKIP RETURN
SKIPN T1,.JBHRL ;IS THERE A HIGH SEGMENT
POPJ P, ;NO, ERROR
CAIGE T4,400010 ;ABOVE THE BEGINNING OF THE HIGH SEGMENT
POPJ P, ;NO, EXIT
CAIGE T4,(T1) ;BELOW THE END OF THE HIGH SEGMENT
CPOPJ1: AOS (P) ;YES, SKIP RETURN
CPOPJ: POPJ P, ;ERROR RETURN
PAGE
SUBTTL ERROR RECOVERY ROUTINES
; ENTERED VIA PUSHJ P,<CLASS>%V2
; WITH <CLASS> ERROR VALUE IN T5
; USES T1, T2, T3
; SET T1 = NORMALIZING ERROR FACTOR FOR ERROR NUMBER
; SET T2 = V1 # FOR UNCLASSIFIABLE <CLASS> ERROR
SYS%V2: MOVEI T1,^D100 ;[564]
MOVEI T2,^D999 ;[564]
JRST ERR%V2 ;[564]
OPN%V2: MOVEI T1,^D250 ;[564]
MOVEI T2,^D699 ;[564]
JRST ERR%V2 ;[564]
DAT%V2: MOVEI T1,^D300 ;[564]
MOVEI T2,^D799 ;[564]
JRST ERR%V2 ;[564]
DEV%V2: MOVEI T1,^D400 ;[564]
MOVEI T2,^D899 ;[564]
JRST ERR%V2 ;[564]
; T1 = NORMALIZING ERROR FACTOR
; T2 = V1 # FOR UNCLASSIFIABLE <CLASS> ERROR
; = SCRATCH IN/AFTER ERROR-SEARCH
; T3 = SCRATCH
; DON'T TOUCH T5 (OR T4) SO CAN CONTINUE NORMAL ERROR
; PROCESSING IF NECESSARY
; IF ERR.V2 ALREADY SET THEN GOT HERE ON ERROR INSIDE
; CLEANUP => V2 GETS +2000 TO MARK FAILURE OF CLEANUP &
; EXIT (SINCE ERR= BRANCH ALREADY SET UP)
; IF EOF (DEV #404) => EXIT SO ER%DEV CAN HANDLE END= THEN ERR=
; IF NO ERR= THEN SHOULDN'T HANDLE => EXIT
; IF NO CLEANUP ROUTINE THEN CAN'T HANDLE => EXIT
; OTHERWISE:
; FIX ERR= TO BE RETURN POINT
; SET ERR.V2 AND LOOK UP V2 TO SET ERR.V1
; ERR.V1 := T2 (UNCLASSIFIABLE ERROR) IF V2 NOT FOUND
; CUT STACK BY RESTORING P FROM ERR.SP
; CALL CLEANUP ROUTINE
; SKIP RETURN ON SUCCESS => EXIT
; FAILURE => V2 GETS +1000 TO FLAG FAILURE & EXIT
ERR%V2: ADD T1,T5 ;[564] NORMALIZE ERROR NUMBER
SKIPE 0,ERR.V2(P4) ;[564] ALREADY AN ERROR SET ?
JRST ERR%ER ;[564] YES => CLEANUP FAILS
; SEARCH ERROR TABLE FOR V2 TO SET V1
MOVEM T2,ERR.V1(P4) ;[564] DEFAULT IS "UNCLASSIFIABLE ERROR"
MOVEM T1,ERR.V2(P4) ;[564] STORE NORMALIZED ERROR NUMBER
MOVEI T2,ERR.CT ;[564] GET COUNT OF ERROR TABLE ENTRIES
ERRSE1: HLRZ T3,ERR.TB(T2) ;[564] GET NEXT V2 VALUE IN TABLE
CAMN T3,ERR.V2(P4) ;[564] MATCH ?
JRST ERRSE2 ;[564] YES
SOJGE T2,ERRSE1 ;[564] NEXT ENTRY INDEX & LOOP
JRST ERRSE3 ;[564] NO MATCH => DEFAULT ALREADY SET
ERRSE2: HRRZ T3,ERR.TB(T2) ;[564] ERR.V2 FOUND =>
MOVEM T3,ERR.V1(P4) ;[564] SET ERR.V1
ERRSE3:
CAIN T1,^D404 ;[564] EOF DEVICE ERR ?
POPJ P, ;[564] YES => EXIT BACK TO ER%DEV
HLRZ T2,ERR.PC(P4) ;[564] ERR= PRESENT ?
CAIN T2,0 ;[564]
POPJ P, ;[564] NO => EXIT
;**;[714] DELETE @ERRSE3 + 6 SJW 27-SEP-77
MOVEM T2,USR.PC(P4) ;[564] SET UP RETURN TO ERR=
MOVEM T2,ALT.PC(P4) ;[564]
;**;[714] @ERR%ER-4 SJW 27-SEP-77
SKIPN 0,ERR.RT(P4) ;[714][564] CLEANUP ROUTINE ?
JRST ERR%ER ;[714] NO: REPORT FAILURE
MOVE P,ERR.SP(P4) ;[564] CUT THE STACK
PUSHJ P,@ERR.RT(P4) ;[564] CLEANUP HOPEFULLY
JRST ERR%FA ;[564] CLEANUP FAILED
POPJ P, ;[564] CLEANUP OK => EXIT TO USER
;**; [711] @ERR%ER SJW 23-SEP-77
;**;[714] @ERR%ER SJW 27-SEP-77
ERR%ER: SKIPE ERR.SP(P4) ;[714] IS THERE A STK PTR SAVED ?
MOVE P,ERR.SP(P4) ;[714][711] YES: CUT STACK TO ORIGINAL CALLER
MOVEI T2,^D2000 ;[564] ERROR DURING CLEANUP
JRST ERRADD ;[564]
ERR%FA: MOVEI T2,^D1000 ;[564] MARK CLEANUP FAILED
ERRADD: ADDM T2,ERR.V2(P4) ;[564]
POPJ P, ;[564] EXIT TO USER
ERR.TB: ERRTBL ;[564] THE ERROR V2,,V1 TABLE
END