*        RJR  3-9-73  16:40  'LDEV/IRBT' CP-V A00
*        RJR  4-18-73  18:50  'A00D'(DONE ON 7E).
*                 CATALOG NO. 70XXXX  SIGMA 6/7/9 CP-V WRTD
*                 CATALOG NO. 70XXXX  SIGMA 6/7/9 UTS  WRTD
*                 CATALOG NO. 704719  SIGMM 5/7   BPM  WRTD
*
MONPROC  SET      1
         SYSTEM   UTS
         DEF      WRTD
WRTD     EQU      %
         OPEN     BUFX  SINCE 'BUFX' IS DEFINED IN SYSTEM UTS ALSO
         PAGE
         BOUND    8
BAPKTC   EQU      BAOVC             *BYTE ADDRESS OF RECORD PACKET COUNT
NUMBIT   EQU      X'200'
K0       EQU      X'0'
K1       EQU      X'1'
K3       EQU      X'3'
K4       EQU      X'4'
K8       EQU      X'8'
KC       EQU      X'C'
KF       EQU      X'F'
K12      EQU      X'12'
K50      EQU      X'50'
K6B      EQU      X'6B'
K71      EQU      X'71'
K78      EQU      X'78'
KF0      EQU      X'F0'
KFF      EQU      X'FF'
KC0      EQU      X'C0'
KFF0     EQU      X'FF0'
K8000    EQU      X'8000'
KFFFF    EQU      X'FFFF'
K1FFFF   EQU      X'1FFFF'
KN1      EQU      -X'1'
KN2      EQU      -X'2'
KN3      EQU      -X'3'
KN4      EQU      -X'4'
         PAGE
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
         PAGE     DEFS WRTDEV
         DEF      INTCHR
         DEF      MSRLP7
         DEF      MSRWRT
         DEF      WRBCDCC
         DEF      BLNKFIL2
         DEF      IOGETBF           GET MPOOL
         DEF      TCLOGON
TCLOGON  EQU      LOGON
         PAGE     REFS WRTDEV
         REF      CLRMBG
         REF      DCT4
         REF      GETBTD
         REF      GETDEV
         REF      GMBSIZ
         REF      IOQUEUE
         REF      J:JIT
         REF      SCLINES           * STREAMS LINE COUNT
         REF      SCMINR            *   ''    LPP
         REF      SCMISC            *   ''    COPY  COUNT
         REF      SCSEQ             *   ''   CARD SEQ ID
         REF      GMB
         REF      M16
         REF      MSREXIT
         REF      MSROTHR
         REF      PULLEXIT,PULLEXIT1
         REF      PUTSZBF
         REF      RECTRAN
         REF      MODEFRM
         REF      S:CUN
         REF      J:DCBLINK
         REF      SETBTDZ
         REF      UH:FLG
         REF      TAPEOP
         REF      M:OC
         REF      XF
         REF      X7F
         REF      XFF
         REF      Y02
         REF      Y04
         REF      YFFFE
         REF      UB:APR
         REF      P:NAME
         REF      Y0C
         REF      TOFMESS
         REF      Y001
         REF      Y008
         REF      Y0008
         REF      CDPO,CUPO,CPPO
         REF      PUF
         REF      BLANK
         REF      INRRWS
         REF      ATITLE
         REF      RNST
         BOUND    8
LOGON    TEXTC    'LOGON'
BCDMESS  TEXT     '!BCD'
         REF      XA
ZBIT     EQU      Y008
         REF      SCDEVTYP
BASCFLG2 EQU      2+SCDEVTYP+SCDEVTYP+SCDEVTYP+SCDEVTYP
BASCMISC EQU      SCMISC+SCMISC+SCMISC+SCMISC
METYPE   EQU      X'10'             SPECIAL CASED BECAUSE
*                                   COC HANDLER DOES MONITOR SERV.
         REF      TB:FLGS           *DEVICE ATTRIBUTE TABLE
         REF      J:USCDX           * JIT: USABLE CNTXT DATA INDEX
         REF      Y08               * =X'08000000'
         REF      GETASN            * D2 GETS 7&DCB:ASN
         REF      FCONCOM           *COMMON FBCD ENTRY ROUT
         REF      XBCDTB            * OPTIONAL FBCD ROUTINE.
         REF      J:BASE            CAL PROCESSING TEMP CELLS
J:TDCB   EQU      J:BASE     0      *DCB TEMP
J:TBTD   EQU      J:TDCB+1   1      *DCB BTD TEMP
J:TDBI   EQU      J:TBTD+1   2      *DATA BYTE INDEX TEMP
J:TCBP   EQU      J:TDBI+1   3      *CNTXT BUF POINT TEMP
J:TBBG   EQU      J:TCBP+1   4      *BUFFER BEGIN TEMP
J:T5%%   EQU      J:TBBG+1   5      *     TEMP
J:TMBA   EQU      J:T5%%+1   6      *MON BUF ADDRESS TEMP
J:TUBA   EQU      J:TMBA+1   7      *USER BUF ADDRESS TEMP
J:T8%%   EQU      J:TUBA+1   8      *     TEMP
J:TEUB   EQU      J:T8%%+1   9      *END USER BUFF TEMP
J:TEMB   EQU      J:TEUB+1  10      *END MON BUFF TEMP
*
         PAGE     MSRWRT
MSRWRT   EQU      %
*        USED BY ALL WRITE ASN=3 & ANS TAPE WRITE ASN=X'A'
*
         LI,SR1   K1FFFF            SET UP WRITE OP CODE
         AND,SR1  R6
         OR,SR1   Y04
*
*                                   GO TO PROPER ROUTINE
         LI,R2    X'E0000'
         AND,R2   BLK,R6
         BEZ      MSREXIT
*                                   SET ENDING OPERATION
         LW,R0    Y0008
         LW,R1    =X'C0400'
         STS,R0   EOP,R6
CNM      EQU      1                 *******TEMP CARD
         DO       CNM
         REF      CNMLNDCB
         LW,R1    CNMLNDCB          GET CNM SLAVE LINE DCB MASK
         CS,R1    0,R6              SEE IF THIS IS A SLAVE LINE
         BE       MSROTHR           B, IF SO; FINISHED HERE
         FIN
