* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
*
*                         Program CHECKDS
*
*  Function:
*    check for possible corruption of data sets on disks.
*
*  Entrance:
*    The field PARM of the JCL operator EXEC should contain -
*      "SET"   - compute checksums of the data sets listed in the file SYSPARM
*                and record the results into that file
*      "CHECK" - compute checksums of the data sets listed in the file SYSPARM
*                and compare with the previously recorded checksums
*    The file SYSPARM should contain 80-byte records, specifying the data sets
*    to verify:
*      Record pos 1-6   - the name of the volume where the data set is located
*      Record pos 8-51  - the full name of the data set
*      Record pos 53-69 - the date and time of the computed checksum
*      Record pos 73-80 - the checksum of the data set
*    The last two fields are recorded in the SET mode.
*    The file SYSUT DD DUMMY is used for allocating/opening of data sets
*    The file SYSSNAP describes the data set for diagnostic messages.
*
* Exit:
*   BR 14, as usual.
*
* Algorithm:
*   A data set is sequentially read into a buffer, and its checksum
*   is computed by the mod 2**32 summation. EODAD signals the end of the
*   data set. The input buffer is cleared with zeroes before each read.
*   The buffer length is the largest block size of the data set,
*   rounded up to the integral number of words.
*   Processing of libraries has two peculiarities:
*     1) Buffer length = MAX(dictionary block size (i.e. 256),
*                            max block size of library members)
*     2) Records of zero size are ignored, with the help of
*        the custom appendix "Channel end". That is, reading zero-size
*        records does not raise EODAD. The end of data is determined by
*        the end of library extents. Thus, the library is processed
*        as if it were one large sequential data set, within which
*        there may occur records of zero size.
*  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
         EJECT
*                          Registers' Usage
R0       EQU   0
R1       EQU   1      work and link registers
R14      EQU   14
R15      EQU   15
RW       EQU   2    work register
RL       EQU   3    loop & length register
RP       EQU   10   @ current sysparm record
RBASE    EQU   13   base register
RBASE1   EQU   12   subroutine's base register
         SPACE
         PRINT NOGEN
         BLOCK (0-14),VS,CHECKDS
*        TRACER STAT=NO P=(CSALL,CSLOOP)
***********************************************************************
*                          Initialization
         SPACE
         L     R1,0(R1)                @ parmstring
         MVI   MODE,C'C'
         CLC   MCHECK,0(R1)            set the program mode -
         BE    *+18                         'S' (SET mode)
         CLC   MSET,0(R1)                         or
         BNE   ERR1                           'C' (CHECK mode)
         MVI   MODE,C'S'
         SPACE
         OPEN  (SYSPARM,(UPDAT))
         TM    48+SYSPARM,X'10'
         BNO   ERR2                    opening failure
         SPACE
         DATIME LINK,A=FORDATIM        get date and time
         SPACE
         PUTS  'CHECKDS 1.0',#20,'check preservation of D.S. on disk', *
               #65,'mode ',-
         LA    RW,=CL5'CHECK'
         CLI   MODE,C'C'
         BE    *+8
         LA    RW,=CL5'SET'
         PUTS  (0(RW),5),#90,'Date  ',(TIMEDATE+9,8,C),'  TIME ',      *
               (TIMEDATE,8,C),/,('-',120),/,'Volume',#20,              *
               'data set name',#54,'time     date           checksum'
         EJECT
***********************************************************************
*			The main loop
MAINLOOP EQU   *
         GET   SYSPARM                 get the new SYSPARM record
         LR    RP,R1                   save the record ptr
         USING PARMRECD,RP
         CLI   MODE,C'S'               set the date and time
         BNE   *+10                       in the SYSPARM record
         MVC   PARMDT,TIMEDATE              when in the SET mode
         SPACE
         PUTS  (PARMREC,PARMKC-PARMREC),'   ',-
         SPACE
         INTO  CHECKSUM                put the checksum into KC
         LTR   R15,R15
         BNZ   ERR3                    check for errors during CHECKSUM
         SPACE
         CLI   MODE,C'S'
         BE    MLS                     set the checksum in SYSPARM recd
         SPACE 3
*                      Check mode: check KC
         PUTS  (PARMKC,8,C),-
         CLC   PARMKC,KC               compare the check sums
         BE    MLCOK                   branch if match
         PUTS  ',  NEW CHECK SUM ',(KC,8,C),' *****',-
MLCOK    PUTS
         B     MAINLOOP
         SPACE 3
*               Set mode: record the new KC
MLS      MVC   PARMKC,KC               record the checksum
         PUTX  SYSPARM                 update the SYSPARM record
         PUTS  (PARMKC,8,C)
         B     MAINLOOP
         EJECT
***********************************************************************
*                        Finish
EOJ      EQU   *
         CLOSE (SYSPARM)
         PUTS  #42,'* * * * *   E N D   O F   J O B   * * * * *'
         BEND
         EJECT
***********************************************************************
*                        Error handling
ERR1     EQU   *  Error in specifying the processing mode
         PUTS  'Incorrect parameter string - neither "SET" nor "CHECK"'
         B     EOJ
         SPACE 2
