         DEF      TELLUSR:
TELLUSR: EQU      %
         SYSTEM   UTS
         CSECT    0
         PCC      0
*****************************************************
*  ROUTINE TO PUT OUT ERROR MESSAGES TO USERS       *
*  WHO INCOUNTER AN ILLEGAL TRAP,                   *
*  WHO ARE ERRORED OR ABORTED BY THE OPERATOR,      *
*  OR WHO ERROR OR ABORT THEMSELVES.  ALSO PUTS     *
*  OUT I/O ERROR MESSAGES IF J:ABC < 80             *
*                                                   *
*  DUMPS "AT" LOCATION, THE PSD FROM TSTACK, THE    *
*  REGISTERS, AND IN THE CASE OF AN I/O ERROR, THE  *
*  DCB ASSOCIATED WITH THE ERROR.                   *
*****************************************************
*        THROUGHOUT THIS ROUTINE:
*        R1 = ADDRESS OF SCRATCH BUFFER
*        R2 = POINTER INTO IT (COUNT OF CHRS IN BUFFER)
*        REGISTERS SAVED IN TSTACK:
*        R0 = RETURN
*        R14 = SAVED RUN STATUS FOR CCI
*        R15 = SAVED BUFFER ADDRESS FOR PMDDMP
*
*
*        REFS AND DEFS
*
         DEF      TELLUSR
         DEF      GETBUF
         REF      M:XX,J:ABC,J:RNST,J:DCBLINK
         REF      J:JIT,ERO
         REF      J:ASSIGN
*
         REF      MSRRDWT
         REF      T:GBUF,SBUF1VPA
         REF      M9
         REF      CLSSEG,OPNSEG,PRINTV
         DEF      CLSXX
*
TELLUSR  EQU      %
         PSW,0    TSTACK          SAVE RETURN
         LW,14    J:RNST            SAVE RUN STATUS
         PSW,14   TSTACK          AND RNST
         LI,2     0               ZERO RNST FOR CALPROC
         STB,2    J:RNST          FOR CALPROC
         BAL,5    CLSXX             CLOSE DCB IF OPEN
CLOSED   BAL,8    GETBUF
         LB,4     *TSTACK           GET RNST
         PSW,1    TSTACK
         LI,3     8               COUNTER FOR SCANNING J:RNST
         BAL,0    SETBUF            SET VFC CHAR IN BUFFER
SCAN     CI,4     1               BIT SET
         BANZ     CVEC,3          YES, GO TO ITS ROUTINE
         SLS,4    -1              NO, GET THE NEXT
         BDR,3    SCAN            AND TRY AGAIN
CVEC     B        RETURN
         B        MSGOUT          M:ERR CAL
         B        MSGOUT          M:XX CAL
         B        MSGOUT          ERRORED BY OPERATOR
         B        MSGOUT          ABORTED BY OPERATOR
         B        CHKPT
         B        MAXMSG
         B        IOERR           I/O ERROR OF SOME KIND
         B        ILLEGALTRAP
         PAGE
*
*
*        COMMON USAGE OF REGISTERS IN THIS ROUTINE:
*        R5 = INDEX TO A MESSAGE (FROM GETWHO)
*        R1 = BUFFER ADDRESS OF BLOCKING BUFFER
*        R2 = INDEX INTO THE BUFFER
*        R6 = MESSAGE ADDRESS
*
MSGOUT   EQU      %
         LW,6     MSGS,3          GET MESSAGE ADDRESS
         BAL,0    FORM            FORM THE MESSAGE
*
*
         CI,3     2               IS IT BY THE OPERATOR
         BG       OP              YES, CONTINUE
         BAL,0    GETWHO          GET THE GUILTY PARTY
         LW,6     MSGS1,5         TELL WHO DID IT
         BEZ      %+2             IF FLAG WAS MEANINGLESS
         BAL,0    FORM            FORM THE MESSAGE
*
*
OP       EQU      %
         LI,3     '1'               SET NEW VFC CHAR IN BUFFER
         STB,3    *1                TO SKIP TO TOF
         BAL,0    AT              TELL HIM WHERE IT HAPPENED
         BAL,12   WRTXX             WRITE THE MESSAGE
         B        RETURN          DONE
          PAGE