*                   *** FBCD CONVERSION (OUTPUT)
         LW,D3    FCON,R6
         CI,D3    X'4000'           DID USER WANT CONVERSION
         BAZ      %+4               NO, SKIP
         LI,D3    XBCDTB
         LW,R2    BUF,R6            CONVERT USER BUF
         BAL,R1   FCONCOM+1
*
*
*
*
         LI,R5    X'FF'             STREAM ID WIDTH
         AND,R5   CLK,R6            STREAM EXISTS
         BNEZ     MSRWRT1           YES, SPECIAL
         BAL,D4   GETDEV            NO, DCTX TO R3
         BEZ      MSREXIT           --'NO' DEVICE IS NOP
         LB,R1    DCT4,R3           DEV ATTRIBUTE INDEX
         CI,R1    METYPE            * IS IT'ME'
         BE       MSROTHR           * YES, SPECIAL CASED
*        NO YOU CANT CLEAR J:TCBP HERE...
*        ... YOU'LL BOMB THE MOUT MESSAGE THAT IS BEING
*        SNEAKED THROUGH IN J:BASE.
         LC       TB:FLGS,R1        * DEV ATTRIBUTES
         B        MSRWRT1B          *=*JOIN*=*
MSRWRT1  EQU      %                 * IS A STREAM DEVICE
         LW,R5    *J:USCDX,R5       * GET HIS CONTEXT
         REF      COPOLDI,Y2
*
         CW,R5    Y2                STREAM MIGHT HAVE A NON-MEANINGFUL
         BANZ     %+2               CNTXT BLK(AFTER SUPCLS)
         BAL,R3   COPOLDI           INTERNAL OPN (R3-SR4 UNTOUCHED)
         STW,R5   J:TCBP            *( SAVE CNTXT POINT FOR LATER.)
         LI,R1    BASCFLG2          * AND ATTRIBUTE INDEX
         LC       *R5,R1            * CC=TYP,TYP,IN,OUT
MSRWRT1B EQU      %
         BCS,12   MSRWRT1%TDL       * IT IS T,D, OR L.
         BCR,1    MSREXIT           * OUT ILLEGAL=>NOP
         LI,11    X'20000'          THIS IS A TEST FOR WHETHER
         AND,11   0,6               BINARY OUTPUT IS LEGAL
         BEZ      MSRPUN            FOR THIS DEVICE.  THE BIN
         LW,11    5                 BIT IN THE FLAGS MUST BE
         BNEZ     %+2               SET IN TB:FLGS (TBL OR CXT)
         LI,11    TB:FLGS           IF IT IS SET IN THE DCB OR
         LB,11    *11,1             AN ABORT CODE 1F00 IS GIVEN.
         CI,11    8                 *BIN FLAG
         BANZ     MSRPUN
         LI,10    X'1F'
         REF      MSR01EXIT
         B        MSR01EXIT
*
*
*
MSRWRT1%TDL EQU   %                 * IT IS
         BCR,4    MSRTAPE           *  NOT D OR L:=>(TAPE LIKE)
         BCR,8    MSRLP             *  NOT D OR T:=>(LISTING
*                                   *             LIKE,LP,TY,ETC.)
         B        MSROTHR           *       D:=>(DISC LIKE)
*
         PAGE     MSRLP
*
*        GOT HERE ON A LISTING TYPE DEVICE(TYP,TYP=01)
MSRLP    EQU      %
         BCR,1    MSREXIT           *OUT ILLEGAL :=>NOP
         BCS,2    MSRTYPE           *IN&OUT:=>TY
*                 NOTE THE OBSCURE ASSUMPTION FOR LACK OF A BETTER
*                 ATTRIBUTE SAYING THAT USER WANTS 2 RECORDS FOR
*                 ONE WRITE ON THIS DEVICE IF WIDTH IS<BC.
*
*        WE ARE ON AN HONEST TO GOODNESS PRINTER
         AI,R5    0
         BEZ      MSRLPT-1
         LW,R1    Y08               * SCDEVTYP=1; THIS FOR DIRECT
         CW,R1    SCDEVTYP,R5       * VFC REQUESTED
         BANZ     MSRLPT            * NOPE, DON'T SET IT
         OR,SR1   Y02               VFC
*                                   R6 = DCB ADR
MSRLPT   EQU      %
         BAL,SR4  INRRWS
*                 INRRWS  I:R6;U:D4;O:R4=BTD&RWS=RWS+BTD
         LI,R2    X'EFFFF'          CLEAR TOF
         AND,R2   0,R6
         STW,R2   0,R6
         CI,R2    X'100'
         BANZ     MSRLP1
         LW,D3    SVA,R6            SPACE VALUE
         SCS,D3   15
         AND,D3   XF
         BNEZ     MSRLP08           *YEP, DCB COMES 1ST
         AI,R5    0                 * STREAM OR DIRECT
         BEZ      MSRLP09           * DIRECT AND SPACE 0
         LI,R1    BASCMISC+1        * USE STREAM SPACE DEFLT
         LB,D3    *R5,R1            * ...
         BEZ      MSRLP09           * (ITS SINGLE SPC)
MSRLP08  EQU      %                 *
         AI,D3    -1
MSRLP09  EQU      %                 *
         AI,D3    KC0               SPACE CHAR
         B        MSRLP33
MSRLP1   RES      0
*                                   VFC BIT IS SET
         LW,D4    BUF,R6
         LB,D3    *D4,R4
         AI,R4    1
MSRLP33  EQU      %
         STW,R4   J:TBTD            *REMEMBER UBTD TEMP'LY
         BAL,R4   INTCHAR           INTERPRET FORM CHAR
         STW,D3   J:TDCB            SAVE VFC CHAR
         LW,R1    Y04               * HASP BIT(R1=SCDEVTYP, DIR)
         CW,R1    SCDEVTYP,R5       * DIRECT OR HASP
         BANZ     MSRLP34           * YES USE MON BUFF
         LI,D4    X'1FFFF'          SET SPECIAL
         STS,D4   7,R6               BFR FLAG
         LI,SR4   BUFX              SET RTN
         B        IOQUEUE1          TRY FOR COOP
*                 R6=DCB
*                 SR1=IO FUNC / DCB
*                 SR4=LINK
*     DONT CARE   R0,R1,R3,R4,R5,R7,D1,D2,D3,D4
*
         PAGE
         REF      IOQUEUE1
         DEF      MSRLP34
