*M* TELLUSR PRINTS REASON FOR JOBSTEP ABORT FOR BATCH & GHOST USERS
         DEF      TELLUSR:          XDELTA LABEL FOR TELLUSR MODULE.
TELLUSR: EQU      %
*P*
*P*      NAME:    TELLUSR
*P*
*P*      PURPOSE: TO PUT OUT ERROR MESSAGES TO USERS WHOSE JOB STEPS
*P*               ARE ABNORMALLY TERMINATED FOR ANY REASON.
*P*  DESCRIPTION: TELLUSR WRITES A MESSAGE THRU M:XX (ASSIGNING IT
*P*               TO THE 'DO' DEVICE) GIVING THE REASON FOR A
*P*               JOBSTEP ABORT:
*P*                 ERRORED/ABORTED BY OPERATOR
*P*                 ERRORED/ABORTED BY THE PROGRAM ITSELF
*P*                 LIMIT EXCEEDED (WHICH-LIMIT MSG FROM ERRMSG FILE)
*P*                 I/O ERROR (WHICH-ERROR MSG FROM ERRMSG FILE)
*P*                           (ALSO TELLS ON WHICH DCB)
*P*                 OTHER ABORT (ABORTCODE MSG FROM ERRMSG FILE)
*P*               IT ALSO PRINTS THE PROGRAM LOCATION WHERE THE
*P*               ABORT OCCURRED.
*P*
BITS     SET      1                 GET DEFINITIONS OF BITS & MASKS.
         SYSTEM   UTS
         PCC      0
         PAGE
         DEF      CLSXX       ENTRY TO CLOSE M:XX DCB
         DEF      TELLUSR     ENTRY TO PRINT THE ABORT-REASON MESSAGE
*
         REF      CLSSEG      = # OF 'CLOSE' MONITOR OVERLAY
         REF      ERO         BITS 24-31 INPUT = ERROR SUBCODE
*,*                           BITS 15-31 OUTPUT WHICH MAX. EXCEEDED
         REF      FINDDO            LOCATE M:DO DCB IN DCB AREA
         REF      HEX         INPUT CHARACTERS '0' - 'F'
         REF      J:ABC       BITS 0-7 INPUT = ERROR CODE
*,*                                    OUTPUT =0 IF MSG PRINTED
         REF      J:ASSIGN    BIT 1 OUTPUT = NO BUFCHK ON M:WRITE
*,*                           BITS 23-31 INPUT = WHICH MAX EXCEEDED
         REF      J:DCBLINK   BITS 15-31 INPUT => USER DCB TABLE
         REF      J:JIT       BASE ADDRESS OF JIT
         REF      M:XX        OUTPUT DCB USED TO GET ERRMSG & PRINT
         REF      MSRRDWT     ROUTINE READS OR WRITES THRU DCB
         REF      OPNSEG      = # OF 'OPEN' MONITOR OVERLAY
         REF      PRINTV      ROUTINE PRINTS LINE GIVEN BUFFER, #CHAR
         PAGE
*        REGISTER EQUATES
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
         PAGE