*
*        RETURNS AN INDEX TO MSGS1 IN R5
*        TO GIVE THE "BY XXXX" MESSAGE
*
GETWHO   EQU      %
         LW,3     J:RNST
         SLS,3    -17
         LI,5     5               5 RUN FLAGS
TRY      CI,3     1               PICK OFF THE GUILTY ONE
         BANZ     *0              GOT HIM, RETURN
         SLS,3    -1              GET THE NEXT BIT
         BDR,5    TRY             TRY AGAIN
         B        *0              GOT NONE
*
*        8 = COUNT IN MESSAGE
*        2 = PTR INTO BUFFER
*        1 = BUFFER ADDRESS
*        6 = MSG ADDRESS
*
*        DESTROYS 4,5,8
FORM     EQU      %
         LB,8     *6              GET THE COUNT
         LI,5     1
STORE    LB,4     *6,5            TRANSFER THE MESSAGE
         STB,4    *1,2
         AI,2     1               BUMP THE POINTER
         AI,5     1               BUMP THE MSG POINTER
         CW,5     8               FINISHED THE MESSAGE
         BLE      STORE           NOT YET, CONTINUE
         B        *0
*
*
*
*
*
MSGS     EQU      %-1
         DATA     JERR
         DATA     JAB
         DATA     JOERR
         DATA     JAERR
*
*
MSGS1    DATA     BYMON
         DATA     BYPROC
         DATA     BYUSR
         DATA     BYLOAD
         DATA     0
         DATA     0
*
*
JERR     TEXTC    '    JOB ERRORED '
JAB      TEXTC    '    JOB ABORTED '
JOERR    TEXTC    '    JOB ERRORED BY OPERATOR '
JAERR    TEXTC    '    JOB ABORTED BY OPERATOR '
BYMON    TEXTC    'BY MONITOR '
BYLOAD   TEXTC    'BY LOADER '
BYUSR    TEXTC    'BY USER '
BYPROC   TEXTC    'BY PROCESSOR '
*
*
TXTAT    TEXTC    'AT '
*
SPACES   TEXTC    '    '
*
OPNERR   EQU      %
OPNABN   EQU      %
         B        *8              THE OPEN CAL
*
WERR     EQU      %
WABN     EQU      %
         B        RETURN
*
XXTODO   EQU      %
         DATA     X'C0040000'
         DATA     OPNERR
         DATA     OPNABN
         DATA,1   0,0,'D','O'
*
CLOSEXX  EQU      %
         DEF      CLOSEXX
         DATA     X'80000000'
         DATA     2               SAVE THE FILE
*
*
ADDRMASK DATA     X'1FFFF'
*
*
*
Y003E    DATA     X'003E0000'
         PAGE
*
*        ROUTINE TO PUT OUT THE "AT" MESSAGE,
*        TAKING THE LOCATION FROM THE PSD IN
*        TSTACK
*
*        DESTROYS  5,6,7,11
AT       EQU      %
         LI,11    X'1FFFF'        ADDRESS MASK
         LS,11    TSTACK+2        GET THE ADDRESS
AT11     EQU      %               ENTRY FOR MSG - AT 11 -
         PSW,0    TSTACK          SAVE RETURN
         LI,6     TXTAT
         BAL,0    FORM            PUT IN AT
         LI,7     0               SKIP ZEROS
         LW,5     11              IN THE ADDRESS
         BAL,0    TRANS
         PLW,0    TSTACK          RESTORE RETURN
         B        *0
*
*        R5 = WORD IN HEX TO BE TRANSLATED TO EBCDIC
*        R7 = 0 => SUPPRESS LEADING ZEROS, = 1 => PUT THEM IN
*        ASSUMES R1 = BUF, 2 = PTR INTO IT
*        DESTROYS 4,5,6,7,8
*
*
TRANS    EQU      %
         LI,8     8               COUNTER FOR HEX CONVERSION