MSRLP34  RES      0                 NOT SYMBIOTIC
         BAL,SR4  IOGETBF
         LW,R3    J:TDCB            * RESTORE VFC CHAR
         STB,R3   *D3
         LI,R2    133
         LW,R4    J:TBTD            *UBTD
         BAL,SR4  FRMIM             FORM IMAGE
         LW,R2    R3                ACTUAL END OF BFR
MSRLP78  EQU      %
         BAL,SR4  PUTSZBF
*                 PUTSZBF  L=SR4;I=R2,D3;U=R3,D4;R2->BLK,D3->QBUF.
         BAL,SR4  IOQUEUE
BUFX     EQU      %
         LI,R0    K0
         LW,R1    Y001
         STS,R0   WAT,R6            CLEAR WAIT BIT
         B        MSREXIT
MSRLP7   EQU      %
*                                   ENTRY FOR TOF
         BAL,SR4  IOGETBF
         LW,R0    TOFMESS
         STW,R0   *D3
         LI,R2    K4
         B        MSRLP78
         PAGE
*
*
INTCHR   EQU      %
*                 R4=LINK
*                 R5=CONTEXT POINT
*                 R6=DCB
*                 R0,R1,D4 - USED
*                 CALLS HEADERTEST    TO OUTPUT HEADER IF APPROPO
*                 RETURNS  D3=VFC CHAR (OR 0 = NONE ALLOWED)
*
*
INTCHAR  EQU      %
         PUSH R4  SAVE RETURN
*
         CI,D3    TOFCHAR           * SKIP TO TOF CHANNEL
         BE       INTCHAR4
*
         BAL,R0   GLINECNT          * CURRENT LINE COUNT
         BNE      INTCHAR2
         BAL,R0   HEADERTEST
         B        %+1
INTCHAR2 EQU      %
         LW,R0    D3                *
         SLD,R0   -4                * SEPARATE VFC CODE
         AI,R0    -4                * CHK FOR BLANK
         BEZ      INTCHAR6          * YEP, NOP VFC
         AI,R0    4-KC              * NOPE, CHK FOR SPACE
         BNE      PULLEXIT          * NOPE, MUST BE A SKIP TO CHANNEL
         SLD,R0   4                 * YEP, EETS A SPACE N LINES
         AW,D4    R0                * ADVANCE LINE COUNT BY N
INTCHAR6 EQU      %
         LW,R0    LVA,R6
         SLS,R0   -17               TRY DCB LINES FIRST
         AI,R0    0
         BNEZ     INTCHAR63         GOT SOME USE IT
         AI,R5    0                 COOP DEV
         BEZ      INTCHAR63         NOPE
         LW,R0    SCMINR,R5         GET STRM
INTCHAR63 EQU     %                 AND TEST
         CW,R0    D4
         BLE      INTCHAR4          THIS LINE BRINGS US TO TOF
         AI,D4    K1                ADD ONE FOR LINE ITSELF
         CW,R0    D4
         BG       INTCHAR5          LAST LINE OF PAGE
         LI,D4    0
INTCHAR5 EQU      %
         BAL,R0   SLINECNT          * UPDATE LINE COUNT
         B        PULLEXIT          * AND  POP-UP RETURN
INTCHAR4 EQU      %
         LI,D4    1                 * RESET STREAM LINES TO
         BAL,R0   SLINECNT          * 1 LINE THIS PAGE
         BAL,R0   HEADERTEST        WANT A HEADER
         B        INTCHAR9          * NO HE DINT
         LI,D3    X'40'             ** YEP,  HE GOT IT
         AI,D4    +1                ** LINES THIS PAGE
         BAL,R0   SLINECNT          ** IS INCREMENTED
INTCHAR9 EQU      %                 *
         CI,D3    X'30'             *WAS THAT A SPACE VFC
         BANZ     PULLEXIT          *(SKIP TO CHAN AGAIN)
         LW,R0    FVA,R6            **
         SCS,R0   +15               ** WAS TOP GIVEN
         AND,R0   XF                **
         BEZ      INTCHAR92         ** NO, CHECK STREAM TOP
INTCHAR91 EQU     %                 **
         AI,R0    -1                ** YES, ENFORCE
         LW,D3    R0                **
         AI,D3    X'C0'             ** SPACE TO 1ST LINE VFC
         AW,D4    R0                ** CORRECT PAGE LINE
         BAL,R0   SLINECNT          **     COUNT
         B        PULLEXIT          ** AND LEAVE
*
INTCHAR92 EQU     %                 **
         AI,R5    0                 ** STREAM OR DIRECT
         BEZ      PULLEXIT          ** DIRECT AND NO TOP
         LI,1     BASCMISC+2        ** STREAM, CHECK TOP DFLT
         LB,R0    *R5,R1            ** ...
         BEZ      PULLEXIT          ** NONE SO GIVE UP
         B        INTCHAR91         **
*
*
         PAGE     FRMIM             FORM IMAGE(DATA,TABS)
TABCHAR  EQU      X'05'             RECOGNIZED TAB CHAR
*
*                 FROM MSRLP4 AND PRTOTY
FRMIM    EQU      %                 FORM IMAGE FOR PRINT BUFFER
*
*                 BY DISPLACEING TO WHERE DSC SAYS FIRST LISTING
*                 COLUMN IS AND EXPANDING TAB CHARACTERS TO
*                 BLANKS AS DIRECTED BY DCB.
*
*                                   SR4 = LINK
*                                   R5 = CONTEXT POINT
*                                   R6 = DCB
*                                   R0,R1,R3,R7,D4     VOLATILE
*                                   USES RECTRAN UNLESS TABS REQ.
*                                   R4 = BTD OF USERS BUF
*                                   R3 = BTD OF MONITOR BUF
*                                   D3 =ADR OF MONITOR BUF
         LI,R3    0
         STW,R3   J:TBBG            ZAP BUFFER BEGIN
         STW,R6   J:TDCB            REMEM DCB ADDR
         LI,R3    K1
         LW,D4    BUF,R6            USERS BUFFER ADDRESS
         LW,R1    RWS,R6            GET USERS RECORD SIZE
*
         DEF      FRMIMNT