*D*      NAME:    TELLUSR
*D*
*D*      REGISTERS: R14 PRESERVED ALL OTHERS ZAPPED.
*D*      INTERFACE: MSRRDWT,(OPNSEG,0),(CLSSEG,0)
*D*      ENVIRONMENT: MASTER MAPPED.
*D*      INPUT:   R0 = RETURN ADDRESS.
*D*               R14= ADDRESS OF BUFFER FOR TEMP USAGE.
*D*            *TSTACK= SAVED J:RNST AT USER EXIT TIME.
*D*               (0-7)=EXIT TYPE:  80=TRAP, 40=I/OERR, 20=LIMIT,
*D*                     10=LINEHANGUP, 08=OPABORT, 04=OPERROR,
*D*                     02=M:XXX, 01=M:ERR.
*D*               (10-14)=WHO RUNNING: 002=PROCESSOR, 001=USER,
*D*                       0008=LOADER, 0000=MONITOR.
*D*            J:ASSIGN(23-31)=WHICH LIMIT EXCEEDED: 100=PDISK NET,
*D*                            80=TIME, 40=SCRATCHTAPE, 20=TDISK,
*D*                            10=PDISK, 08=DO,04=UO,02=LO,01=PO.
*D*            J:ABC(0-7)=ERRCODE (TRAP OR I/OERR)
*D*            ERO(24-31)=SUBCODE (TRAP OR I/OERR)
*  THROUGHOUT THIS ROUTINE:
*  R1 = ADDRESS OF SCRATCH BUFFER.
*  R2 = CURRENT BYTE INDEX INTO BUFFER.
*
TELLUSR  EQU      %
         PUSH     R0                  SAVE RETURN ADDRESS.
         PUSH     R14                 SAVE BUFFER ADDRESS.
         BAL,R0   CLSXX               CLOSE M:XX IF OPEN.
         LW,R1    *TSTACK           R1 =>BUFFER.
         LI,R2    1                 R2 = INITIAL BUFFINDEX (1 IN).
         LI,R4    -8
         LB,R4    *TSTACK,R4        R4 = RNST BYTE 0.
         LI,R3    8                 R3 = COUNTER FOR SCANNING RNST.
SCAN     CI,R4    1                   IS IT THIS BIT...
         BANZ     CVEC,R3             ---> YES. GO TO ITS ROUTINE.
CHKPT    SLS,R4   -1                  NO.
         BDR,R3   SCAN                TRY NEXT BIT.
*  EXIT.
RETURN   EQU      %
         LI,R1    0
         STB,R1   J:ABC             RESET J:ABC TO SHOW MSG PRINTED.
RETURN1  EQU      %
         BAL,R0   CLSXX             CLOSE M:XX IF OPENED.
         BAL,R4   FINDDO            CLOSE M:DO IF OPEN
         BEZ      %+2
         BAL,R0   CLSDCB
*
         PULL     R14               RESTORE BUFFER ADDRESS TO R14.
         PULL     R0                RESTORE RETURN ADDRESS.
         B        *R0               ---> EXIT TELLUSR.
*
*
CVEC     EQU      %-1
         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      %
         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,R3    TSTACK
         LW,R3    -2,R3             R3 = SAVED J:RNST WORD.
         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 OR CANCELED '
BYMON    TEXTC    'BY MONITOR '
BYLOAD   TEXTC    'BY LOADER '
BYUSR    TEXTC    'BY USER '
BYPROC   TEXTC    'BY PROCESSOR '
*
*
TXTAT    TEXTC    'AT '
*
SPACES   TEXTC    '    '
         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,R6    HEX,R4            PICK UP THE EBCDIC
         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
         PAGE
*
*
*        ROUTINE TO HANDLE THE I/O ERRORS
*
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,R0   OPNXX               OPEN M:XX TO DO DEVICE
         BAL,12   WRTXX             WRITE THE RECORD
         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    M17               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 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
         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 '
         PAGE
