**************************************************************
*M*      COMJRNL  COMMON JOURNAL MONITOR SERVICE
**************************************************************
*P*
*P*      NAME:    COMJRNL, COMMON JOURNAL ROUTINE.
*P*
*P*      DESCRIPTION:  THE COMMON JOURNAL ROUTINE HANDLES ALL
*P*               OUTPUT TO THE 'JRNL' ASSIGNMENT TYPE DCB.
*P*               THE METHOD IS SIMPLY TO QUEUE THE REQUESTS
*P*               TO THE (TAPE) DEVICE THROUGH IOQ.  A
*P*               SINGLE CFU (OBTAINED BY THE TPG) IS USED TO
*P*               MONITOR USER COUNTS, NUMBER OF RECORDS WRITTEN,
*P*               ETC.  ERRORS AND END-OF-TAPE INDICATIONS ARE
*P*               PASSED BACK TO THE USER IN THE ECB AND/OR
*P*               AS AN ERROR CODE IN REGISTER 12.
*P*
         TITLE    'COMMON JOURNAL MONITOR SERVICE'
         PCC      0
MONPROC  SET      1
         SYSTEM   UTS
         DEF      COMJRNL           COMMON JOURNAL MONITOR SERVICE
         REF      SETTYC            SET TYPE OF COMPLETION
         REF      QUEUE1            QUEUE THE I/O REQUEST
         REF      MSREXIT           RETURN TO USER
         REF      PUTSZBF1          BUF->QBUF, RWS->BLK.
         REF      SETBTDQ           UBTD->HBTD.
         REF      CLRMBG            0->MBG.
         REF      T:GJOBSTRT        GJOB START OF THE 'TPG' TO
*,*                                 REPORT END OF VOLUME ON THE COMMON
*,*                                 JOURNAL.
         REF      MASKS             MASKS.
         DEF      CJ:               PATCHING DEF
CJ:      RES
         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      %
         BAL,R11  PUTSZBF1          DCB: BUF->QBUF, RWS->BLK.
         BAL,R15  SETBTDQ           DCB: UBTD->HBTD.
         BAL,R15  CLRMBG            DCB: 0->MBG.
         LI,R1    X'1FFFF'
         AND,R1   CJCFUA,R6         R1= CJ CFU ADDRESS.
         LI,R2    TDA*2
         LH,R12   *R1,R2              FETCH DEVTYPE/ADDR OR ERRCODE.
         CI,R12   X'FF00'             IS DEVTYPE OR ERROR...
         BAZ      COMJ100           --->ERROR.
         LI,R3    DSI*2+1             DEVTYPE.
         STH,R12  *R6,R3              PUT INTO DCB.
         LI,R1    BAFCN
         MTB,1    *R6,R1            INCREMENT FUNCTION COUNT
         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,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
         BAL,R11  QUEUE1            QUEUE I/O WITH DCB AND END-ACTION
         B        MSREXIT           ALL DONE
         PAGE
*
*        ERROR HANDLING
*
         SPACE    2
COMJ100  EQU      %
         AI,R12   EOR-X'1C'           ASSUME END-OF-TAPE.
         CI,R12   EOR                 IS IT REALLY...
         BE       %+2               --->YES.
         LI,R12   WRTERR              NO. MUST BE WRITE ERROR.
         BAL,R0   SETTYC              R12->DCB:TYC; CLEAR DCB:EGV.
         B        MSREXIT           --->RETURN & CVT TYC TO ERRCODE.
         PAGE
EOR      EQU      5
WRTERR   EQU      9
CJEA     EQU      %
         LW,R4    R8                R4= DCBADDR (INTO INDEX REG.)
         LI,R2    X'1FFFF'
         AND,R2   CJCFUA,R4         R2= CJ CFU ADDRESS.
         LI,R6    TYC*4+1
         LB,R6    *R4,R6
         SLS,R6   -1                R6= DCB:TYC.
         CI,R6    WRTERR              IS IT A WRITE ERROR...
         BNE      CJEA050           --->NO.
         LI,R5    X'45'               YES. GET ERRCODE FOR ERROR
         B        CJEA100           --->AND REPORT TO TPG.
CJEA050  EQU      %                   NOT A WRITE ERROR, SO
         MTW,1    SREC,R2             COUNT RECORD AS WRITTEN.
         CI,R6    EOR                 IS IT END-OF-TAPE...
         BNE      *R11              --->NOT ERR/EOT ARE OK FOR CJ.
         LI,R5    X'1C'               YES. GET ERRCODE FOR EOT
CJEA100  EQU      %                   AND REPORT TO TPG.
         LI,R7    TDA*2               POINT TO LEFT HALFWORD OF TDA
         STH,R5   *R2,R7              CLEAR DCTX; SHOW ERROR TO TPG.
         PUSH     10,R2               SAVE REGS ACROSS GJOBSTART.
         LD,R0    CJEATPG           FETCH TPG NAME
         BAL,R10  T:GJOBSTRT        GIVE TPG A JOLT
         PULL     10,R2               RESTORE REGS.
         CI,R5    X'1C'               WAS IT END-OF-TAPE...
         BNE      *R11              --->NO; ALL DONE. (WRITE ERROR)
         LI,R6    1
         LW,R7    MASKS+7
         SLD,R6   17                RESET TYC TO 1 BECAUSE
         STS,R6   TYC,R4              RECORD WAS ACTUALLY WRITTEN.
         AI,R3    0                 CHECK FOR ECB
         BEZ      *R11              NONE, ALLDONE
         SLS,R6   7                   ALIGN TYC TO PLACE FOR ECB.
         STW,R6   2,R3                TYC->W2 OF 4-WD BLK FOR ECB.
         B        *R11              SKIP COUNTING BLOCKS
         BOUND    8
CJEATPG  TEXTC    'TPG'
         TEXT     '    '
         END