ERR2     EQU   *  Error opening SYSRARM
         PUTS  'Cannot open the file SYSPARM'
         B     EOJ
         SPACE 2
ERR3     EQU   *  Error in computing the checksum, R15 = error code
         L     RW,MESTAB@-4(R15)
         PUTS  (0(RW),25)
         B     MAINLOOP
         EJECT
***********************************************************************
*		Subroutine CHECKSUM
*
* Entrance:
* VOLSER - volume name, DSNAME - the name of the data set to check
*
* Exit:
*   8-byte field KC contains the checksum of the given data set
*   ( in symbolic hex form  ).
*   R15 = return code:
*     0  - success
*     4  - requested volume not mounted
*     8  - requested data set not found
*     12 - i/o error on VTOC
*     16 - i/o error
*     20 - no DDNAME SYSUT
         SPACE
RB       EQU   4     input buffer ptr
RC       EQU   5     checksum register
         SPACE
CHECKSUM BLOCK (0-14),N,BASE=12
         SPACE
         LA     R1,DSNAME
         ST     R1,CAMLST+4
         LA     R1,VOLSER
         ST     R1,CAMLST+8
         OBTAIN CAMLST                 obtain DSCB1
         LTR   R15,R15
         BNZ   CSEND                   if an error occurred
         SPACE
*           Set  DCBBLKSIZE and check if the data set is a library
         MVC   DCBBLKSI,DSCBLKSI       set DCBBLKSI from DSCB1
         MVI   FPO,C'N'
         TM    DSCDSORG,X'02'
         BNO   CSALL                   branch if not a library
         MVI   FPO,C'Y'                set flag
         LA    R1,256
         CH    R1,DCBBLKSI             set DCBBLKSI = MAX(256,
         BNH   *+8                                    max block lngth)
         STH   R1,DCBBLKSI
         SPACE 2
*                      Allocating the data set
CSALL    MVC   JFCBDSNM,DSNAME
         MVC   JFCBVOLS,VOLSER
         GETCB UCB,VOL=VOLSER,REG=RW   get @UCB (volume is mounted)
         GETCB TIOTDD,DDNAME='SYSUT',REG=RL,NOTFND=CSNSUT
         LA    R1,1
         INTO  NEWPSW,V                get the zero storage key
         STH   RW,18(RL)               set @UCB in the TIOT entry
         LA    R1,3
         INTO  NEWPSW,V                restore the storage key
         OPEN  (DCB,(INPUT)),TYPE=J
         EJECT
*                     Allocating the input buffer
         LH    R1,DCBBLKSI             max block size
         LA    R1,3(R1)                round up to
         SRA   R1,2                      the integral number of words
         SLA   R1,2                         
         STH   R1,BUF#                 save the buffer length
         GETMAIN R,LV=(R1)
         LR    RB,R1                   save the buffer ptr
         SPACE 2
* In case of a library,
* Set the DEB pointer to our appendix "End of Channel"
         CLI   FPO,C'Y'
         BNE   CSLOOPP                 branch if not a library
         SPACE
         LA    R1,1
         INTO  NEWPSW,V                get the zero storage key
         SPACE
         L     RW,DCBDEBAD             @ DEB
         LA    RW,0(RW)
         SH    RW,=H'24'               @ @ "CHANNEL END" appendix
         LA    R1,POCEA                @ our APPENDIX
         ST    R1,0(RW)                  --> DEB
         SPACE
         LA    R1,3
         INTO  NEWPSW,V                restore the storage key
         EJECT
*----------------------------------------------------------------------
*    The main loop of reading the data set and computing its checksum
CSLOOPP  EQU   *                       prepare to main loop
         SR    RC,RC                   clear the checksum register
CSLOOP   EQU   *
         SPACE
*                       Clear the input buffer
         LH    RL,BUF#                 buffer length
         LR    RW,RB                   buffer ptr
CSL1     SH    RL,=H'256'
         BNH   CSL1EX
         XC    0(256,RW),0(RW)
         LA    RW,256(RW)
         B     CSL1
CSL1EX   AH    RL,=H'255'              remainder length - 1
         EX    RL,XC                   clear the remainder
         SPACE
         READ  DECB,SF,DCB,(RB),'S'
         CHECK DECB
         SPACE
*                    Computing the check sum
         SR    RL,RL
CSL2     AL    RC,0(RL,RB)             accumulate the checksum
         LA    RL,4(RL)                to the next buffer word
         CH    RL,BUF#
         BM    CSL2
         SPACE 2
         B     CSLOOP                  Keep on reading
         SPACE
*----------------------------------------------------------------------
*            Finishing. Error Handing.
         SPACE
CSSYN    EQU   *         Irrecoverable input error
         LA    R15,16
         B     CSEND
         SPACE 2
CSNSUT   EQU   *         No DDNAME "SYSUT"
         LA    R15,20
         B     CSEND
         SPACE 2