*
*        ROUTINE TO READ THE ERROR MESSAGE FILE AND PRINT THE
*        ERROR MESSAGE OR THE ERROR NUMBER IF NO SUCH MESSAGE.
*        IN: R0=LINK, R1=WA(BUFFER)
*        OUT: R1 PRESERVED.
*
WRITERR  EQU      %
         LB,R12   J:ABC             IS THERE REALLY AN ERROR...
         BEZ      *R0               ---> NO. DON'T PRINT ANYTHING.
         AI,R12   X'030000'
         SLS,R12  +8                R12= 03 / 00 / J:ABC / 00
         LI,R13   X'FF'
         LS,R12   J:JIT+ERO         R12= 03 / 00 / J:ABC / J:ERO
         STW,R12  0,R1              SAVE KEY IN WORD0 OF BUFFER.
         PUSH     2,R0              SAVE RETURN & BUFFER ADDRESS.
         LCI      12
         LM,R2    OPEN              GET OPEN FPT AND
         STM,R2   1,R1              COPY IT TO BUFFER.
         LI,R6    M:XX              R6 = DCB ADDRESS.
         LW,R7    R1
         AI,R7    2                 R7 =>FPT + 1.
         LI,R8    X'14'             R8 = FPT CODE (M:OPEN).
         OVERLAY  OPNSEG,0            OPEN M:XX TO ERRMSG FILE.
         LW,R1    *TSTACK           REFRESH BUFFER ADDRESS IN R1.
         LH,R5    M:XX              IF M:XX DIDN'T GET OPEN,
         CI,R5    X'20'             WE CAN'T READ IT.
         BAZ      KEYCONV
         LW,R5    Y4                SET 'DONT-CHECK-BUFFER-ACCESS'
         STS,R5   J:ASSIGN          FOR THE READ.
         LI,R6    M:XX              R6 = DCB ADDRESS.
         LW,R7    TSTACK            R7 =>FPT.
         LI,R8    X'10'             R8 = FPT CODE (M:READ).
         LW,R9    L(X'78000000')    SET UP FPT:
         LI,R10   KEYCONV            *ABN
         LW,R11   R1
         AI,R11   1                  *BUF = (BUFFER) + 1
         LI,R12   140                *SIZE = 140
         LW,R13   R1                 *KEY IS IN BUFFER WORD 0.
         PUSH     5,R9              PUT FPT INTO STACK.
         BAL,R11  MSRRDWT             READ MESSAGE FROM ERRMSG FILE.
         LI,R11   -5
         MSP,R11  TSTACK            REMOVE FPT.
         CI,R10   0                 WAS THE READ SUCCESSFUL...
         BNE      KEYCONV           --> NO. PRINT KEY ONLY.
         LW,R4    M:XX+13           YES. GET SIZE OF MESSAGE
         AI,R4    4-1               R4=MSGSIZE (+4 1WORD, -1 CR)
         B        WTERROUT          ---> GO PRINT MESSAGE NOW.
KEYCONV  EQU      %
         LW,R1    *TSTACK           REFRESH BUFFER ADDRESS IN R1.
         LW,R3    0,R1              GET KEY AGAIN.
         SLS,R3   +8                STRIP OFF BYTE COUNT.
         LI,R4    3                 START 3 BYTES INTO BUFFER.
GO       LI,R2    0
         SLD,R2   +4                GET A HALFBYTE OF KEY.
         LB,R2    HEX,R2            CONVERT TO EBCDIC.
         STB,R2   *R1,R4            STORE IN BUFFER.
         AI,R4    +1
         CI,R4    3+6               REPEAT FOR 6 HALFBYTES.
         BL       GO
WTERROUT EQU      %                 GOT ERRMSG OR DECODED # IN BUF.
         PULL     R1                REMOVE BUFFER ADDRESS FROM STACK.
         LW,R2    L('1   ')         PUT PAGE-EJECT INTO
         LW,R0    J:ASSIGN          GET FLAG BITS
         CI,R0    X'60000'          CHECK FOR !PMDS
         BANZ     %+2               IF !PMDS, PAGEFEED FIRST
         LW,R2    L(C'C   ')        OTHERWISE TRIPLESPACE
         STW,R2   0,R1                BEGINNING OF BUFFER.
         LW,R2    R4                R2 = RECORD LENGTH.
         BAL,R0   OPNXX             NOW OPEN M:XX TO DO DEVICE.
         BAL,R12  WRTXX             WRITE ERROR MESSAGE.
         PULL     R0                  (RESTORE RETURN ADDRESS)
         B        *R0               RETURN TO CALLER.
*
OPEN     DATA     0
         DATA     X'C1020001'
         PZE      KEYCONV           *ERR
         PZE      KEYCONV           *ABN
         DATA     1                 * IN
         DATA     0                 *BTD = 0
         DATA     X'01000202'       *FILENAME:
         TEXTC    'ERRMSG'
         DATA     X'02010202'       *ACCOUNT#:
         TEXT     ':SYS    '
         PAGE
