TITLE 'ERROR-B00,08/22/73,DWG702985' SYSTEM SIG7F CSECT 1 PCC 0 CONTROL CARDS NOT PRINTED. ERROR@ RES 0 ORIGIN OF ERROR MODULE. * * REF'S AND DEF'S * DEF ERROR@ = START OF 'ERROR' MODULE. DEF ENTEREM PT OF ENTRY INTO THE ERROR MODULE. SPACE 3 * REFS TO PROCEDURE: REF EBALS TBL OF BAL,R15 EXITS INTO ENTEREM. REF ALOCBLK ALLOCATES A DATA BLOCK. REF ALOCHNW ALLOCS. DATA BLK W/HDR & EVENS SIZE. REF DREF DE-REFERENCES A DATA BLOCK. REF MAYDREF DE-REFS. DATA BLK, IF NON-ZERO PTR. REF SICLR CLEARS STATE-INDICATOR TO GO-STATE. REF NIRETURN RETURN AFTER NILADIC INTRINSIC OPER. REF BCBRANCH CLR BREAK & START ERR-CTRL'D BRANCH. REF ECBRANCH START ERR-CONTROLLED BRANCH. REF BBADFL EXIT TO USE BAD FUN.LINE (MAYBE). REF BCONTOFF EXIT AS IF A )CONTINUE CMD ISSUED. REF CMDEXITM EXIT ACCORDING TO MODE. REF CMDEXITO EXIT VIA MODE UNLESS OFF-LINE RUN. REF INPDIR EXIT FOR DIRECT INPUT. REF INPEVAL EXIT FOR EVALUATED INPUT. REF INPLSCER EXIT FOR INPUT AFTER LINESCAN ERR. REF GENNAME GENERATE A NAME IN IMAGE BUFFER. REF GENNAME0 DITTO (ALT.ENTRY). REF TEXTC2I MOVE TEXTC MSG TO IMAGE. REF FUNLDIS% DISPLAY FUNCTION LINE. REF EDECODOP DECODE CODESTRING & DISPLAY ERROR. REF DUMPLINP DISPLAY LINE AS A PROMPT. REF EDUMPLIN DISPLAY LINE IN ERROR. REF EDUMPLIG DITTO (ALT.ENTRY). REF EWRTEXTC WRITE TEXTC ERROR MSG. REF EWROUTWB WRITE ERROR INFO AT WORD BOUNDARY. REF CLOSR CLOSE & RELEASE FILE. REF OBSERVEZ EXIT PT AFTER AN OBSERVATION. REF SINGOUT DISPLAY VALUE OF OBSERVATION. * REFS TO CONTEXT: REF ELINK SOMETIME LINK TO ERROR ROUTINE. REF ERRORID INTERNAL I.D. FOR ERROR. REF EREGS @ R1-R6 SAVED AT ERR-CTRL TEST. REF ERRLOC @ ERROR LOC (CURRLINO & NAME PTR). REF ERRNUM @ ERROR NUMBER. REF SICTRL STATE-INDICATOR CTRL: * 0 = ON -- SUSPEND, IF APPROPR. * NZ = OFF -- DON'T SUSPEND ON ERR. REF STATEPTR PTS AT TOP STATE-ENTRY. REF GOSTATE PTS AT GO-STATE ENTRY. REF BRNVAL ERR-CTRL BRANCH VALUE (OR NEGATIVE). REF MODE EXECUTION MODE: * -1 = FORCED CLOSE OF FUN DEFN. * 0 = FUN DEFN. * 1 = DIRECT INPUT. * 2 = EVAL-INPUT OR EXECUTE-OPER. REF OLDMODE MODE WHEN FUN DEFN MODE BEGAN. REF IOERCODE I/O ERROR CODE,SUBCODE,DCB ADDR WD. REF ON%OFF ON OR OFF-LINE RUN FLAG. REF BSPFLAG BACKSPACE FLAG FOR TERMINAL TYPE. REF ERRORCHR ERROR MARKER CHAR FOR TERMINAL TYPE. REF OUTRANST OUTPUT TRANSLATION TBL FOR TERMINAL. REF OBSAVE REG.SAVE AREA DURING AN OBSERVATION. REF SAVE14 LINKAGE HOLDER. REF F:WS DCB FOR WS FILE ACTIVITIES. REF BREAKFLG BREAK FLAG: <0 IF HANG-UP, * =0 IF NO BREAK DETECTED, * >0 IF BREAK DETECTED. REF CURRCS PTR TO CURRENT CODESTRING, IF ANY. REF OFFSET OFFSET. REF WHATERR DATA CONCERNING EXECUTION ERROR. REF IMAGE IMAGE BUFFER. REF HICOL INDICATES HIGH COLUMN IN IMAGE. REF IMAGEPOS POSITION INDICATOR FOR IMAGE BUFFER. REF INBUF INPUT OR OUTPUT BUFFER. REF ERRCOL COLUMN INDICATOR FOR ERROR. REF WSIDNAME WS I.D. NAME (TEXTC). REF RESULT PTR TO RESULT DATA BLK. REF STRAYS STRAY DATA BLK PTRS. REF SYMT PTS AT SYMBOL TABLE. * REFS TO CONSTANTS: REF BLANKS BLANK DBLWD. REF HEXTBL TBL OF EBCDIC CHARS FOR HEX DIGITS. * REFS TO EQU'S: REF NSTRAYS NO.OF NORMAL EXECUTION STRAYS. REF DWSIZIM DBLWD SIZE OF IMAGE. * INTERNAL ERROR I.D.'S FOR: REF IDLSCAN LINESCAN ERR REF IDDEFN DEFN ERR REF IDNOTSAV NOT SAVED, THIS WS IS ... REF IDSIDAM SI DAMAGE REF IDNERASE ... NOT ERASED REF IDNOTCPY ... NOT COPIED REF IDNOTFND ... NOT FOUND REF IDXEQERR ERR DURING AN 'EXECUTE' OPERATION. * * STANDARD EQU'S * REGISTERS R0 EQU 0 R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 * * OTHER EQU'S * CATQ EQU 7 QUAD-STATE CATEGORY. CATF EQU 10 FUNCTION-STATE CATEGORY. EFLAG EQU X'10000' MARKS 'EXECUTE' TYPE OF Q-ENTRY. TYPETEXT EQU 2 DATA BLK TYPE = TEXT. TYPEINTG EQU 3 DATA BLK TYPE = INTEGER. FNOFF EQU 5 FUN.DESCR. OFFSET TO FUN.NAME PTR. XSIZOFF EQU 2 FUN.DESCR. OFFSET TO XSIZE WD. PENDFLAG EQU X'8000' MARKS PENDENT STATES. LOCKFLAG EQU X'10000' MARKS LOCKED FUNCTIONS. IDLE EQU X'16' IDLE CHARACTER. * * CONSTANTS * PENDFUN DATA X'A008000' PENDENT FUNCTION STATE BITS. PAGE * * ERROR MESSAGES: * M%SYNTAX TEXTC 'SYNTAX ERR' M%UNDEF TEXTC 'UNDEFINED' M%NORES TEXTC 'NO RESULT' M%IOERR TEXTC 'I/O ERR ' M%DOMAIN TEXTC 'DOMAIN ERR' M%RANK TEXTC 'RANK ERR' M%LENGTH TEXTC 'LENGTH ERR' M%WSFULL TEXTC 'WS FULL' M%SINGMX TEXTC 'SING. MATRIX' M%FMTSYN TEXTC 'FORMAT SYNTAX ERR' M%INDEX TEXTC 'INDEX ERR' M%BADCH TEXTC 'BAD CHAR' M%TRUNC TEXTC 'TRUNCATED INPUT' M%OPENQT TEXTC 'OPEN QUOTE' M%SYMFUL TEXTC 'SYM TBL FULL' M%LSCAN TEXTC 'LINESCAN ERR' M%DEFN TEXTC 'DEFN ERR' M%SIDAM TEXTC 'SI DAMAGE' M%BADCMD TEXTC 'BAD COMMAND' M%NOTGRP TEXTC 'NOT GROUPED' M%2BIGLD TEXTC 'TOO BIG TO LOAD' M%FILREF TEXTC 'BAD FILE REF' M%FILBSY TEXTC 'FILE IN USE' M%WSNOTF TEXTC 'WS NOT FOUND' M%NOTSAV TEXTC 'NOT SAVED, THIS WS IS ' M%NERASE TEXTC ' NOT ERASED' M%NOTCPY TEXTC ' NOT COPIED' M%NOTFND TEXTC ' NOT FOUND' M%TOOBIG TEXTC 'TOO BIG' M%2NAMEY TEXTC 'TOO MANY SYMBOLS' M%FILSPC TEXTC 'FILE SPACE TOO LOW' M%TERMAL TEXTC 'WRONG TERMINAL' M%FILNAM TEXTC 'FILE NAME ERR' M%NOTAPL TEXTC 'NOT APL FILE' M%FTFULL TEXTC 'FILE TBL FULL' M%FILACC TEXTC 'FILE ACCESS ERR' M%FILTIE TEXTC 'FILE TIE ERR' M%NOPACK TEXTC 'PRIVATE PACK UNAVAIL, CALL OPR.' M%FILIDX TEXTC 'FILE INDEX ERR' M%FILDAM TEXTC 'FILE DAMAGE' M%FIOERR TEXTC 'FILE I/O ERR ' PAGE IDMSGTBL EQU %+1 ERROR I.D. VS MESSAGE LOCATION: DATA 0 -1 BREAK (NO MESSAGE) DATA M%SYNTAX 0 LINESCAN ERR = SYNTAX ERR DATA M%SYNTAX 1 SYNTAX ERR DATA M%UNDEF 2 UNDEFINED DATA M%NORES 3 NO RESULT DATA -M%IOERR 4 I/O ERR .... DATA M%DOMAIN 5 DOMAIN ERR DATA M%RANK 6 RANK ERR DATA M%LENGTH 7 LENGTH ERR DATA M%WSFULL 8 WS FULL DATA M%SINGMX 9 SING. MATRIX DATA M%FMTSYN 10 FORMAT SYNTAX ERR DATA M%INDEX 11 INDEX ERR DATA 0 12 XEQ ERR (NO MESSAGE) DATA M%BADCH 13 BAD CHAR DATA M%TRUNC 14 TRUNCATED INPUT DATA M%OPENQT 15 OPEN QUOTE DATA M%SYMFUL 16 SYM TBL FULL DATA M%LSCAN 17 LINESCAN ERR DATA M%DEFN 18 DEFN ERR DATA M%SIDAM 19 SI DAMAGE DATA M%BADCMD 20 BAD COMMAND DATA M%NOTGRP 21 NOT GROUPED DATA M%2BIGLD 22 TOO BIG TO LOAD DATA M%FILREF 23 BAD FILE REF DATA M%FILBSY 24 FILE IN USE DATA M%WSNOTF 25 WS NOT FOUND DATA M%NOTSAV 26 NOT SAVED, THIS WS IS ... DATA M%NERASE 27 ... NOT ERASED DATA M%NOTCPY 28 ... NOT COPIED DATA M%NOTFND 29 ... NOT FOUND DATA M%TOOBIG 30 TOO BIG DATA M%2NAMEY 31 TOO MANY SYMBOLS DATA M%FILSPC 32 FILE SPACE TOO LOW DATA M%TERMAL 33 WRONG TERMINAL DATA M%FILNAM 34 FILE NAME ERR DATA M%NOTAPL 35 NOT APL FILE DATA M%FTFULL 36 FILE TBL FULL DATA M%FILACC 37 FILE ACCESS ERR DATA M%FILTIE 38 FILE TIE ERR DATA M%NOPACK 39 PRIVATE PACK UNAVAIL, CALL OPR. DATA M%FILIDX 40 FILE INDEX ERR DATA M%FILDAM 41 FILE DAMAGE DATA -M%FIOERR 42 FILE I/O ERR .... PAGE ERRO#TBL EQU %+1 ERROR I.D. VS ERROR NUMBER TABLE: DATA 100 -1 BREAK DATA,1 2 0 LINESCAN ERR (SYNTAX ERR ASSUMED) DATA,1 2 1 SYNTAX ERR DATA,1 3 2 UNDEFINED DATA,1 8 3 NO RESULT DATA,1 30 4 I/O ERR DATA,1 4 5 DOMAIN ERR DATA,1 5 6 RANK ERR DATA,1 6 7 LENGTH ERR DATA,1 1 8 WS FULL DATA,1 15 9 SINGULAR MATRIX DATA,1 16 10 FORMAT SYNTAX ERR DATA,1 7 11 INDEX ERR DATA,1 0 12 XEQ ERR DATA,1 20 13 BAD CHAR DATA,1 22 14 TRUNCATED INPUT DATA,1 23 15 OPEN QUOTE DATA,1 9 16 SYM TBL FULL DATA,1 21 17 LINESCAN ERR DATA,1 35 18 DEFN ERR DATA,1 36 19 SI DAMAGE DATA,1 40 20 BAD COMMAND DATA,1 51 21 NOT GROUPED DATA,1 45 22 TOO BIG TO LOAD DATA,1 43 23 BAD FILE REF DATA,1 42 24 FILE IN USE DATA,1 44 25 WS NOT FOUND DATA,1 41 26 NOT SAVED, THIS WS IS ... DATA,1 50 27 ... NOT ERASED DATA,1 48 28 ... NOT COPIED DATA,1 49 29 ... NOT FOUND DATA,1 46 30 TOO BIG DATA,1 47 31 TOO MANY SYMBOLS DATA,1 70 32 FILE SPACE TOO LOW DATA,1 31 33 WRONG TERMINAL DATA,1 73 34 FILE NAME ERR DATA,1 74 35 NOT APL FILE DATA,1 75 36 FILE TBL FULL DATA,1 76 37 FILE ACCESS ERR DATA,1 77 38 FILE TIE ERR DATA,1 78 39 PRIVATE PACK UNAVAIL, CALL OPR. DATA,1 79 40 FILE INDEX ERR DATA,1 72 41 FILE DAMAGE DATA,1 71 42 FILE I/O ERR .... SPACE 2 BOUND 4 PAGE ************************************************************************ * * * DSTRAYS -- DEREFERENCES THE NORMAL STRAY DATA BLK PTRS ASSOCIATED * * WITH EXECUTION. * * REGS: R14 LINK, EXIT VIA *R14 * * R4,R5,R7 ARE VOLATILE. * * * DSTRAYS LI,R5 NSTRAYS = NO.OF NORMAL EXEC. STRAYS. DSTRAY LI,R4 0 XW,R4 STRAYS-1,R5 BAL,R7 MAYDREF DEREFERENCE, IF NON-ZERO PTR. BDR,R5 DSTRAY B *R14 EXIT. PAGE ************************************************************************ * * * ECTEST -- ERROR CONTROL TESTER. * * * * IDECTEST -- ALT.ENTRY PT. ENTERED WITH THE ERROR I.D. IN R8. THIS * * IS SAVED IN ERRORID & R8 IS GIVEN THE ERROR NUMBER. * * * * REGS: R8 (ENTRY) CONTAINS THE ERROR NUMBER (BYTE SIZE). * * R7 LINK -- EXIT 0,R7 IF CONTROLLED, BRNVAL SET MAX.OF * * ERR-CTRL LINE NO. VALUE OR ZERO. * * EXIT 1,R7 IF UNCONTROLLED, BRNVAL SET NEG. * * ALL REGS. PRESERVED. * * * IDECTEST STW,R8 ERRORID SAVE ERROR I.D. STW,R7 ERRLOC SAVE R7. LW,R7 ERRORID LB,R8 ERRO#TBL,R7 GET ERROR NUMBER. LW,R7 ERRLOC RESTORE R7. ECTEST LCI 8 SAVE R1-R6, USE R7 TO 'CLEAR' ERRLOC STM,R1 EREGS AND PUT R8 IN ERRNUM. LW,R1 STATEPTR PT AT TOP STATE ENTRY. LI,R2 EFLAG SET FOR 'EXECUTE' STATE TESTS. B ECTESTS ECTESTNS LI,R6 X'7FFF' PT AT THE NEXT STATE ENTRY. AND,R6 0,R1 AW,R1 R6 ECTESTS CW,R2 0,R1 TEST FOR 'EXECUTE'... BANZ ECTESTNS YES, TRY AGAIN. LI,R3 X'F8000' AND,R3 0,R1 CW,R3 PENDFUN TEST FOR PENDENT FUNCTION... BE ECTESTPF YES. STW,R1 GOSTATE NO, SAVE PTR TO SUSP. OR EVAL-INP. LI,R2 -1 STW,R2 BRNVAL SET BRNVAL NEG. = UNCONTROLLED ERROR LCI 6 LM,R1 EREGS RESTORE USED REGS. B 1,R7 EXIT (UNCONTROLLED). ECTESTPF LW,R5 1,R1 GET LINE # & FDEFPTR WD. CW,R7 ERRLOC HAS THE ERROR LOC BEEN UPDATED... BNE ECTESTCT YES. LI,R4 X'E0000' NO, SET IT NOW -- AND,R4 1,R1 CURRLINO & AW,R4 FNOFF,R5 FUNCTION NAME PTR. STW,R4 ERRLOC ECTESTCT LW,R4 XSIZOFF,R5 DOES PEND FUNC HAVE ERR-CTRL TBL... CI,R4 X'1FFFF' BL ECTESTNS NO, TRY AGAIN. AI,R4 2 YES, PT AT # OF ROWS. LW,R6 0,R4 GET # OF ROWS. ECTESTCR AI,R4 2 PT AT NEXT ROW OF ERR-CTRL TBL. LW,R5 1,R4 GET ERR-CTRL NO... BEZ ECTESTC ZERO -- CONTROL THIS ERROR. CW,R5 ERRNUM NZ, DOES IT MATCH THE ERROR NO... BE ECTESTC YES, CONTROL THIS ERROR. BDR,R6 ECTESTCR NO, LOOP THRU ERR-CTRL TBL... B ECTESTNS NO SCORE, TRY AGAIN. ECTESTC LW,R2 0,R4 GET ERR-CTRL LINE NO. VALUE... BGEZ ECTESTB LI,R2 0 USE ZERO IF THAT VALUE IS NEG. ECTESTB STW,R2 BRNVAL SET BRNVAL = BRANCH VALUE FOR ERROR. STW,R1 GOSTATE SAVE PTR TO ERR-CTRL'D FUN STATE. LCI 6 LM,R1 EREGS RESTORE USED REGS. B 0,R7 EXIT (CONTROLLED). PAGE * * COMMUNICATIONS REGION -- FROM ROOT INTO ERROR MODULE -- VIA R15. * * IT IS INTENDED THAT ALL ENTRIES TO THIS MODULE BE CHANNELED THRU HERE * ENTEREM STW,R7 ELINK SAVE R7 FOR PROCESSES NEEDING THAT. AI,R15 BE-EBALS CALC. COMMUNICATION BRANCH. BE B *R15 @ ENTER APPROPRIATE PROCESS. B ERRN @ B ERRF @ B ERRX @ B CMDERRH @ B IDECTEST @ B CTRL @ B DONTSAVH @ B DERASE @ B DNOTFND @ B DNOTCPY @ B DSIDAM @ B DEFNERRH @ B LSCANERH @ B UNREF @ B ERRSET @ B OBSERVER @ * B FUNDERRH @ FUNDERRH RES 0 @ BAL,R7 IDECTEST @ RECORD ERROR & TEST ERR-CTRL... B *ELINK @ CONTROLLED -- RESUME FUNDEF AWHILE B EIDTEXTC @ UNCONTROLLED -- DISPLAY & RESUME. LSCANERH LI,R5 F:WS RELEASE WS IF OPEN DUE TO ERROR ON BAL,R6 CLOSR AN AUTOCONTINUE CODESTRING ERR. LI,R8 IDLSCAN = ERROR I.D. FOR 'LINESCAN ERR'. BAL,R7 IDECTEST @ RECORD ERROR & TEST ERR-CTRL... B BBADFL @ CONTROLLED -- MUST BE BAD FUN.LINE LW,R7 ERRCOL @ UNCONTROLLED. BAL,R11 GENCARMS DISPLAY MSG WITH AN ERROR MARKER. LW,R7 MODE CK MODE... BLEZ BBADFL FUN.DEFN -- MAY USE BAD FUN.LINE. LW,R10 ON%OFF IF HANG-UP OCCURRED. BEZ BCONTOFF DO LIKE A CONTINUE CMD. LW,R10 BSPFLAG DOES TERMINAL ADMIT BACKSPACING... BEZ CMDEXITM NO, EXIT VIA MODE AS IF A CMD. LW,R3 ERRCOL YES, DISPLAY ACCEPTABLE LI,R12 INPLSCER PORTION OF LINE B DUMPLINP AS A PROMPT. DEFNERRH LI,R8 IDDEFN = ERROR I.D. FOR 'DEFN ERR'. BAL,R7 IDECTEST @ RECORD ERROR & TEST ERR-CTRL... B CMDEXITM @ CONTROLLED -- EXIT VIA MODE. STW,R1 ERRCOL @ UNCONTROLLED. LI,R11 EFLAG WAS THIS AN 'EXECUTED' FUN DEFN... CW,R11 OLDMODE BAZ DEFNERRM NO. LI,R3 -BA(IMAGE) YES, DISPLAY THE OFFENDING LINE. AW,R3 HICOL BAL,R12 EDUMPLIN DEFNERRM LW,R7 ERRCOL LI,R11 CMDEXITO GO TO CMDEXITO AFTER * B GENCARMS @ DISPLAYING ERR MSG & ERROR MARKER. GENCARMS AI,R7 -BA(IMAGE) @ STW,R7 ERRCOL SET ERROR POSITION IN THE LINE. LW,R6 ERRORID LW,R6 IDMSGTBL,R6 GET LOC OF (TEXTC) ERR MSG. LB,R8 *R6 GET BYTE COUNT OF ERR MSG. LW,R10 R8 SAVE BYTE COUNT FOR LOOP AI,R8 1 ADD 1 TO ERR MSG SIZE FOR FITTING. SLS,R6 2 AI,R6 1 = BA(ERROR MSG STRING). LI,R5 DWSIZIM LW,R9 BLANKS BLANKIT STD,R9 INBUF-2,R5 BLANK THE OUTPUT BUFFER. BDR,R5 BLANKIT LI,R5 IDLE STB,R5 IMAGE,R7 PUT IDLE IN BAD SPOT IN IMAGE. LB,R5 ERRORCHR LB,R5 OUTRANST,R5 GET TERMINAL'S ERROR MARKER & STB,R5 INBUF,R7 PUT IT IN THE OUTPUT BUFFER. LW,R9 R7 SW,R7 R8 CK IF MESSAGE FITS ON LEFT... BGEZ SETMESS YES AW,R7 R8 NO, MOVE TO RIGHT OF MARKER. AI,R7 2 AW,R9 R8 ADJUST SIZE. SETMESS LB,R5 0,R6 LB,R5 OUTRANST,R5 TRANSLATE BYTE TO OUTPUT FORM STB,R5 INBUF,R7 AND PUT IN INBUF AI,R6 1 AI,R7 1 BDR,R10 SETMESS LOOP LI,R8 INBUF AI,R9 1 SIZE. LW,R7 R11 EXIT FROM GENCARMS AFTER B EWROUTWB DISPLAYING THE DIAGNOSTIC. DONTSAVH LI,R8 IDNOTSAV = ERROR I.D. FOR 'NOT SAVED, ETC.'. BAL,R7 IDECTEST @ RECORD ERROR & TEST ERR-CTRL... B CTRL @ CONTROLLED. LW,R7 ERRORID @ UNCONTROLLED. LW,R8 IDMSGTBL,R7 GET LOC OF (TEXTC) ERR MSG. LI,R3 0 INIT. CHAR POSITION. BAL,R13 TEXTC2I MOVE ERR MSG INTO IMAGE BUFFER. LI,R8 WSIDNAME PT AT (TEXTC) WS I.D. BAL,R13 TEXTC2I APPEND THAT TO ERR MSG IN IMAGE. LI,R12 CMDEXITO GO TO CMDEXITO AFTER B EDUMPLIG DISPLAYING THE DIAGNOSTIC. CMDERRH BAL,R7 IDECTEST @ RECORD ERROR & TEST ERR-CTRL... B CTRL @ CONTROLLED. EIDTEXTC LW,R7 ERRORID @ UNCONTROLLED, GET ERROR I.D. AGAIN MSGTEXTC LW,R8 IDMSGTBL,R7 GET LOC OF (TEXTC) ERR MSG. LW,R7 ELINK EXIT AFTER * B WRTEXTCQ @ DISPLAYING THE ERR MSG. WRTEXTCQ AI,R8 0 @ IS R8 POSITIVE... BGZ EWRTEXTC YES, NORMAL MSG. LCW,R8 R8 NO, I/O OR FILE I/O ERR MSG. LI,R3 0 INIT. CHAR POSITION. BAL,R13 TEXTC2I MOVE ERR MSG INTO IMAGE BUFFER. LW,R12 R7 PUT LINK IN R12 SO EDUMPLIG IS EXIT. LI,R14 WRTEXTCX EXIT FROM 'HEXIO' TO 'WRTEXTCX'. HEXIO LW,R7 IOERCODE GET I/O ERR CODE & SUBCODE. SLD,R6 8 MOVE CODE OVER. SLS,R7 -1 RIGHT-JUSTIFY SUBCODE. SLD,R6 -8 MOVE CODE BACK. LI,R11 4 PRODUCE 4 HEX DIGITS. HEXCHAR LI,R6 0 SLD,R6 4 LB,R6 HEXTBL,R6 GET EBCDIC VERSION OF A HEX DIGIT. B *R14 WRTEXTCX STB,R6 IMAGE,R3 PUT HEX CHAR IN IMAGE. AI,R3 1 PT AT NEXT POS. BDR,R11 HEXCHAR LOOP TILL LAST HEX CHAR PUT. B EDUMPLIG DISPLAY DIAG., LINK IS R12. DSIDAM LI,R8 -IDSIDAM RECORD NEG. ERROR I.D. (DISPLAY NOW, STW,R8 ERRORID TEST ERR-CTRL LATER). LI,R7 IDSIDAM = ERROR I.D. FOR 'SI DAMAGE'. B MSGTEXTC DISPLAY & RESUME PROCESSING. DERASE LI,R8 -IDNERASE RECORD NEG. ERROR I.D. (DISPLAY NOW, STW,R8 ERRORID CK ERR-CTRL LATER)--'NOT ERASED'. LI,R3 0 INIT. CHAR POSITION. LW,R8 R6 GET NAME PTR, I.E. SYMT OFFSET. BAL,R13 GENNAME GEN. NAME INTO IMAGE BUFFER. NAMEGEND LCW,R7 ERRORID GET ERROR I.D. LW,R8 IDMSGTBL,R7 GET LOC OF (TEXTC) ERR MSG. BAL,R13 TEXTC2I APPEND ERR MSG TO NAME IN IMAGE. LW,R12 R14 EXIT AFTER B EDUMPLIG DISPLAYING DIAGNOSTIC. DNOTCPY LI,R8 -IDNOTCPY RECORD NEG. ERROR I.D. (DISPLAY NOW, STW,R8 ERRORID CK ERR-CTRL LATER)--'NOT COPIED'. LI,R3 0 INIT. CHAR POSITION. LW,R8 R1 GET NAME PTR, I.E. SYMT OFFSET. LI,R13 NAMEGEND GO TO NAMEGEND AFTER B GENNAME0 GEN. NAME INTO IMAGE BUFFER. DNOTFND LI,R8 -IDNOTFND RECORD NEG. ERROR I.D. (DISPLAY NOW, STW,R8 ERRORID CK ERR-CTRL LATER)--'NOT FOUND'. LI,R8 ' ' NAME IS IN IMAGE BUFFER WITH A LI,R3 -1 TRAILING BLANK. DNOTFND1 AI,R3 1 FIND THE CHAR POSITION CB,R8 IMAGE,R3 OF THAT BLANK. BNE DNOTFND1 B NAMEGEND PAGE ************************************************************************ * * * ERRSET IS ENTERED VIA SETERR IN THE INTRINS MODULE. IT HANDLES THE * * END ACTIONS TO BE TAKEN ON AN EXECUTION ERROR. THERE ARE * * REALLY TWO TYPES OF EXECUTION ERRORS -- THE USUAL ONES (E.G. * * DOMAIN, RANK, SYNTAX, ETC.) ASSOCIATED WITH EXECUTION AND * * COMMAND OR FUNCTION DEFINITION ERRORS RESULTING VIA AN * * EXECUTE-OPERATOR (THESE ARE CALLED XEQ ERRORS). IN THE XEQ * * ERROR CASE, ERROR-CONTROL HAS ALREADY BEEN TESTED. * * * ERRSET STW,R2 ERRORID SAVE EXECUTION-ERROR I.D. VALUE. LB,R8 ERRO#TBL,R2 GET ERROR NUMBER... BNEZ TESTCTRL USUAL TYPE. LW,R8 BRNVAL XEQ ERR, IS IT A CONTROLLED ERR... BGEZ CTRL YES. B UNCTRL NO. TESTCTRL BAL,R7 ECTEST @ TEST ERROR CONTROL... B CTRL @ CONTROLLED ERROR. UNCTRL LB,R4 *STATEPTR @ UNCONTROLLED ERROR. STB,R4 WHATERR SAVE F OR Q STATE CATEGORY... AI,R4 -CATQ BNEZ ERRFSTAT F -- FUNCTION OR FINAL STATE. LI,R4 EFLAG Q -- EVAL-INPUT OR EXECUTE... CW,R4 *STATEPTR BAZ ERRS EVAL-INPUT STATE. LW,R4 CURRCS EXECUTE STATE. BNEZ ERRXEQCS CODESTRING IS AVAILABLE FOR ERR DIAG LW,R4 STATEPTR CODESTRING NOT YET AVAILABLE. LI,R3 X'1FFFF' AND,R3 1,R4 PT AT CODESTRING CONTAINING THIS STW,R3 CURRCS EXECUTE-OPERATOR. MTW,1 -1,R3 BUMP REF-COUNT OF CODESTRING DATABLK LW,R3 1,R4 SLS,R3 -17 RESTORE BYTE OFFSET USED WHEN THIS STW,R3 OFFSET EXECUTE WAS RECOGNIZED. LI,R3 X'7FFF' AND,R3 0,R4 UPDATE TO NEXT STATE ENTRY. AWM,R3 STATEPTR B UNCTRL ERRXEQCS BAL,R14 EXERRLNK HANDLE ERR DIAGNOSTIC & DEREF CURRCS LW,R2 ERRORID WAS IT A BREAK 'MESSAGE'... BLZ UNCTRL YES, RETAIN BREAK I.D. LI,R2 IDXEQERR STW,R2 ERRORID NO, SWITCH TO XEQ ERROR I.D. B UNCTRL ERRFSTAT LI,R4 PENDFLAG IS F-ENTRY PENDENT... CW,R4 *STATEPTR BANZ ERRP YES. STB,R4 WHATERR NO, SET CAT=0 -- DIRECT LINE ERR. B ERRS ERRP LW,R4 ERRORID WAS THIS A BREAK... BLZ ERRSUSP YES, SUSPEND THE FUNCTION. LW,R4 SICTRL TEST STATE INDICATOR CONTROL... BNEZ ERRS OFF -- DON'T SUSPEND THE FUNCTION. ERRSUSP LI,R4 -PENDFLAG-1 ON -- SUSPEND IT. AND,R4 *STATEPTR STW,R4 *STATEPTR LW,R4 STATEPTR MAKE IT THE 'GO' STATE. STW,R4 GOSTATE ERRS BAL,R14 DSTRAYS DEREF ANY EXECUTION STRAYS. LI,R14 EXERR ISSUE LAST ERR DIAGNOSTIC AFTER B SICLR CLEARING THE STATE INDICATOR DOWN * TO THE 'GO' STATE. PAGE ************************************************************************ * * * EXERR -- EXECUTION ERROR DIAGNOSTIC DRIVER. USUALLY DISPLAYS AN * * ERROR MSG & OFFENDING LINE WITH ERROR MARKER. EXITS TO * * INPDIR OR INPEVAL. * * * * EXERRLNK -- ALT. ENTRY PT CALLED FOR 'EXECUTE' OPERATOR ERRORS * * (LINK VIA R14). * * * * ALL REGS SHOULD BE CONSIDERED VOLATILE. * * * EXERRLNK STW,R14 SAVE14 SAVE LINK FOR RETURN VIA UNREF. LW,R7 BREAKFLG CK FOR BREAK OR HANGUP... BNEZ UNREF YES, NO DISPLAY. B EXERR1 NO. EXERR LI,R14 EXERREX SET RETURN FROM UNREF. STW,R14 SAVE14 LCW,R7 BREAKFLG CK FOR BREAK... BGEZ EXERR1 NOT ON OR ELSE HANGUP. AWM,R7 BREAKFLG ON, RESET BREAK FLAG. EXERR1 LW,R7 ERRORID GET ERROR IDENTIFIER. LW,R8 IDMSGTBL,R7 GET ERR MSG LOC... BEZ EXNOMSG NONE (BREAK OR XEQ ERR). BAL,R7 WRTEXTCQ DISPLAY ERR MSG. EXNOMSG LB,R7 WHATERR GET STATE CATEGORY FOR ERROR PT... AI,R7 -CATF BEZ FLINERR FUNCTION LINE. LW,R7 BLANKS DIRECT OR EVAL INPUT LINE OR XEQ. STD,R7 IMAGE BLANK BYTES D-7 OF IMAGE. LI,R3 6 SET FOR COLUMN 7. SETIMPOS STW,R3 IMAGEPOS = START PT FOR DECODE OPS. LW,R7 ERRORID CK FOR BREAK I.D... BGEZ EDECODOP NO, DISPLAY ERR LINE & MARKER. UNREF LW,R7 SAVE14 SET RETURN. CI,R7 OBSLINE+1 WAS THIS AN OBSERVATION... BE 0,R7 YES -- RETURN. LI,R4 0 NO, CLEAR & GET CODESTRING PTR. XW,R4 CURRCS AI,R4 -2 PT AT CODESTRING DATA BLK HEADER. * RETURN IS VIA R7. B DREF DE-REFERENCE THE CODESTRING DATA BLK EXERREX LI,R11 0 STW,R11 ERRORID CLEAR THE ERROR I.D. LW,R11 ON%OFF ON OR OFF-LINE... BEZ BCONTOFF OFF LINE -- DO LIKE CONTINUE CMD. LB,R11 *STATEPTR ON LINE. AI,R11 -CATQ IS EVAL-INPUT THE TOP STATE NOW... BNEZ INPDIR NO -- DO DIRECT INPUT. B INPEVAL YES -- DO EVAL INPUT AGAIN. FLINERR LW,R6 ERRLOC GET CURRLINO (& FUNCTION NAME PTR). LI,R8 X'FFFF' AND,R8 ERRLOC GET FUNCTION NAME PTR. BAL,R14 FUNLDIS% GEN. FUN NAME & LINE NO. LI,R12 UNREF SET EXIT TO UNREF AFTER DISPLAY. LW,R8 ERRORID CK FOR BREAK I.D... BLZ EDUMPLIN YES -- DISPLAY ONLY FUN NAME & LN. LI,R8 LOCKFLAG IS FUNCTION LOCKED... AW,R6 SYMT LW,R6 0,R6 CW,R8 0,R6 BAZ SETIMPOS NO. B EDUMPLIN YES -- DISPLAY ONLY FUN NAME & LN. PAGE * * OBSERVER -- DISPLAYS AN OBSERVATION: LINE & MARKER PLUS A VALUE. * OBSERVER LW,R15 ERRLOC SAVE ERROR LOCATION. LCI 0 SAVE ALL REGS. STM,R0 OBSAVE LI,R2 IDXEQERR CLAIM THIS IS AN 'XEQ ERR' TO AVOID STW,R2 ERRORID DISPLAYING AN ERROR MSG. LB,R4 *STATEPTR STB,R4 WHATERR SAVE F OR Q STATE CATEGORY... AI,R4 -CATQ BEZ OBSLINE Q-STATE. LI,R4 PENDFLAG F-STATE. CW,R4 *STATEPTR PENDENT OR SUSPENDED... BANZ OBSFLINE PENDENT (SHOW FUN.NAME & LN). STB,R4 WHATERR SUSPENDED (DIRECT INPUT LINE). OBSLINE BAL,R14 EXERRLNK @ SHOW LINE & MARKER, DON'T DE-CURRCS. LW,R4 OBSAVE+6 @ PT AT DATA BLK TO BE OBSERVED. BAL,R14 SINGOUT @ DISPLAY THAT VALUE. B %+1 @ SCREW ERROR RETURN. LCI 0 @ NORMAL RETURN. LM,R0 OBSAVE RESTORE ALL REGS. STW,R15 ERRLOC RESTORE ERROR LOCATION. B OBSERVEZ EXIT FROM THIS OBSERVATION. OBSFLINE LW,R4 STATEPTR PT AT THE F-STATE. LI,R14 X'E0000' EXTRACT CURR.LINE NO. AND,R14 1,R4 LW,R4 1,R4 PT AT FUNC.DESCR. AW,R14 FNOFF,R4 INCLUDE FUN.NAME PTR. STW,R14 ERRLOC TEMP. SET ERRLOC. B OBSLINE PAGE CTRL LI,R4 0 CLEAR & TEST CODESTRING PTR... STW,R4 ERRORID (CLEAR THE ERROR I.D.) XW,R4 CURRCS BEZ CTRLS NOT CURRENTLY IN USE. AI,R4 -2 USED, PT AT CODESTRING D.B. HDR. BAL,R7 DREF DEREFERENCE THAT DATA BLOCK. CTRLS BAL,R14 DSTRAYS DEREF ANY EXECUTION STRAYS. BAL,R14 SICLR CLEAR STATE INDIC. DOWN TO 'GO'STATE LCW,R12 BREAKFLG TEST BREAK FLAG... BGEZ ECBRANCH OFF OR HANGUP -- DO ERR-CTRL BRNCH B BCBRANCH ON -- RESET & DO ERR-CTRL BRANCH. ERRN LI,R11 6 BAL,R7 ALOCBLK ALLOCATE 6-WD DATA BLK. STW,R4 RESULT SAVE PTR TO RESULT DATA BLK. LI,R11 (TYPEINTG**8)+1 TYPE = INTEGER & RANK = 1. STH,R11 *RESULT LI,R11 2 LENGTH = 2. STW,R11 2,R4 LW,R11 ERRNUM STW,R11 3,R4 SET ERROR NUMBER. LW,R11 ERRLOC SLS,R11 -17 SET ERROR LINE NUMBER (OR ZERO). STW,R11 4,R4 B NIRETURN RETURN FROM NILADIC INTRINSIC. ERRF LI,R12 0 PREPARE FOR EMPTY ERROR LOC. LW,R2 ERRLOC IF FUNC.ERR, GET CURRLINO & NAME PTR CI,R2 X'E0000' IS THERE A CURRENT LINE NO... BAZ EFNALOC NO -- USE EMPTY FUNCTION NAME. AI,R2 1 = OFFSET TO FUN'S NAME INDIC. WD. LW,R3 *SYMT,R2 GET NAME INDICATOR WD. LB,R12 R3 GET # WDS FOR THAT NAME (UNLESS IT CI,R12 20 IS A SHORT NAME). BLE EFNALOC LONG NAME. LI,R12 1 SHORT NAME, 1 WD IN R3 ALREADY. EFNALOC LW,R11 R12 = NO.OF WDS FOR FUNCTION NAME. AI,R11 1 ADD 1 FOR THE VECTOR LENGTH WD. BAL,R7 ALOCHNW ALLOC DATA BLK, INCLUDING HEADER. STW,R4 RESULT SAVE PTR TO RESULT DATA BLK. LI,R11 (TYPETEXT**8)+1 TYPE = TEXT & RANK = 1. STH,R11 *RESULT AI,R4 2 PT AT LENGTH WD. LW,R11 R12 GET # WDS FOR NAME... BEZ EFNLEN NONE (EMPTY TEXT VECTOR). CI,R11 1 BE EFNMOV ONE (NAME WD IS ALREADY IN R3). LW,R5 *SYMT,R2 LONG, PT AT 1ST WD OF LONG NAME. EFNGET LW,R3 0,R5 GET NAME WD. AI,R5 1 PT AT NEXT WD OF LONG NAME DATA BLK. EFNMOV AI,R4 1 PT AT NEXT WD OF RESULT. STW,R3 0,R4 STORE NAME WD. BDR,R12 EFNGET LOOP TILL LAST NAME WD STORED. SW,R4 R11 PT AT LENGTH WD AGAIN. SLS,R11 2 = NO.OF BYTES MOVED. EFNBLCK CB,R3 BLANKS CK FOR TRAILING BLANK IN NAME... BNE EFNLEN NO, R11 = # CHARS IN NAME. SLS,R3 -8 YES, DROP THAT BLANK. BDR,R11 EFNBLCK DECR. BYTE COUNT & LOOP. EFNLEN STW,R11 0,R4 SET TEXT VECTOR'S LENGTH. B NIRETURN RETURN FROM NILADIC INTRINSIC. ERRX LI,R11 4 BAL,R7 ALOCBLK ALLOCATE 4-WD DATA BLK. STW,R4 RESULT SAVE PTR TO RESULT DATA BLK. LI,R11 (TYPETEXT**8)+1 TYPE = TEXT & RANK = 1. STH,R11 *RESULT LI,R11 4 LENGTH = 4. STW,R11 2,R4 AI,R4 3 PT AT VALUE WORD. SLS,R4 2 PT AT 1ST VALUE BYTE POS. BAL,R14 HEXIO START GETTING I/O ERR CODE & SUBCODE STB,R6 0,R4 SET VALUE BYTE (EBCDIC HEX DIGIT). AI,R4 1 PT AT NEXT VALUE BYTE. BDR,R11 HEXCHAR LOOP TILL LAST HEX CHAR SET. B NIRETURN RETURN FROM NILADIC INTRINSIC. PAGE ************************************************************************ SPACE 2 Z SET %-ERROR@ SIZE IN HEX. SPACE Z SET Z+Z/10*6+Z/100*96+Z/1000*1536 SIZE IN DECIMAL. SPACE 3 END