*                 USED BY COOP
FRMIMNT  RES      0
         LI,R7    BADSC             IS DATA OPTION SPECIFIED
         LB,R7    *J:TDCB,R7        IN HIS DCB
         AND,R7   X7F               LIMIT IT
         B        FRMIM1-1
         LI,R0    ' '
         STB,R0   *D3,R3
         AI,R3    1
         BDR,R7   %-3
FRMIM1   EQU      %
         LI,R7    4*TAB1            DID HEE
         LB,R0    *J:TDCB,R7        REQUEST TABS
         BEZ      RECTRAN           NO TABS SO MBS
         LCI      5
         STM,D3   J:TMBA   THROUGH J:TEMB     D3-R2
FRMIM2   EQU      %
         CW,R4    J:TEUB            AT OR BEYOND END USER BUFFER
         BGE      *SR4              YES
         CW,R3    J:TEMB            AT OR BEYOND END MONITOR BUF
         BGE      *SR4              YES
         LB,R0    *J:TUBA,R4        NEXT USER BYTE
         CI,R0    TABCHAR           IS IT
         BE       FRMIM3            YES
         STB,R0   *J:TMBA,R3        STORE CHAR
FRMIM4   EQU      %
         AI,R3    K1                INCREMENT DISPLACEMENTS
FRMIM2A  EQU      %
         AI,R4    K1
         B        FRMIM2
FRMIM3   EQU      %
         LI,R0    ' '
         LB,R5    *J:TDCB,R7        NO MORE TABS
         BEZ      FRMIM4-1
         AI,R7    K1
         AW,R5    J:TBBG            TAB + DEST BTD = DEST BYTE INDEX
         CW,R5    J:TEMB            OFF END OF DEST BUFFER
         BGE      *SR4              OFF THE END
FRMIM3A  CW,R3    R5
         BL       FRMIM3B
         LW,R3    R5
         B        FRMIM2A
FRMIM3B  EQU      %
         STB,R0   *J:TMBA,R3        PLANT EXPANDING BLANK
         AI,R3    1
         B        FRMIM3A
         PAGE
*
*
HEADERTEST  EQU   %
*                                   PRINT HEADER IF DESIRED
*                 R0 = LINK
*                 R5 = CONTEXT POINT
*                 R6 = DCB
*                 USES - R1,R2,R3,R4,D1,D2,D4,SR2,SR3,SR4
*                 DOES ACCOUNTING CHECK
*                 OUTPUTS - USER HEADER
*                   OR      TITLE + PAGE COUNT.
TOFCHAR  EQU      X'F1'             RECOGNIZED TOF CHAR
*
*
         PUSH     1,R0
         PUSH D3
         PSW,R5   TSTACK            * SAVE STRM/DIRECT POIN
         LI,R0    X'40'
         STB,R0   J:TCBP
*
         BAL,R0   PMAX              ACCOUNT FOR THAT PAGE
*
         LI,D1    KN1
         LI,R1    BAHSC             * DOES USER WANT
         LB,R1    *R6,R1            * A HEADER.
         BNEZ     MSRLP3B           YES
*                                   CHECK FOR TITLE CC
         LC       J:JIT             * IS HE ONLINE OR GHOST
         BCS,8+4  HD3               * YEP, TITLE UNDEFINED
         DO       0                 LEAVE IT OUT AND SEE WHO SCREAMS.
         AI,R5    0                 * STREAM
         BEZ      HD3               * NOPE, NO TITLE
         LW,D2    TITLEOPTBIT       * TITLE ON THIS STREAM
         CW,D2    SCDEVTYP,R5       * REQUESTED OR DEFAULT
         BAZ      HD3               * NOPE,
