         TITLE    'COMMON JOURNAL MONITOR SERVICE'
         PCC      0
MONPROC  SET      1
         SYSTEM   UTS
         DEF      COMJRNL
         REF      SETTYC
         REF      QUEUE1
         REF      MSREXIT
         REF      CJEA
         REF      S:CUN
         REF      J:RWECB
         REF      MASKS
         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
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
CJCFUA   EQU      11
         PAGE
COMJRNL  EQU      %
         LW,R1    CJCFUA,R6         FETCH CJ CFU ADDRESS
         AND,R1   MASKS+17          REMOVE ANY EXTRANEOUS BITS
         LI,R2    TDA*4             POINT TO TDA IN CFU
         LB,R0    *R1,R2            FETCH DCT INDEX
         BEZ      COMJ100           IF ZERO, CJ IS SUSPENDED
         SLS,R2   -1                POINT TO TDA HALFWORD
         LH,R0    *R1,R2            FETCH DEVF,TYPE,DEV
         LI,R2    DSI*2+1           UPDATE DCT INDEX IN DCB
         STH,R0   *R6,R2
         LI,R1    BAFCN
         MTB,1    *R6,R1            INCREMENT FUNCTION COUNT
         LI,R8    0                 CLEAR REGISTER
         LI,R9    X'1FFFF'          FORM ADDRESS MASK
         LS,R8    BUF,R6            FETCH BUFFER ADDRESS
         STS,R8   QBUF,R6           AND INPUT TO IOQ
         LI,R0    2                 SET EOP TO
         LI,R1    3                 INDICATE LAST OPERATION
         SLD,R0   18                THROUGH DCB WAS A
         STS,R0   EOP,R6            WRITE REQUEST
         LW,R0    MBG,R6            INDICATE TRANSFER
         AND,R0   NB31TO0+24        DIRECT FROM
         STW,R0   MBG,R6            USER STORAGE
         SLS,R0   2                 SET HBTD FOR INPUT
         LI,R1    X'C0'             TO IOQ
         STS,R0   BTD,R6            AS BUFFER BYTE OFFSET
         LW,R8    R6                SETUP R8 FOR IOQ
         LI,R1    6                 FCN CODE IS 06 (WRITE)
         STB,R1   R8                AND STORED WITH DCB ADDRESS
         LI,R9    CJEA              END-ACTION ROUTINE ADDRESS
         LW,R10   R3                SETUP EAI (NONZERO IF ECB)
         BAL,R11  QUEUE1            QUEUE I/O WITH DCB AND END-ACTION
         B        MSREXIT           ALL DONE
         PAGE
*
*        ERROR HANDLING
*
         SPACE    2
COMJ100  EQU      %
         LI,R2    TDA*4+1           FETCH BYTE ONE OF TDA
         LB,R2    *R1,R2            FETCH OUTSTANDING ERROR CODE
         LW,R3    J:RWECB           CHECK FOR ECB ON REQUEST
         AND,R3   MASKS+17          MASK DOWN TO ADDRESS
         BEZ      COMJ200           NO ECB
         LW,R0    R2                TRANSFER CODE TO WORK REGISTER
         LI,R1    2
         STB,R1   R0                ESTABLISH SUBCODE AS 1
         SCS,R0   8
         LI,R1    X'FF'
         STB,R1   R0                SET UP ECB COMPLETION CODE
         STW,R0   2,R3              AND STORE IT IN ECB BLOCK
COMJ200  EQU      %
         LI,R12   5                 ASSUME EOT
         CI,R2    X'1C'             IS IT REALLY EOT
         BE       %+2               YES
         LI,R12   9                 NO, MUST BE WRITE ERROR
         BAL,R0   SETTYC            SET PROPER TYC AND EGV
         B        MSREXIT           RETURN TO USER
         END