TLOOP    LI,4     0
         SCD,4    4               GET 4 BITS
         MTW,0    4               IIS IT ZERO?
         BNEZ     TLOAD           NO, PACK IT IN
         B        %+1,7
         BDR,8    TLOOP+1         SUPPRESS ZEROS
TLOAD    LI,7     1               TURN OFF THE FLAG
         LB,6     LIST,4          PICK UP THE EBXDIC
         STB,6    *1,2            AND PUT IT AWAY
         AI,2     1               BUMP THE COUNTER
         BDR,8    TLOOP           GET THE FULL WORD
         B        *0              YES, QUIT
*
LIST     TEXT     '0123456789ABCDEF'
         PAGE
*
*
*        ROUTINE TO HANDLE THE I/O ERRORS
*
CALMASK  DATA     X'7F000000'
CAL      CAL1,1   0
Y8       DATA     X'80000000'
Y4       DATA     X'40000000'
X7F      DATA     X'7F'
XMASK    DATA     X'E0000'
*
*
IOERR    EQU      %
         LB,12    J:ABC           GET THE ABORT CODE
         CI,12    X'80'           IS IT > 80
         BG       RETURN1         YES, DON'T HANDLE THIS MSG
         BAL,0    WRITERR         WRITE OUT THE ERROR
         LI,6     SPACES          PRECEED THIS AT WITH 4 SPACES
         BAL,0    FORM
         BAL,0    AT              TELL HIM WHERE
         BAL,5    OPNXX             OPEN M:XX TO DO DEVICE
         BAL,12   WRTXX             WRITE THE RECORD
         BAL,0    SETBUF            SET VFC CHAR IN BUFFER
         LI,3     X'1FFFF'
         LS,3     TSTACK+2        GET THE PSD ADDRESS
*
*        IN: R3 = ADDRESS FROM THE PSD IN THE TSTACK
*        OUT:  R4 = CAL INSTRUCTION IF FOUND, OTHERWISE EXIT TO NOCALEP
*
GETCAL   EQU      %
         CW,3     X'F'            IN A REGISTER
         BG       %+2             NO
         AI,3     TSTACK+5        YES, GET THE RIGHT LOCATION
         LI,6     2                 DO IT TWICE
         AI,3     -1
GETCAL1  LW,4     *3
         LB,5     4                 GET THE OP CODE
         AND,5    X7F               WITHOUT THE INDIRECT BIT
         CI,5     X'4'
         BE       GOTCAL          YES, GOT IT
         CI,5     X'67'             IS IT AN EXU
         BE       GETEXU          YES, TRACE IT OUT
         AI,3     1
         BDR,6    GETCAL1         BUT ONLY TRY ONCE
         B        RETURN            THEN GIVE UP
*
*
GETEXU   EQU      %
         LB,5     4               GET THE OP CODE AGAIN
         CI,5     X'80'
         BAZ      GETEXU1         NO
         LI,5     X'1FFFF'        ADDRESS MASK
         LS,4     *4              GET THE ADDRESS
         CI,4     X'F'
         BG       %+2             NO
         AI,4     TSTACK+5        YES, CREATE PROPER DISPLACEMENT
GETEXU1  LI,3     X'1FFFF'        ADDRESS MASK
         LS,3     4               GET THE ADDRESS INTO 3
         B        GETCAL          AND TRY AGAIN
*
GOTCAL   EQU      %
IOC      LI,3     X'1FFFF'
         LS,3     4               GET THE FPT ADDRESS
         CW,4     Y8              WAS IT INDIRECT?
         BAZ      FPT             NO, CONTINUE
         CI,3     X'F'            YES, WAS IT TO A REGISTER?
         BG       INDR            NO, CONTINUE
         LW,3     TSTACK+5,3      GET THE ADDRESS FROM REGISTER
INDR     CI,3     X'F'            IS IT IN A REGISTER
         BG       %+2             NO, CONTINUE
         AI,3     TSTACK+5          YES, GET IT
FPT      EQU      %
         LW,7     XMASK             SEE IF IT WAS INDEXED
         CW,4     7
         BAZ      NOINDEX
         LS,6     4
         SLS,6    -17               GET THE REGISTER
         LW,6     TSTACK+5,6
         AW,3     6                 INDEX
