SPL,L,M,O,T,C NAME DGLST(8) "REV G 770323" ! REV-G 03/23/77 ! DIAGNOSTIC PRINT ROUTINE ! PRINTS A DIAGNOSTIC MESSAGE ON THE TELETYPE AND OTHER ! INFORMATION, ACCORDING TO THE ERROR CODE. ! ! ERROR CODES 1-49 DO NOT CAUSE AN ABORT, UNLESS THE "ABORT ! IF ERRORS" FLAG IS SET. IF THE COMMAND FILE IS NOT THE ! TTY, THEN THE POSITION OF THE PREVIOUS FILE, NAME, ETC., ! IS SAVED(STACKED) AND THE COMMAND FILE IS SETUP TO ! COME FROM THE TTY. COMMAND CONTROL CAN BE RETURNED BY A ! "TR" COMMAND WITH NO FILE ATTACHED. ! ! ONLY ERROR CODES 1-21 AND 50 ARE IMPLEMENTED. ! LET BUF BE INTEGER(40) INITIALIZE BUF TO " V " LET ABRT BE INTEGER(6) INITIALIZE ABRT TO "SXL ABORTED " LET JTY,JLU,JSEC,OFF,RS,REC,NAM3,NAM2,NAM1\ BE INTEGER LET IAILU BE INTEGER,EXTERNAL LET UMAIN BE LABEL,EXTERNAL LET STAK,SVLU BE PSEUDO,EXTERNAL LET XCOM,DNFLG,CCPTR,PTPTR,SOURC BE INTEGER,EXTERNAL LET TRSTK,SODC4,INLU,ASTAK,ERR,CMDLN BE INTEGER,EXTERNAL LET LAST ,WKTOP BE INTEGER,EXTERNAL LET ERR,FILEX,ABRTF,LOCC,BPLOC,FWAM,LWAM,XMAXA,DCBBO,DCBB4,\ LWABP,LCOMM,ABRTF,BPLOC BE INTEGER,EXTERNAL LET LISTO,LSTLU BE INTEGER,EXTERNAL LET NXSY,CCON BE FUNCTION,EXTERNAL LET MSTBL,.XEC,.GOTO,BLNK,UNSTR ,\ STPRG,TRBAK,\ OCTAQ,DECV,MOVE., EXEC BE SUBROUTINE,EXTERNAL LET PSER BE SUBROUTINE LET OBT BE INTEGER(41),EXTERNAL LET LOCF,CLOSE,ILOSE,FKDCB BE SUBROUTINE,EXTERNAL ! DGLST: SUBROUTINE(ERRNO,DATA) GLOBAL LET ERRNO BE INTEGER !ERROR NUMBER CODE LET DATA BE INTEGER !DATA FOR ERROR PRINTOUT ! LET SER1,SER2,SER3,SER4,SER5,SER6,SER7 ,SER8,SER9,SER10,\ SER11,SER12,SER13,SER14,SER15,SER16,SER17,SER18,SER19,\ SER20,SER21,\ SER50 BE LABEL DNFLG_0; CALL STPRG(SOURC); CALL STPRG(CCPTR); CALL STPRG(PTPTR) CALL .XEC(2,OBT(2),CMDLN) ! JUMP TO PROPER ERROR CODE PROCESSOR CALL .GOTO(ERRNO,SER1,SER2,SER3,SER4,SER5,\ SER6,SER7,SER8,SER9,SER10,\ SER11,SER12,SER13,SER14,SER15,\ SER16,SER17,SER18,SER19,\ SER20,SER21,\ SER50) ! ERROR # 1--NO NAM RECORD IN RELOCATABLE INPUT LET M1 BE INTEGER(6) INITIALIZE M1 TO "NO NAM RCRD." SER1: CALL .XEC(2,M1,6) GOTO SER4. ! ERR #2-- ILLEGAL RECORD TYPE LET M2 BE INTEGER(7) INITIALIZE M2 TO "ILL.RCRD TYPE." SER2: CALL .XEC(2,M2,7) GOTO SER4. ! ERROR # 3--ILLEGAL EXT ORDINAL IN DBL RECORD LET M3 BE INTEGER(4) INITIALIZE M3 TO "ILL.EXT." SER3: CALL .XEC(2,M3,4) GOTO SER4. ! ERROR #4--CAN'T ALLOCATE ANY LINK. LET M4 BE INTEGER(6) INITIALIZE M4 TO "NO LINK ROOM" SER4: CALL .XEC(2,M4,6) SER4.: CALL PSER(DATA) ! ERROR 5--SCANNER FAILURE. ILLEGAL CHARACTER LET M5 BE INTEGER(5) INITIALIZE M5 TO "ILL.CHAR " SER5: M5(5)_DATA OR 20000K CALL .XEC(2,M5,5) GOTO SRTRN ! ERR #6/-- PARSING ERROR LET M6 BE INTEGER(9) INITIALIZE M6 TO "UNRECOGNIZED STMT." SER6: CALL .XEC(2,M6,9) GOTO SRTRN ! ERR #7 ILLEGAL LINKS START AT ADDRESS LET M7 BE INTEGER(21) INITIALIZE M7 TO "ILL.LINKS STRT ADDR.= BPLOCC= " SER7: T1_[T_@M7+11]+7 CALL OCTAQ($T,DATA); CALL OCTAQ($T1,BPLOC) CALL .XEC(2,M7,21) GOTO SRTRN ! ERROR # 8--MEMORY OVERFLOW LET LOCC,LWAM BE INTEGER,EXTERNAL LET M8 BE INTEGER(16) INITIALIZE M8 TO "MEM OVF LOCC= LWAM= " SER8: T1_[T_@M8+7]+5 CALL OCTAQ($T,LOCC); CALL OCTAQ($T1,LWAM) CALL .XEC(2,M8,16) GOTO SER4. ! ERROR #9-- BP OVERFLOW LET M9 BE INTEGER(18) INITIALIZE M9 TO "BP MEM OVF BPLOCC= LWABP= " SER9: T1_[T_@M9+9]+6 CALL OCTAQ($T,BPLOC); CALL OCTAQ($T1,LWABP) CALL .XEC(2,M9,18) GOTO SER4. ! ERROR # 10--FILE MANAGER CREATE ERROR LET M10 BE INTEGER(12) INITIALIZE M10 TO "CREAT ERR " SER10: T1_[T_[T3_@M10]+3]+6 SR10: CALL MOVE.($DATA,$T,3); CALL DECV($T1,ERR,I) CALL .XEC(2,$T3,(I+19)>-1) GOTO SRTRN ! ERROR # 11 -- FILE MANAGER OPEN ERROR LET M11 BE INTEGER(12) INITIALIZE M11 TO "OPEN ERR " SER11: T1_[T_[T3_@M11]+3]+6; GOTO SR10 ! ERROR 12 -- SET $() WHERE EXPR EVALUATES < 2 LET M12 BE INTEGER(12) INITIALIZE M12 TO "EVAL.ERR,EXPR= (8) " SER12: T_@M12+7 CALL OCTAQ($T,DATA) CALL .XEC(2,M12,12) GOTO SRTRN ! ERROR 13 -- BP LNTH IN NAM RECORD <0 LET M13 BE INTEGER(6) INITIALIZE M13 TO "ILL.BP LNTH " SER13: CALL .XEC(2,M13,6) GOTO SER4. ! ERROR # 14 -- COMMON BLOCK ERROR LET M14 BE INTEGER(20) INITIALIZE M14 TO "COMMON LNTH ERR,LNTH= ,NOW= " SER14: T1_[T_@M14+11]+6 CALL OCTAQ($T,XCOM); CALL OCTAQ($T1,LCOMM) CALL .XEC(2,M14,20); DATA_0 GOTO SER4. ! ERROR # 15 -- NAM OUT OF SEQUENCE LET M15 BE INTEGER(8) INITIALIZE M15 TO "NAM OUT OF SEQ." SER15: CALL .XEC(2,M15,7 ) GOTO SER4. ! ERROR 16 -- FILE READ OR WRITE ERROR LET M16 BE INTEGER(22) INITIALIZE M16 TO "FILE READ OR WRITE ERR= FILE = " SER16: T1_[T_@M16+12]+6 CALL DECV($T,ERR,I); CALL MOVE.($DATA,$T1,3) CALL .XEC(2,M16,22) GOTO SRTRN ! ERROR # 17 -- NO COMMAND ID CHARACTER AND NON-KEYBOARD CMND INPUT LET M17 BE INTEGER(5) INITIALIZE M17 TO "NO CMND ID" SER17: CALL .XEC(2,M17,5) GOTO SRTRN ! ERROR # 18 -- ABORT BECAUSE OF UNDEFINEDS(ABORT IF UNDEFS SET) LET M18 BE INTEGER(6) INITIALIZE M18 TO "UNDEFS ABORT" SER18: CALL .XEC(2,M18,6) GOTO SRTT ! ERROR 19 -- NO MAIN PROGRAM LET M19 BE INTEGER(6) INITIALIZE M19 TO "NO MAIN PRGM" SER19: CALL .XEC(2,M19,6) GOTO SRTRN ! ERROR 20 --DUPLICATE ABSOLUTE FILE LET M20 BE INTEGER(7) INITIALIZE M20 TO "DUPL.ABS.FILE" SER20: CALL .XEC(2,M20,7); GOTO SRTRN ! !ERROR 21 ABORT SXL SER21: GOTO SRTT LET M50 BE INTEGER(9) INITIALIZE M50 TO "WORKSPACE OVERFLOW" ! ERROR 50 -- WORKSPACE OVERFLOW SER50: CALL .XEC(2,M50,9) GOTO SRTT ! SRTRN: IFNOT(ABRTF AND 2) THEN GOTO TRTTY SRTT: CALL .XEC(2,ABRT,6) CALL EXEC(5,-1) !RELEASE DISC TRACKS $(@DCBB4+15)_0 !SET CURRENT EXTENT# TO 0 FOR PURGING IF DCBB4 THEN CALL CLOSE(DCBB4,ERR,48)!PURGE ABS. FILE IF(LISTO AND 27K)THEN CALL EXEC(3,1100K+LSTLU,-1) ALWAYS DO\ CLOSE ALL TRANSFER FILES [CALL ILOSE($SODC4,ERR);\ IF TRSTK THEN CALL TRBAK, ELSE CALL EXEC(6)] TRTTY: CALL LOCF($SODC4,ERR,REC,RS,OFF,JSEC,JLU,JTY) IF IAILU = 0 THEN \ DON'T STACK IF FILE = TTY [CALL ILOSE($SODC4,ERR); T_@JTY; REPEAT 6 TIMES DO\ [STAK(TRSTK)_$T; T_T+1]; T_SODC4; REPEAT 3 TIMES DO\ [T_T-1; STAK(TRSTK)_$T]; \ INLU_401K; CALL FKDCB($SODC4,INLU,0,0,100000K)] GOTO UMAIN END PSER: SUBROUTINE(PROG) LET PSERM BE INTEGER(14) INITIALIZE PSERM TO "FILE NAME= NAME= " T1_[T_@PSERM+5]+6 CALL MSTBL(FILEX,$T,I); IF PROG THEN\ [T2_CCON(PROG); CALL UNSTR(PROG,$T1,T2); I_17] CALL .XEC(2,PSERM,((I+11)>-1)) GOTO SRTRN END END END$