*                 NEEDS AN LDEV OPTION FOR TITLEOPTBIT
         FIN
         LI,D1    K1
         LB,D2    ATITLE+J:JIT      (DON'T LOOK AT 'UC')
         BNEZ     MSRLP3B
HD3      EQU      %
         LW,R1    LVA,R6
         SLS,R1   -17
         AI,R1    0
         BNEZ     HD31
         LI,R1    BACSC             * DOES USER WANT
         LB,R1    *R6,R1            * THE PAGE COUNT
         BNEZ     HD31              * YES, THEN DOIT
         AI,R5    0                 * STREAM OR DIRECT
         BEZ      HDX               * DIRECT,XIT
         LW,R1    SCMISC,R5         * STREAM USE COUNT
         LB,R1    R1                * ..HI BYTE
         BEZ      HDX               * NON THERE EITHER
HD31     EQU      %                 *
         LI,D1    K0
MSRLP3B  EQU      %
         STW,D1   CDA,R6
         MTW,1    SQS,R6
         BAL,SR4  IOGETBF
         LI,R2    133
         BAL,SR4  BLNKFIL
         LI,SR3   TOFCHAR           *PROPER VFC FOR TOF
         STB,SR3  *D3
         LW,D4    CDA,R6
         BEZ      MSRLP7B
         BGZ      HD1
         LI,R1    BAHSC             * FETCH UP
         LB,R3    *R6,R1            * MONITOR BTD(RECTRAN).
         AND,R3   X7F               HAVE TO LMIT(< MON BUF)
         LW,D4    HLC,R6            GET HEADER ADDRESS
HD2      EQU      %
         LI,R4    K1
         LB,R1    *D4               LENGTH OF HEADER
         AI,R1    K1
         BAL,SR4  RECTRAN           TRANSFER RECORD
MSRLP7B  EQU      %
         LI,R1    BACSC             * DOES HE WANT
         LB,R3    *R6,R1            * A PAGE COUNT.
         BEZ      HD20              NO;GO ON
         CI,R3    132               YES;CHK AGNST MAX. PRNTABL PSTN
         BLE      HD21
         LI,R3    132               HAVE TO LIMIT IT
         B        HD21
HD20     EQU      %
         LW,R5    *TSTACK           * RECTRAN BOMBED R5
         AI,R5    0                 * STREAM OR DIRECT
         BEZ      MSRLP8            * DIRECT NO COUNT
         LW,R3    SCMISC,R5         * STREAM COUNT
         LB,R3    R3                *
         BEZ      MSRLP8            * NONE, NO COUNT
HD21     EQU      %                 * DO APPROPO COUNT
         BAL,R0   CVTDTB            YES--CONVERT DECIMAL COUNT TO BCD
*                                   PUT COUNT INTO BUFFER
         LI,R4    K0                USERS BYTE DIS
         LI,D4    D1
         LI,R1    K4                LENGTH OF COUNT
*
*                                   SUPPRESS LEADING ZEROS
HD5      EQU      %
         LB,R0    D1,R4
         CI,R0    KF0
         BNE      HD4
         AI,R4    K1
         B        HD5
HD4      EQU      %
         BAL,SR4  RECTRAN
MSRLP8   EQU      %
         BAL,SR4  PUTSZBF
         LI,SR4   X'40'             ** SET TOF THIS LINE
         STB,SR4  J:TCBP            **
         BAL,SR4  IOQUEUE
         PLW,R5   TSTACK            * RESTORE STRM POINT
         LI,15    1
         BAL,R0   SLINECNT          * COUNT BACK  TO 1.
         PULL D3
         B        PULLEXIT1
HDX      EQU      %
         PLW,R5   TSTACK            * RESTORE STRM/DIR POINT
         PULL D3
         LI,D4    0
         B        PULLEXIT
*
HD1      EQU      %
         LI,D4    J:JIT+ATITLE
         LI,R3    K1
         B        HD2
*
*
         PAGE     MSRPUN
*MSRPUN-ASSUMES R6 CONTAINS DCB ADDRESS, AND THAT WE WANT TO PUNCH.
*
*
MSRPUN   EQU      %
         BAL,SR4  MODEFRM
         B        MSRPUNT
MSRPUNN  EQU      %
         BAL,R0   PUNMAX            COUNT RECORD
         B        MSROTHR
MSRPUNT  EQU      %
         AI,R5    0
         BEZ      MSRPNT1
         LW,SR4   Y002
         REF      Y002              CXT PUNCH BIT
         CW,SR4   1,R5
         BAZ      MSRPUNN
MSRPNT1  EQU      %
         AND,R0   R1
         BEZ      BCDFOR
         BAL,R0   PMAX              * COUNT THAT RECORD
         BAL,SR4  IOGETBF           OBTAIN A MONITOR (DYNAMIC) BUFFER
         LI,R2    K78               SET UP BUFFER LENGTH=120 BYTES
         BAL,SR4  PUTSZBF           PUT OUTPUT BUFFER PARAMS IN DCB
*                 PUTSZBF  L=SR4;I=R2,D3;U=R3,D4;R2->BLK,D3->QBUF.
         LI,D1    K0
         BAL,SR4  BLNKFIL2          FILL IT WITH ZEROS
         BAL,SR4  INRRWS
*                 INRRWS I:R6;U:D4;O:R4=BTD&RWS=RWS+BTD.
         LW,R1    RWS,R6            LOAD    USER BUFFER LENGTH
         LW,D4    BUF,R6            LOAD    USER BUFFER ADDRESS
         LI,R3    K0
         BAL,SR4  RECTRAN           MOVE RECORD TO MONITOR BUFFER
*
         LW,R5    J:TCBP            *(RECTRAN BOMBED R5 AGAIN
*
         BAL,SR2  SEQR              ***CHK SEQ OPTIONS
*GRP1
         LI,R3    K6B               * BUFF INDEX FOR ID
         BAL,SR4  BCDTOB            * ID TO BIN IMAGE AND STORE
*GRP2
         LI,R3    K71               * BUFF INDEX FOR SEQ VALUE
         BAL,R0   CVTDTB            * CONV SEQ NO TO BCD VAL
         BAL,SR4  BCDTOB            * SEQ VAL TO BIN IMAGE AND STORE
         NOP                        **SPACER**
*SKIPPED IF NEITHER
         MTW,+1   SQS,R6            * SEQUENCE COUNT
*
         BAL,SR4  IOQUEUE           * DO THE OUTPUT
*
*
         B        BUFX
*                                   WANT TO WRITE IN BCD
BCDFOR   EQU      %
         B        BCDOK
         BAZ      BCDOK
         LI,D3    BCDMESS           GET ADDRESS OF !BCD MESSAGE
         LI,R2    K4
         BAL,R0  RWPUNCC1
BCDOK    EQU      %
         LI,R0    -4                *
         LI,R2    BAPKTC            *CONTINUOUS IO(IOCONT) PACKET COUNT
         STB,R0   *R6,R2            * 2 TIMES
         LW,R0    RWS,R6
         CI,R0    K50
         BG       %+2
         MTB,2    *R6,R2
         BAL,SR4  INRRWS
BCDLOOP  EQU      %
         PUSH     1,R4              SAVE USER BYTE INDEX
*
         BAL,R0   PUNMAX
         BAL,SR4  IOGETBF           OBTAIN A MONITOR BUFFER
         LI,R2    K50
         BAL,SR4  BLNKFIL           FILL IT WITH ZEROS
         BAL,SR4  PUTSZBF           PLACE ITS PARAMS IN DCB
*
         LI,R3    K12               *SET INDEX TO COL73-WORD 19
         BAL,SR2  SEQR              ***CHK SEQ OPTIONS
*GRP1
         AI,R2    KN4               REDUCE CARD LENGTH BY 4(MORE) BITES
         STW,D1   *D3,R3            PLANT EBCDIC ID
*GRP2
         AI,R3    1                 * INCREMENT INDEX TO COL 77
         BAL,R0   CVTDTB            * CONV SEQ NO TO BCD VAL
         STW,D1   *D3,R3            * PLANT VALUE IN CARD
         AI,R2    KN4               * REDUCE BY 4(MORE) BITES.
*SKIPPED IF NEITHER
         MTW,+1   SQS,R6            * SEQUENCE COUNT
*
*
         LI,R3    BADSC
         LB,R3    *R6,R3
         BEZ      MSRPUN4           DATA OPTION NOT WANTED
         AI,R3    KN1
MSRPUN4  EQU      %
         LW,D4    BUF,R6            GET USER BUF
         LW,R1    RWS,R6            EXTRACT USER BUFF SIZE
         PULL     1,R4
MSRPUN5  BAL,SR4  RECTRAN           MOVE (SOME OF) OUTPUT TO BUFFER
         LI,R0    BCDLOOP
*                                   DO IO AND SEE IF WE SHOULD CONTINUE
*
*
IOCONT   EQU      %
         PUSH     1,R0
         PUSH     1,R4              SAVE CURRENT BTD
         BAL,SR4  IOQUEUE           WRITE OUT
         PULL     1,R4
         LW,D1    RWS,6
         PULL     1,R0
         CI,R6    M:OC              IS IT M:OC
         BE       BUFXOC            YES
         CW,R4    D1
         BGE      BUFX
         LI,R1    BAPKTC            *CONTINUOUS IO(IOCONT) PACKET COUNT
         MTB,2    *R6,R1
         BEZ      BUFX
         B        *R0
BUFXOC   BAL,R1   MAP               GO MAPPED
         B        BUFX
         PAGE     MSRTYPE           THIS ROUTINE HANDLES OUTPUT TO THE
*                                   TYPEWRITER
MSRTYPE  EQU      %
         LI,R5    X'FF'             *CLK STRM FLD WIDTH
         AND,R5   CLK,R6            * STRM OR DIR
         BNEZ     PRTOTY            * STRM, NO ID:
         LI,R5    -4                2 ITERATIONS
         LI,R2    BAPKTC            *CONTINUOUS IO(IOCONT) PACKET COUNT
         STB,R5   *R6,R2
TYPE1    EQU      %
         BAL,SR4  IOGETBF
         LI,R2    X'15'
         STB,R2   *D3
         LI,R3    1
         LI,R2    4
         LW,R1    J:JIT             PICK UP USERS ID
         BEZ      ENDID
         AND,R1   M16
         SLS,1    16
ID1      LI,R0    0                 CONVERT TO EBCDIC
         SLD,R0   4
         CI,R0    0
         BNE      ID4
         CI,R3    1
         BE       ID3
ID4      AI,R0    X'C0'-9
         CI,R0    X'C0'
         BG       ID2
         AI,R0    X'F0'-(X'C0'-9)
ID2      STB,0    *D3,R3            PUT IT AWAY
         AI,R3    1
ID3      BDR,R2   ID1
         LI,R1    X'7A'             COLON
         STB,R1   *D3,R3
         AI,R3    1
         LI,R1    X'40'             BLANK
         STB,R1   *D3,R3
         AI,R3    1                 IF USER RUNNING TAB IT OUT
         LW,1     S:CUN
         LB,2     UB:APR,1
         LD,10    P:NAME,2
         CD,10    LOGON
         BE       ENDID
         LH,1     UH:FLG,1
         CI,1     TIC
         BANZ     ENDID
         LI,R1    X'05'             TAB CHARACTER
         STB,R1   *D3,R3
         AI,R3    1
         STB,R1   *D3,R3
         AI,R3    1
ENDID    LW,R1    BLK,R6
         SLS,R1   -17
         SLS,R3   17
         AWM,R3   BLK,R6
         SLS,R3   -17
         BAL,D4   GETBTD
         AW,R1    R4
         LW,D4    BUF,R6
         LW,R2    R1
         AW,R2    R3
         CI,R2    136
         BLE      %+2
         LI,R2    136
         BAL,SR4  RECTRAN
         LI,D4    X'1FFFF'
         STS,D3   QBUF,R6
         LI,0     TYPE1
         CI,R6    M:OC              CHECK FOR M:OC
         BNE      %+2               NO
         BAL,R1   UNMAP             GO UNMAPPED
         B        IOCONT            WADE INTO IOCONT
*
*
PRTOTY   EQU      %
         LI,R5    KN2               MAZIMUM OF TWO RECORDS
         LI,R2    BAPKTC            *CONTINUOUS IO(IOCONT) PACKET COUNT
         STB,R5   *R6,R2
         STW,R5   CDA,R6
         BAL,SR4  INRRWS
*                 INRRWS I:R6;U:D4;O:R4=BTD&RWS=RWS+BTD.
         BAL,D4   GETBTD
*                 GETBTD  DCB:BTD->R4;L=D4
PRTOTY1  EQU      %
         PUSH     1,R4
         BAL,SR4  IOGETBF
         LI,R2    81
         BAL,SR4  BLNKFIL
         PULL     1,R4
*
*                                   PUT IN CARRIAGE RETURN
         LI,R1    X'15'
         STB,R1   *D3
         BAL,SR4  FRMIM
         LW,R2    R3
         BAL,SR4  PUTSZBF
         LI,R0    PRTOTY1
         B        IOCONT            DO IO AND SEE IF MORE SHOULD BE DONE
         PAGE     MSRTAPE
*MSRTAPE - ASSIGNS OUTPUT TO TAPE OR PUNCH AS APPROPRIATE
*USES VOLATILE REQS,ASSUMING R6 POINTS TO DCB, R5 TO JIT
MSRTAPE  EQU      %
         BAL,SR4  MODEFRM           ZEE IF FORMATTING SHOULD BE DONE
         B        TAPEFRM
         B        MSROTHR
TAPEFRM  EQU      %
         BAL,R0   GETASN
         AI,D2    -3                * 3 IS IT DEVICE ASN
         BNEZ     MSROTHR           * NO MUST BE OTHER (ANS=X'A')
         INT,D2   0,R6              *FETCH UP VFC BIT
         OR,D2    SVA,R6            * + SPACE AND DATA
         OR,D2    HSC,R6            * + HEADER AND 1ST
         CW,D2    =X'FFFE0100'      * FEILD MASK FOR ABOVE THINGS
         BAZ      MSROTHR           **NONE OF EM WANTED**
         B        MSRLPT            * MAY NOT NEED PRPNCHK
M:LL     TEXT     'M:LL'
         PAGE     MISCELLANEOUS I/O ROUTINES
PBT      EQU      %                 PROPER BUCKET TABLE
         GEN,16   0                 0 - NO ACCOUNTING
         GEN,16   CDPO              1 - CURRENT DIAG PAGES OUT
         GEN,16   CPO               2 - CURRENT PUNCH OUTPUT
         GEN,16   CUPO              3 - CURRENT USER PAGES OUT
         GEN,16   CPPO              4 - CURRENT PROC PAGES OUT
         BOUND    4
PMAX     RES      0
PUNMAX   RES      0
*                 MAX UO,DO,LO ENFORCER (ALSO PO)
*                   R0 = LINK
*                   R5 = CONTEXT BLOCK POINTER.
*                   R6 = DCB
*                         CLK(WORD 12) BYTE 2 IS PROPER BUCKET INDEX.
*                   D1,D2,R1 - USED
*
         LI,R1    (4*CLK)+2         WORD CLK BYTE 2
         LB,R1    *R6,R1            FETCH UP ACCOUNTING TYPE
         AND,R1   XF                (FOUR BITS WIDE.)
         BEZ      *R0               DO NO ACCOUNTING
         LH,R1    PBT,R1            XLATE INTO JIT DISP.
         LW,D1    J:JIT,R1
         LW,D2    SCMISC,R5         * CHARGE FOR EACH COPY
         AND,D2   XFF               * , I.E. THE REAL ITEM IS
         SLS,D2   +17               * THE END PRODUCT, PAPER
         AW,D1    D2                * ,CARDS, PERIPHERAL TIME,
         LW,D2    YFFFE             * ETC. AND THAT
*                                   * IS THE LIMIT.
         STW,D1   J:JIT,R1
         AI,R1    1
         CS,D2    J:JIT,R1          MAX LIMIT
         BE       *R0               YES, THAT MEANS NO LIMIT
         CS,D1    J:JIT,R1
         BLE      *R0
         LW,D2    Y0038
         REF      CPO,Y0038,NMPO,MFL
         AND,D2   J:JIT+PUF
         BEZ      *R0
         LW,D2    Y04
         STS,D2   RNST+J:JIT
         AI,R1    NMPO
         SLS,R1   -1
         SLS,D2   -26,R1
         STS,D2   MFL+J:JIT
         B        *R0
*
*
HACLK    EQU      CLK+CLK           *DCB W 12 HW 0
*
*        GET LINE COUNT  L=0,I=R5(0 OR CNTXT LOC),R6(DCB)
*                        O=D4(CURR LINE COUNT)
*
GLINECNT EQU      %
         AI,R5    0                 *STREAM OR DIRECT
         BNEZ     %+4               *IS STREAM NORMALLY
         LI,R1    HACLK             *NOPE, IS DIRECT
         LH,D4    *R6,R1            *GET DCB LIN COUNT
         B        *R0               * AND RETURN
         LW,D4    SCLINES,R5        *..STREAM LINE COUNT
         B        *R0               * AND RETURN
*
*        SET LINE COUNT  L=R0,I&O LIKE GET L.C.
*
SLINECNT EQU      %
         AI,R5    0                 *STREAM OR DIRECT
         BNEZ     %+4               * IS STREAM NORM.
         LI,R1    HACLK             * NOPE IS DIRECT
         STH,D4   *R6,R1            * SET CURR L. C.
         B        *R0               * AND RETURN
         STW,D4   SCLINES,R5        * ..SET STREAM L. C.
         B        *R0               * AND RETURN
*
WRBCDCC  PUSH     SR4
         REF      DEOD
         CI,D3    DEOD
         BNE      %+2
         BAL,R0   PUNMAX
         BAL,SR2  BCDWRTE           * CLEAR J:TCBP AND WRT
         PULL     SR4
***    DUMMY ENTRY FROM IOD-SYMBIONT-M:DEVICE (FORM) DIRECTIVE
RMESSX   RES      0
         OBSR4
*
BCDWRTE  EQU      %                 *
         LI,R0    0                 *CLEAR RECORD FLAGS
         STB,R0   J:TCBP            * FOR CANNED MSG.
         LI,10    4
         B        TAPEOP
*
*
RWPUNCC1 EQU      %
*                                   R3 = DEVICE NO
         LB,R1    DCT4,R3
         CI,R1    CP
         BNE      *R0               IGNORE IF NOT CARD PUNCH
         PUSH     1,R0              D3 = ADDRESS
         PUSH    1,SR1
         BAL,SR4  PUTSZBF
         BAL,D4   SETBTDZ
         BAL,D4   CLRMBG
         BAL,R0   PUNMAX
         BAL,SR2  BCDWRTE           * CLEAR J:TCBP AND WRT
         PULL     1,SR1
         B        PULLEXIT
*
*
*
BLNKFIL  EQU      %                 FILL BUFFER WITH BLANKS
*                                   R2 = SIZE, D3 = ADR
         LW,D1    BLANK
BLNKFIL2 EQU      %
         LI,R3    GMBSIZ-1
         STW,D1   *D3,R3
         BDR,R3   %-1
         STW,D1   *D3
         B        *SR4
*
*
***
*   TEST FOR SEQUENCE OPTION REQUESTS
*   CALL:         BAL,SR2    ...
*                 1ST ID PLACEMENT INST.
*                 2ND ''    ''      ''
*                 1ST VALUE PLACEMENT INST.
*                 2ND   ''     ''      ''
*                 3RD   ''     ''      ''
*                 4TH   ''     ''      ''
*                 SEQUENCE COUNT INST IF EITHER
*                 ALL DONE OR NONE WANTED RETURN.
***
SEQR     EQU      %                 * CHECK FOR CARD SEQUENCING
         LW,D1    SID,R6            *  DCB SEQID OVERRIDE
         LW,R1    Y0C               * (SEQ FLAGS)
         AND,R1   SEQ,R6            * REQUEST IN DCB
         BNEZ     SEQR2             *  SOMETHING IS WANTED
         LW,D1    SCSEQ,R5          * ANY DFLT STREAM SEQ
         BNEZ     *SR2              * YEP, DO THAT
         AI,SR2   7                 *  NOTHING SO SKIP IT ALL
         B        *SR2              *=*AND RETURN*=*
SEQR2    EQU      %                 *
         CW,R1    Y04               * DOES HE WANT ID TOO
         BANZ     *SR2              * YEP, GIVEM BOTH
         AI,SR2   2                 * NOPE, VALUE ONLY
         B        *SR2              *
***
*
*
CVTDTB   EQU      %
*                                   TO EBCDIC
         LI,R1    3                 * LO ORD TO BY3
         LI,SR4   KFFFF
         AND,SR4  SQS,R6
CVTDTB1  EQU      %
         LI,SR3   K0
         DW,SR3   XA
         STB,SR3  D1,R1             * PLANT CONVERTED VALUE
         AI,R1    -1                * NEXT MOST SIGNIFICANT
         BGEZ     CVTDTB1           * FROM TOP
         OR,D1    ='0000'           * DONE,MERGE ZONE BITS
         B        *R0               *=*RETURN*=*
*
*BCDTOB  CONVERTS CONTENTS OF  D1 FROM BCD TO BINARY MAP. LINKED VIA SR4
*OUTPUT STORED AT (D3) INDEXED BY R3
*
BCDTOB   PUSH     9,D2              GET WORKING SPACE
         LI,R1    KN2               SET UP OUTER LOOP INDEX
         LI,D2    KFF               SET UP CHARACTER MASK
CHAR1    LI,R2    KN2               SET UP INNER LOOP INDEX
         LI,D4    K0                CLEAR MAP ACCUMULATOR
CHAR2    SCS,D1   +8                PLACE 1ST CHARACTER UNDER MASK
         SLS,D4   +12               SHIFT PRIOR CHARACTER MAP AWAY
         LI,R4    K0                 CLEAR A REGISTER
         STS,D1   R4                EXTRACT BCD CHARACTER
         LI,R5    KFF0              CLEAR THE REGISTER AND SET MASK
         SLD,R4   -4                SEPARATE ZONE AND NUMBERIC
         CI,R4    KC                IS CHARACTER ALPHA-NUMBERIC
         BL       CHKINRDN          NO-GET THE NEXT CHARACTER
         CI,R4    KF                IS CHARACTER NUMBERIC
         BE       SETNUM            YES-SET ONLY NUMERIC BIT IN MAP
         LW,R0    ZBIT              SET UP ZONE BIT
         LCW,R4   R4                NEGATE THE ZONE SHIFT COUNT
         LS,R5    R4                EXTRACT ONE BYTE
         SLS,R0   0,R5              SHIFT IT TO THE CORRECT LOCATION
         AW,D4    R0                ADD ZONE BIT TO MAP ACCUMULATOR
SETNUM   LI,R0    NUMBIT            SET UP NUMERIC BIT
         SLS,R5   -12               PUT NUMERIC IN RIGHT PLACE
         LCH,R4   R5                NEGATE THE NUMERIC FIELD
         LI,R5    KFF               SET UP A ONE BYTE MASK
         LS,R5    R4                EXTRACT SHIFT COUNT
         SLS,R0   0,R5              SHIFT IT TO THE CORRECT LOCATION
         EOR,D4   R0                ADD NUMERIC BIT TO MAP ACCUM.
CHKINRDN BIR,R2   CHAR2             IF WE HAVE ONLY DONE 1 CH.GET 2ND
         LI,R5    KN3               SET UP INDE
         AI,R3    K3                SET INDEX FOR 3RD BYTE
LDNXT    STB,D4   *D3,R3            STORE RIGHTMOST BYTE
         SLS,D4   -8                MOVE NEXT BYTE INTO PLACE
         AI,R3    KN1               DECREMENT STORAGE INDEX
         BIR,R5   LDNXT             IF NOT DONE, STORE NEXT BYTE BY LOOP
         AI,R3    K3                SET BUFFER INDEX AFTER 3 BYTES
         BIR,R1   CHAR1             IF WE HAVE ONLY DONE 2 CHAR.REPEAT
         PULL     9,D2              RESTORE REGISTERS
BISR4    B        *SR4              RETURN
*                 FOR CPV-A00 SLEEP IF NO MPOOLS
IOGETBF  EQU      %
         PUSH     1,SR4
         BAL,SR4  GMB
         LW,D3    D3
         BEZ      %-2
         B        PULLEXIT
         SPACE    3
         SPACE    3
         REF      Y3
         REF      PULLALLEXIT,X1FFFF
         REF      PUSHALL,CHKBIT1
         REF      CKLIMIT,MSRRDWT,RESBTD
         DEF      MSROCTY,MSRTYPR
         PAGE
         PAGE
*                                   THIS ROUTINE HANDLES THE PRINT AND
*                                   TYPE OPTIONS
*                                   R5 = JIT
*                                   R6 WILL GET USED FOR DCB ADDRESSES
*                                   R7 = PLIST
*                                   SR1 = 1 IF PRINT OP
*                                       =2 IF TYPE OP
*                                   CALLING SEQUENCE--BAL,SR4 MSRTYPR
MSROCTY  EQU      %
         LI,R6    M:OC
         B        MSRTY0
MSRTYPR  EQU      %
         LI,R6    M:OC
         LW,R1    J:JIT
         BGEZ     MSRTY0
         LI,R6    M:UC
MSRTY0   RES      0
         REF      M:UC
         BAL,R1   PUSHALL
MSRTY1   EQU      %
         BAL,R2   CHKBIT1
         B        %+1
         REF      T:ABORTM
         LW,R7    D1
         LI,D4    0
         BAL,R0   CKLIMIT
         BCR,2    %+2
         BCS,1    ABORT
         LW,SR4   Y3
         LI,SR2   0
         LB,D2    *D1               SIZE
         PUSH     3,SR4
         LW,R7    TSTACK
         AI,R7    -3
         LCI      3
*
         CI,SR1   K1
         BNE      MSRTYPR2
*
*
         LW,R6    J:DCBLINK
         AI,R6    1
LOCDCB1  LW,D3    0,R6
         LB,D1    D3
         CI,D1    K4
         BNE      LOCDCB2
         LW,D4    1,R6
         SLD,D3   8
         CW,D3    M:LL
         BNE      LOCDCB2
         LW,SR2   R6
         LW,R6    2,R6
*
MSRTYPR2 EQU      %
         BAL,D4   GETBTD
         PUSH     1,R4
         LI,D1    K1
         BAL,R0   RESBTD
         LI,R5    J:JIT
         LI,SR1   X'11'
         BAL,11   MSRRDWT
         PULL     1,D1              RESTORE BTD
         BAL,R0   RESBTD
MSRTYPR3 EQU      %
         BUMP     -3,R1
         B        PULLALLEXIT
LOCDCB2  EQU      %
         AI,D1    K8
         SLS,D1   -2
         AW,R6    D1                NEXT ENTRY
         LB,D1    *R6
         BNEZ     LOCDCB1
         LW,R6    0,R6
         AND,R6   X1FFFF
         BEZ      MSRTYPR3          NO M:LL :=> NOP
         AI,R6    K1
         B        LOCDCB1
ABORT    EQU      %
         LI,11    X'4A'
         B        T:ABORTM
         CLOSE    BUFX  SINCE 'BUFX' IS DEFINED IN SYSTEM UTS ALSO
         END