NOINDEX  EQU      %
         CI,3     X'F'              IN A REGISTER
         BG       %+2               NO
         AI,3     TSTACK+5          YES, POINT TO THE RIGHT PLACE
         LW,3     *3
         CW,3     Y8              IS  IT INDIRECT?
         BAZ      NOINDR          NO, CONTINUE
         LI,5     X'1FFFF'
         LS,5     3               GET THE ADDRESS
         CI,5     X'F'            A REGISTER?
         BG       %+2             NO, CONTINUE
         AI,5     TSTACK+5
         LW,3     *5
NOINDR   AND,3    ADDRMASK        GET IT AS AN ADDRESS ONLY
         LI,4     J:DCBLINK
DCBLOOP  LB,5     *4
         BEZ      NXTCHN          NO COUNT, GET LINK
         AI,5     4               SKIP THE NAME
         SLS,5    -2
         AW,5     4
         CW,3     *5              IS IT OUR DCB?
         BE       FOUND           YES, SUCCESS
         AI,5     1               NEXT NAME
         LW,4     5
         B        DCBLOOP
*
*
NXTCHN   LW,4     *4              IS IT A LINK?
         BEZ      NODCB           NO, CONTINUE
         AI,4     1               YES, BUMP PAST LINK
         B        DCBLOOP
*
*
*        3 = ADDRESS OF DCB
*        4 = ADDRESS OF ITS NAME
*
FOUND    EQU      %
         LW,7     4               SAVE THE DCB NAME LOCATION
         LI,6     ONDCBMSG
         BAL,0    FORM            TELL HIM WHICH DCB DID IT
         LW,6     7               PRINT THE DCB NAME
         BAL,0    FORM
         BAL,12   WRTXX             WRITE THE RECORD
         B        RETURN
*
*
NODCB    LI,6     NODCBMSG        PUT OUT THE MSG
         BAL,0    FORM
         LW,11    3               AND TELL HIM THE DCB ADDR
         BAL,0    AT11
         BAL,12   WRTXX             WRITE THE RECORD
         B        RETURN            AND GET OUT
*
*
NODCBMSG TEXTC    '    NON-EXISTENT DCB ADDRESS '
ONDCBMSG TEXTC    '    ON DCB '
         PAGE
*
*        ROUTINE TO READ THE ERRMSG FILE AND
*        PRINT THE APPROPRIATE MESSAGE TO THE
*        USER
*
GETBUF   LI,5     J:JIT           GET THE JIT IN 5
         LI,14    SBUF1VPA          GET SPEC BUFFER
         PSW,8    TSTACK
         BAL,2    T:GBUF
         PLW,8    TSTACK
         LW,1     14                BUFFER ADDRESS
         AI,10    0                 GET THE BUFFER
         BNEZ     *8              YES
NOBUF    EQU      %
         LC       8
         BCS,4    *8
         LI,15    0                 SET NO BUFFER GOTTEN FLAG
         B        RETURN2
         PAGE
*
*
*        MAIN ROUTINE   BUFFER IS IN R1
*
WRITERR  EQU      %
*
         LB,12    J:ABC
         BEZ      *0
         LCI      7
         PSM,0    TSTACK
         LW,15    1
         LCI      15
         LM,0     OPEN              GET OPEN FPT
         STM,0    *15
         LI,5     J:JIT             SET UP FOR ENTRY TO MSROPN
         LI,6     M:XX
         LW,7     15
         AI,7     1                 PLIST ADDRESS
         LI,8     X'14'
         LI,2     0
         LI,0     0
         BAL,11   T:OVERLAY         T:OVERLAY
         LCI      7
         PLM,0    TSTACK
         LI,3     M:XX
         LI,4     140