CSEOD    EQU   *         End of reading of the data set
         CLOSE (DCB)
         LH    R1,BUF#
         FREEMAIN R,LV=(R1),A=(RB)
         SPACE
         ST    RC,WORK                 Convert the checksum
         UNPK  KC(9),WORK(5)            into the hex format
         TR    KC,TRTAB-C'0'
         SR    R15,R15
CSEND    BEND
         EJECT
***********************************************************************
*      "End of Channel" Appendix routine when processing a library
*
* Entrance:
*   R1  = @RQE,      R2  = @IOB,        R3  = @DEB,       R4  = @DCB,
*   R7  = @UCB,      R14 = RETURN,      R15 = EPA
*   The appendix is executed in the supervisor mode with disabled
*   interrupts. 
*   Bit IOBEX is zero - successful completion of the channel operation
*   Bit IOBEX is one  - there has been a size error, or a zero-length
*   record has been read. We can tell which is which by examining
*   the unit and the channel status bits in CSW in IOB.
*
* Exit:
*   BR R14.
*   If the bit IOBEX has been set and a zero-length record has read,
*   reset IOBEX
         SPACE
RIOB     EQU   2     IOB ptr
         SPACE
IOBFLAG1 EQU   0     IOB flag 1
IOBEX    EQU   X'04' IOB flag 1 - exception bit
IOBUSTAT EQU   12    unit status byte in CSW in IOB
IOBCSWEC EQU   X'01' unit exception bit in IOBUSTAT
         SPACE 2
POCEA    EQU   *
         USING *,R15
         TM    IOBFLAG1(RIOB),IOBEX    Q. successful channel end
         BZR   R14                     yes - exit
         TM    IOBUSTAT(RIOB),IOBCSWEC Q. unit exception (zero record)
         BZR   R14                     no - exit
         NI    IOBFLAG1(RIOB),255-IOBEX reset the IOBEX bit
         BR    R14
         DROP  R15
         EJECT
***********************************************************************
*                    Constants and work fields
         SPACE
XC       XC    0(1,RW),0(RW)
         SPACE
TRTAB    DC    C'0123456789ABCDEF'     for hex number conversion
MESTAB@  DC    A(MESER1,MESER2,MESER3,MESER4,MESER5)
MESER1   DC    CL25'VOLUME NOT MOUNTED'
MESER2   DC    CL25'DATA SET NOT FOUND'
MESER3   DC    CL25'I/O ERROR ON VTOC'
MESER4   DC    CL25'I/O ERROR'
MESER5   DC    CL25'NO SYSUT DD STATEMENT'
         SPACE
MCHECK   DS    0CL7
         DC    AL2(5),C'CHECK'
MSET     DS    0CL5
         DC    AL2(3),C'SET'
         SPACE
SYSPARM  DCB   DSORG=PS,MACRF=(GL,PL),DDNAME=SYSPARM,LRECL=80,         *
               EODAD=EOJ
DCB      DCB   DSORG=PS,RECFM=U,MACRF=(R),DDNAME=SYSUT,EODAD=CSEOD,    *
               SYNAD=CSSYN,EXLST=EXLST
DCBBLKSI EQU   DCB+62,2                BLOCK SIZE
DCBDEBAD EQU   DCB+44,4                @ DEB
         SPACE
CAMLST   CAMLST SEARCH,1,3,DSCB
DSCB     DS    0D                      DATA SET CONTROL BLOCK (FORM1)
         DS    CL148
DSCDSORG EQU   DSCB+38,1               DSORG, X'02' = PO
DSCBLKSI EQU   DSCB+42,2               BLOCK SIZE
         SPACE
EXLST    DC    X'87',AL3(JFCB)
JFCB     DC    XL176'00'               JOB FILE CONTROL BLOCK
         ORG   JFCB
JFCBDSNM DS    CL44                     data set name
         DC    CL8' '                   no member name
         DC    X'08'                    do not write this JFCB onto disk
         ORG   JFCB+70
         DC    AL2(1)                   volume serial number
         ORG   JFCB+86
         DC    X'00'                    indicator byte 1
         DC    X'40'                    DISP=OLD
         ORG   JFCB+117
         DC    AL1(1)                   volume number
JFCBVOLS DS    CL6                      volume name
         ORG
         SPACE
         LTORG
         SPACE
WORK     DS    F                       for checksum conversion
KC       DS    CL8                     calculated checksum
         DS    X                       1 extra bit for the UNPK instruction
BUF#     DS    H                       input buffer length
         SPACE
FORDATIM DS    0F                      for use of the DATIME routine
         DS    7H
TIMEDATE DS    CL17                    time & date
         DS    CL5
         SPACE
MODE     DS    C                       program mode - "C" or "S"
FPO      DS    C                       if DSORG=PO
         SPACE
PARMRECD DSECT                         SYSPARM record
PARMREC  DS    CL80
VOLSER   EQU   PARMREC+0,6             volume name
DSNAME   EQU   PARMREC+7,44            data set name
PARMDT   EQU   PARMREC+52,17           date & time
PARMKC   EQU   PARMREC+72,8            checksum
         END