* L:0 P:NONE.
CLSXX    EQU      %                 CLOSE M:XX IF OPEN.
         LI,R6    M:XX
CLSDCB   EQU      %
         LI,R2    2                 (SAVE).
         LH,R1    *R6               CHECK FOR ALREADY CLOSED
         CI,R1    X'0020'           IF CLOSED ALREADY,
         BAZ      *R0               ---> FINISHED.
         LW,R1    Y8                R1/R2 = M:CLOSE FPT.
         PUSH     3,R0              SAVE RETURN & FPT IN STACK.
         LW,R7    TSTACK
         AI,R7    -1                R7 =>FPT.
         LI,R8    X'15'             R8 = M:CLOSE FPT CODE.
         OVERLAY CLSSEG,0           CLOSE M:XX.
         PULL     3,R0              RESTORE RETURN & LEVEL STACK.
         B        *R0               ---> RETURN.
         SPACE    3
* L:0 P:1,2.
OPNXX    EQU      %                 OPEN M:XX TO 'DO'.
         LCI      5
         LM,R3    XXTODO              LOAD FPT FOR M:OPEN TO 'DO'.
         PUSH     8,R0                SAVEREGS & FPT TO STACK.
         LH,R1    M:XX
         CI,R1    X'0020'             IS M:XX OPEN...
         BAZ      OPNXX10           ---> NO.
         BAL,R0   CLSXX               YES. CLOSE IT FIRST.
OPNXX10  LI,R6    M:XX              R6 =>DCB (M:XX).
         LW,R7    TSTACK
         AI,R7    -3                R7 =>FPT +1.
         LI,R8    X'14'             R8 = FPT CODE (M:OPEN).
         OVERLAY  OPNSEG,0            OPEN M:XX.
         LI,R2    X'100'              SET VFC,
         LI,R3    X'4130'             CLEAR FBCD, SET BTD=0
         STS,R2   M:XX                IN M:XX.
         STB,R2   M:XX+20             NO PAGE HEADERS.
         PULL     8,R0               RESTORE REGS & LEVEL STACK.
         B        *R0               ---> RETURN.
*
XXTODO   DATA     0                 M:OPEN M:XX,(DEVICE,'DO')
         DATA     X'C0040000'
         PZE      %                 *ERR (NONZERO)
         PZE      %                 *ABN (NONZERO)
         DATA     'DO'              *DEVICE,'DO'
         SPACE    3
* I:1,2 L:12 P:1
WRTXX    EQU      %                 WRITE TO M:XX BUF,R1 SIZE,R2.
         PUSH     R12               SAVE RETURN.
         LH,R14   M:XX
         CI,R14   X'0020'           IS M:XX OPEN...
         BANZ     WRTXX10           ---> YES.
         BAL,R0   OPNXX             OPEN M:XX TO 'DO' DEVICE.
WRTXX10  LW,R14   R1                GET BUFFER ADDRESS
         LW,R15   R2                GET BUFFER SIZE
         LI,R6    M:XX              GET DCB ADDRESS
         BAL,R12  PRINTV            PRINT THE MESSAGE.
         BAL,R4   FINDDO
         BEZ      WRTXX20           NO M:DO, NO NEED TO ECHO MESSAGE
         LI,R4    X'F'
         AND,R4   0,R6              IF M:DO IS DEVICE,
         CI,R4    3                  LAST WRITE COVERED IT.
         BE       WRTXX20
         BAL,R12  PRINTV            ECHO MESSAGE THRU M:DO DCB
WRTXX20  EQU      %
         PULL     R0                PULL THE RETURN ADDRESS
*
SETBUF   LI,2     ' '               VFC CHAR
         STB,2    *1                TO BUFFER
         LI,2     1                 BUFFER POINTER
         B        *0
*
         END