*
*
*        FORM A KEY WITH THE FOLLOWING FORMAT
*          8    8    8       8
*        ---------------------------
*        ' 03 ' 00 ' J:ABC ' J:ERO '
*        ---------------------------
*
         LW,13    J:JIT+ERO       GET WORD OF ERO
         SLS,13   24              GET LEAST SIG 7 BITS
         LB,12    J:ABC
         SLD,12   8               FORM J:ABC-J:ERO-0
         AW,12    =X'03000000'    MAKE IT A KEY
         BAL,11   ERRMSGE         GET THE MESSAGE
         BAL,5    OPNXX             OPEN M:XX TO DO DEVICE
         LW,2     TOFMES
         STW,2    0,1               SET VFC TO TOP OF PAGE
         LW,2     4                 SET RECORD LENGTH
         PUSH     0                 SAVE RETURN
         BAL,12   WRTXX             AND WRITE IT
         B        SETBUF1           AND SET NEW VFC CHAR
         PAGE
*
*
*        ROUTINE TO READ THE ERR FILE:
* INITIAL CONDITIONS:
*        R2 = DCB ADDRESS
*        R3 = BUFFER ADDRESS
*        R4 = BUFFER SIZE
*        11 = RETURN ADDRESS
*        D1 = KEY IN TEXTC FORMAT
*
* RESULTS:
*        R1 = KEY IN TEXTC FORMAT
*        R4 = ACTUAL RECORD SIZE
*        R3 = ADDRESS OF OUTPUT MESSAGE BUFFER
*
* ABNORMAL OR ERROR =>  KEY TRANSLATION
*
*
OPEN     DATA     0
         DATA     X'C7480001'
         DATA     ERRADD
         DATA     ABNADD
         DATA     2,2,1,2,4  KEYED, DIRECT,IN,SAVE,MAX KEY
         DATA     X'01000202'
         TEXTC    'ERRMSG'        FILE NAME
         DATA     X'02010202'
         TEXT     ':SYS '         ACCOUNT
*
*
READ     EQU      %
         DATA     X'78000000'
         PAGE
*
*
ERRMSGE  EQU      %
         LH,5     M:XX              IF M:XX IS NOT OPEN,
         CI,5     X'20'             WE CAN'T READ IT.
         BAZ      KEYCONV
         STW,12   *1              STORE THE KEY
         LW,5     Y4
         STS,5    J:ASSIGN
         LCI      4
         PSM,0    TSTACK
         LCI      2
         PSM,11   TSTACK
         LI,5     J:JIT
         LI,6     M:XX
         LW,7     TSTACK
         LW,8     READ
         LI,9     ABNREAD
         LW,10    1
         AI,10    1                 LEAVE SPACE FOR VFC CHAR
         LW,11    4
         LW,12    1
         LCI      5
         PSM,8    TSTACK
         LI,8     X'10'
         BAL,11   MSRRDWT
         LI,1     -5
         MSP,1    TSTACK
         LCI      2
         PLM,11   TSTACK
         LCI      4
         PLM,0    TSTACK
         CI,10    0
         BNE      KEYCONV           DIDN'T READ, CONVERT THE KEY
         LW,4     13,3              GET ARS
         AI,4     3                 -1 FOR CR, +4 FOR WORD OFFSET
         LW,5     11                SET RETURN ADDRESS
         B        CLSXX             CLOSE THE DCB
*
ABNREAD  EQU      %
ERRADD   EQU      %
ABNADD   EQU      %
         B        *8                JUST PRETEND NOTHING HAPPENED
*
KEYCONV  LI,4     3
         LI,5     6                 6 CHARS TO MAKE
GO       AND,12   =X'00FFFFFF'    MASK TO STRIP BYTE ZERO
         SLS,12   4               SHIFT A HALF BYTE
         LB,2     12              GET THAT BYTE
         LB,2     LIST,2
         STB,2    *1,4            STORE THE EBCDIC
         AI,4     1
         BDR,5    GO
         LW,5     11                SET RETURN ADDRESS
         B        CLSXX             CLOSE THE DCB
         PAGE
*
*        ROUTINE TO PRINT WHO, WHERE, AND WHY OF
*        AN ILLEGAL TRAP
*
MAXMSG   EQU      %
         LI,4     32                DETERMINE WHICH ONE
         INT,3    J:ASSIGN
         AND,3    M9
         SLS,3    1
         BCS,8    %+2
         BDR,4    %-2
         LI,5     X'1FFFF'
         STS,4    J:JIT+ERO
         LI,4     X'B3'
         STB,4    J:ABC
ILLEGALTRAP EQU   %
         BAL,0    GETWHO
         PSW,5    TSTACK
         LI,4     0
         LW,5     Y003E
         STS,4    J:RNST
         BAL,0    WRITERR         GIVE THE MSG FROM ERRMSG
         LI,6     SPACES
         BAL,0    FORM
         PLW,5    TSTACK
         LW,6     MSGS1,5         PICK UP THE MSG
         BEZ      TRAP2           UNLESS IT WAS MEANINGLESS
         BAL,0    FORM
TRAP2    BAL,0    AT
         LI,6     CONTMSG         TELL WHY
         BAL,0    FORM            FORIM IT UP
         LW,5     *TSTACK+2       WHERE WE TRAPPED
         LI,7     1               DON'T SUPPRESS ZEROS
         BAL,0    TRANS
         BAL,12   WRTXX
         B        RETURN            DONE
*
*
CONTMSG  TEXTC    ' WHICH CONTAINS '
*
*
*
*        EXIT ROUTINE
*
RETURN   EQU      %
         LI,1     0
         STB,1    J:ABC           RESET THE ABC
RETURN1  EQU      %
CHKPT    EQU      %
         BAL,5    CLSXX             CLOSE M:XX BEFORE EXIT
         PLW,15   TSTACK          BUFFER
RETURN2  EQU      %
         PLW,14   TSTACK          RNST
         PLW,0    TSTACK          RETURN
         STW,14   J:RNST            RESTORE RNST FOR CCI
         B        *0
*
         PAGE
CLSXX    PUSH     7,15              SAVE VOLITILE REGS
         LH,1     M:XX              IF CLOSED, DON'T CLOSE AGAIN
         CI,1     X'20'
         BAZ      CLSXX1
         LCI      2
         LM,1     CLOSEXX           GET PLIST
         PSM,1    TSTACK            INTO STACK
         LW,7     TSTACK            GET
         AI,7     -1                PLIST POINTER
         LI,6     M:XX              DCB ADDRESS
         LI,8     X'15'             CLOSE CODE
         LI,5     J:JIT
         OVERLAY  CLSSEG,0          CLOSE DCB
         PULL     2,1
CLSXX1   PULL     7,15
         B        0,5
         SPACE    3
OPNXX    PUSH     6,0
         LH,1     M:XX              CLOSE FIRST IF OPEN
         CI,1     X'20'
         BAZ      OPNXX10
         BAL,5    CLSXX
OPNXX10  LW,7     TSTACK
         AI,7     1                 PLIST POINTER
         LCI      4
         LM,1     XXTODO            OPEN PLIST
         PSM,1    TSTACK            TO STACK
         LI,6     M:XX              DCB ADDRESS
         LI,8     X'14'             OPEN CODE
         LI,5     J:JIT
         OVERLAY  OPNSEG,0
         PULL     4,1
         LI,2     X'100'            SET VFC BIT
         LI,3     X'4130'           SET BTD TO ZERO - RESET FBCD BIT
         STS,2    M:XX
         STB,2    M:XX+20           ZAP PAGE HEADER FLAG
         PULL     6,0
         B        0,5
*
WRTXX    LH,14    M:XX              OPEN FIRST IF NOT OPEN
         CI,14    X'20'
         BANZ     WRTXX10
         PUSH     12
         BAL,5    OPNXX
         PULL     12
WRTXX10  LW,14    1                 SET BUFFER ADDRESS
         LW,15    2                 SET BUFFER SIZE
         LI,6     M:XX              SET DCB ADDRESS
         B        PRINTV
*
TOFMES   TEXT     '1   '
*
SETBUF1  PULL     0                 GET RETURN
SETBUF   LI,2     ' '               VFC CHAR
         STB,2    *1                TO BUFFER
         LI,2     1                 BUFFER POINTER
         B        *0
*
         END

