TITLE 'NVCSGET - PUNCH VSE FILE TO CMS'
NVCSGET  CSECT
**********************************************************************
*   THIS PROGRAM RETRIEVES DATA FROM VSE SEQUENTIAL FILE             *
*   FILE DEFINITION PASSED BY PARM= ON // EXEC                       *
*   CALLS DDPUT TO PUNCH DATA TO CMS IN DISK DUMP FORMAT             *
**********************************************************************
*                                                                    *
**********************************************************************
*        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
         EJECT
         STM   R14,R12,12(R13)         * SAVE ENTRY REGS
         BALR  R12,R0                  * ESTABLISH BASE
        USING  *,R12
         LR    R2,R13                  * CALLER SAVEAREA
         LA    R13,SAVEAREA            * MY SAVEAREA
         ST    R2,4(R13)               * SAVEAREA BWD POINTER
         ST    R13,8(R2)               * SAVEAREA FWD POINTER
PARM0000 DS    0H
         CR    R1,R15                  * ANY PARM PASSED
         BE    ERROR01                 * NO
         L     R1,0(,R1)               * POINT TO PARM STRING
         LA    R2,2(,R1)               * PAST LENGTH
        USING PARM,R2
         MVC   FNAME,PFNAME            * FOR DDPUT
         MVC   FTYPE,PFTYPE            * FOR DDPUT
         MVC   RECFM,PRECF             * SAVE RECFM
         CLI   PRECF,C'V'              * VARIABLE ?
         BNE   PARM0100                * NO - CHECK FIXED
         BAL   R10,OPNV0000            * OPEN VARIABLE INPUT
         B     MAIN0000                * GET ON WITH IT
PARM0100 DS    0H
         CLI   PRECF,C'F'              * FIXED ?
         BNE   ERROR02                 * NO
         LA    R3,5                    * LOOP COUNT
         LA    R4,PRECL                * PARAMETER LRECL
PARM0200 DS    0H
         CLI   0(R4),C'0'
         BL    ERROR03                 * < 0
         CLI   0(R4),C'9'
         BH    ERROR03                 * > 9
         LA    R4,0(,R4)               * NEXT CHAR
         BCT   R3,PARM0200             * LOOP
         PACK  PACKRECL,PRECL          * PACK LRECL
         BAL   R10,OPNF0000            * OPEN FIXED INPUT
        DROP R2
MAIN0000 DS    0H
         LA    R6,IOAREA               * WORKA AREA
         GET   (9),(6)                 * GET DATA
         CLI   RECFM,C'F'              * FIXED ?
         BE    MAIN0100                * YES
         LH    R1,IOAREA               * RDW
         SH    R1,=H'4'                * DECREMENT FOR RDW
         STH   R1,LRECL                * DATA LENGTH
MAIN0100 DS    0H
         LA    R1,PLIST                * DDPUT PLIST
         L     R15,=V(DDPUT)           * DDPUT
         BALR  R14,R15                 * CALL
         LH    R15,RC                  * RETURN CODE
         LTR   R15,R15                 * OK ?
         BNZ   ERROR04                 * NO
         B     MAIN0000                * GET NEXT
*
TERM0000 DS    0H
         CLOSE (9)                     * CLOSE INPUT FILE
         MVI   FUNC,C'E'               * DDPUT TERMINATE
         LA    R1,PLIST                * DDPUT PLIST
         L     R15,=V(DDPUT)           * DDPUT
         BALR  R14,R15                 * CALL
         LH    R15,RC                  * RETURN CODE
         LTR   R15,R15                 * OK ?
         BNZ   ERROR04                 * NO
         L     R13,SAVEAREA+4          * PRIOR SAVEAREA
         LM    R14,R12,12(R13)         * ENTRY REGS
         XR    R15,R15                 * RC = 0
         BR    R14                     * RETURN TO VSE
*
CANC0000 DS    0H                      * GOING ... GOING ...
         CANCEL ,                      * GONE
         DC    H'0'                    * FOR SURE
*
OPNF0000 DS    0H
         LA    R9,FIXBLK
        USING PARM,R2
        USING DTFSIFB,R9
         MVC   SIFBDDN(7),PFNAME       * DDNAME
         CVB   R1,PACKRECL             * LRECL
         ST    R1,SIFBRECL             * TO DTF
         STH   R1,LRECL                * FOR DDPUT
         LA    R1,IOAREA               * IO AREA
         ST    R1,RECADDR              * ADDRESS FOR DDPUT
         OPEN  (9)
         BR    R10
        DROP   R2,R9
*
OPNV0000 DS    0H
         LA    R9,VARBLK
        USING PARM,R2
        USING  DTFSIVB,R9
         MVC   SIVBDDN(7),PFNAME       * DDNAME
         LA    R1,IOAREA+4             * IO AREA PAST RDW
         ST    R1,RECADDR              * ADDRESS FOR DDPUT
         OPEN  (9)
         BR    R10
        DROP   R2,R9
*
ERROR01  DS    0H
         WTO   'NO PARM SUPPLIED'
         B     CANC0000
ERROR02  DS    0H
         WTO   'RECFM MUST BE F OR V'
         B     CANC0000
ERROR03  DS    0H
         WTO   'LRECL INVALID'
         B     CANC0000
ERROR04  DS    0H
         WTO   'BAD RETURN CODE FROM DDPUT - ABENDING'
         DC    H'0'
*
FIXBLK   DTFSD BLKSIZE=MAX,EOFADDR=TERM0000,                           *
               DEVADDR=SYS030,RECFORM=FIXBLK,                          *
               TYPEFLE=INPUT,RECSIZE=100,WORKA=YES,TRUNCS=YES
*
VARBLK   DTFSD BLKSIZE=MAX,EOFADDR=TERM0000,                           *
               DEVADDR=SYS030,RECFORM=VARBLK,                          *
               TYPEFLE=INPUT,WORKA=YES
*
PACKRECL DS    D                       * RECORD LENGTH
SAVEAREA DS    9D                      * SAVE AREA
*
PLIST    DS    0F                      * DDPUT PLIST
         DC    A(FUNC)                 * FUNCTION CODE
         DC    A(CMSFILE)              * CMS FN FT FM
         DC    A(LRECL)                * RECORD LENGTH
         DC    A(RC)                   * RETURN CODE
RECADDR  DC    A(0)                    * RECORD ADDRESS
         DC    A(0)                    * TERMINATOR (UNUSED)
*
         DS    0D
         DC    CL16'*** DDPUT PARMS'
LRECL    DS    H                       * RECORD LENGTH
RC       DS    H                       * RETURN CODE
CMSFILE  DS    0CL18                   * CMS FILE NAME
FNAME    DC    CL8'ERROR'              * FNAME
FTYPE    DC    CL8'FILE'               * FTYPE
         DC    CL2'A1'                 * FMODE
FUNC     DC    C'P'                    * DDPUT FUNCTION
RECFM    DS    C                       * SAVED RECFM
         LTORG
         DS    0D
         DC    CL16'*** IOAREA ***'
IOAREA   DS    XL32767                 * IO AREA
*
*        DSECT FOR PASSED PARAMETER
*
PARM     DSECT                         * PASSED PARAMETER
PFNAME   DS    CL8                     * DATA FILENAME/DDNAME
         DS    C
PFTYPE   DS    CL8                     * DATA FILETYPE
         DS    C
PRECF    DS    C                       * F OR V
         DS    C
PRECL    DS    CL5                     * RECORD LENGTH (FIXED ONLY)
         EJECT
************************************************************
*                                                          *
*        DTFSD FIXBLK INPUT                                *
*                                                          *
************************************************************
*
DTFSIFB  DSECT
SIFBDTF  DS    XL6           CCB
         DS    AL1           LOGICAL UNIT CLASS
SIFBLU   DS    AL1           LOGICAL UNIT NUMBER
SIFBCCWA DS    A             CCB-CCW ADDRESS            (SIFBCCW)
         DS    4X            CCB-ST BYTE,CSW CCW ADDRESS
         DS    AL1
         DS    XL3           LOGIC MODULE ADDRESS
         DS    X             DTF TYPE
         DS    AL1           OPEN/CLOSE INDICATORS
SIFBDDN  DS    CL7           FILENAME
         DS    X             INDICATE 2311
         DS    6X            BCCHHR ADDR OF F1 LABEL IN VTOC
         DS    2X            VOL SEQ NUMBER
         DS    X             OPEN COMMUNICATIONS BYTE
         DS    X             XTENT SEQ NO OF CURRENT EXTENT
         DS    X             XTENT SEQ NO LAST XTENT OPENED
SIFBULA  DS    AL3           USER'S LABEL ADDRESS   (*)
         DS    X             DATAFILE VERSION 3 BIT
SIFBIOA  DS    AL3           ADDRESS OF IOAREA (ACTUALLY *)
         DS    XL4           CCHH ADDR OF USER LABEL TRACK
         DS    2X            LOWER HEAD LIMIT
         DS    4X            XTENT UPPER LIMIT
SIFBSEEK DS    2X            SEEK ADDRESS-BB
SIFBSRCH DS    XL4           SEARCH ADDRESS-CCHH
         DS    X             RECORD NUMBER
SIFBEODA DS    AL3           EOF ADDRESS
         DS    4X            CCHH CONTROL FIELD
         DS    AL1           R    CONTROL FIELD
         DS    B
SIFBBLKS DS    AL2           SIZE OF BLOCK-1
         DS    5X            CCHHR BUCKET
         DS    3X
         DS    2H            NOP   0
SIFBDB1  DS    A             DEBLOCKER-INITIAL POINTER  (*)
SIFBRECL DS    F             DEBLOCKER-RECORD SIZE
SIFBDBL  DS    A             DEBLOCKER LIMIT         (*+BLKSIZE-1)
         DS    AL1           LOGICAL INDICATORS
SIFBERR  DS    AL3           USER'S ERROR ROUTINE OR 0
SIFBCCW  DS    X             COMMAND SEEK
SIFBCA1  DS    AL3           (SIFBSEEK)
         DS    XL4           FLAGS AND LENGTH
SIFBCCW2 DS    X             COMMAND SEARCH ID EQUAL
SIFBCA2  DS    AL3           (SIFBSRCH)
         DS    XL4           FLAGS AND LENGTH
SIFBCCW3 DS    X             COMMAND TIC
SIFBCA3  DS    AL3           (SIFBCCW2)
         DS    XL4           FLAGS AND LENGTH
SIFBCCW4 DS    X             COMMAND READ DATA
SIFBCA4  DS    AL3           (SIFBCCW4)
         DS    XL2           FLAGS
SIFBCBKS DS    XL2           LENGTH   (BLOCKSIZE)
SIFBCCW5 DS    X             COMMAND READ COUNT
SIFBCA5  DS    AL3           (SIFBCNT)
         DS    XL4           FLAGS AND LENGTH
SIFBCNT  DS    2F'0'         COUNT AREA
SIFBV3   DS    0F            TO FORCE ALIGNMENT
         DS    AL1           1ST VERSION 3 FLAG
         DS    B             2ND VER 3 FLAG
         DS    AL2           VERSION 3 FLAGS
         DS    AL4           CISIZE IF PRESENT
         DS    AL4           PHYSICAL BLOCK SIZE
         DS    AL2           NUMBER OF PHYSICAL BLOCKS/CI
         DS    AL1           NUMBER OF PHYSICAL BLOCKS/TRACK
         DS    AL1           UPPER LIMIT RECD NUMBER
         DS    AL4           DATA SECURITY PLIST PTR
         DS    AL4           EOX EXIT POINTER ADDRESS
         EJECT
************************************************************
*                                                          *
*        DTFSD VARBLK INPUT                                *
*                                                          *
************************************************************
*
DTFSIVB  DSECT
SIVBDTF  DS    XL6           CCB
         DS    AL1           LOGICAL UNIT CLASS
SIVBLU   DS    AL1           LOGICAL UNIT NUMBER
SIVBCCWA DS    A(SIVBCCW)    CCB-CCW ADDRESS
         DS    4X            CCB-ST BYTE,CSW CCW ADDRESS
         DS    AL1
         DS    XL3           LOGIC MODULE ADDRESS
         DS    X             DTF TYPE
         DS    AL1           OPEN/CLOSE INDICATORS
SIVBDDN  DS    CL7           FILENAME
         DS    X             INDICATE 2311
         DS    6X            BCCHHR ADDR OF F1 LABEL IN VTOC
         DS    2X            VOL SEQ NUMBER
         DS    X             OPEN COMMUNICATIONS BYTE
         DS    X             XTENT SEQ NO OF CURRENT EXTENT
         DS    X             XTENT SEQ NO LAST XTENT OPENED
SIVBULA  DS    AL3           USER'S LABEL ADDRESS (*)
         DS    X             DATAFILE VERSION 3 BIT
SIVBIOA  DS    AL3           ADDRESS OF IOAREA (ACTUALLY *)
         DS    XL4           CCHH ADDR OF USER LABEL TRACK
         DS    2X            LOWER HEAD LIMIT
         DS    4X            XTENT UPPER LIMIT
SIVBSEEK DS    2X            SEEK ADDRESS-BB
SIVBSRCH DS    XL4           SEARCH ADDRESS-CCHH
         DS    X             RECORD NUMBER
SIVBEODA DS    AL3           EOF ADDRESS
         DS    4X            CCHH CONTROL FIELD
         DS    X             R    CONTROL FIELD
         DS    B
SIVBBLKS DS    AL2           SIZE OF BLOCK-1
         DS    5X            CCHHR BUCKET
         DS    3X
         DS    2H            NOP   0
SIVBDB1  DS    A             DEBLOCKER-INITIAL POINTER (*+4)
SIVBRECL DS    F             DEBLOCKER-RECORD SIZE
SIVBDBL  DS    A             DEBLOCKER LIMIT (*+BLKSIZE-1)
         DS    AL1           LOGICAL INDICATORS
SIVBERR  DS    AL3           USER'S ERROR ROUTINE OR 0
SIVBCCW  DS    X             COMMAND SEEK
SIVBCA1  DS    AL3           (SIVBSEEK)
         DS    XL4           FLAGS AND LENGTH
SIVBCCW2 DS    X             COMMAND SEARCH ID EQUAL
SIVBCA2  DS    AL3           (SIVBSRCH)
         DS    XL4           FLAGS AND LENGTH
SIVBCCW3 DS    X             COMMAND TIC
SIVBCA3  DS    AL3           (SIVBCCW2)
         DS    XL4           FLAGS AND LENGTH
SIVBCCW4 DS    X             COMMAND READ DATA
SIVBCA4  DS    AL3           (SIVBCCW4)
         DS    XL2           FLAGS
SIVBCBKS DS    XL2           LENGTH (BLOCKSIZE)
SIVBCCW5 DS    X             COMMAND READ COUNT
SIVBCA5  DS    AL3           (SIVBCNT)
         DS    XL4           FLAGS AND LENGTH
SIVBCNT  DS    2F            COUNT AREA
SIVBV3   DS    0F            TO FORCE ALIGNMENT
         DS    AL1           1ST VERSION 3 FLAG
         DS    B             2ND VER 3 FLAG
         DS    AL2           VERSION 3 FLAGS
         DS    AL4           CISIZE IF PRESENT
         DS    AL4           PHYSICAL BLOCK SIZE
         DS    AL2           NUMBER OF PHYSICAL BLOCKS/CI
         DS    AL1           NUMBER OF PHYSICAL BLOCKS/TRACK
         DS    AL1           UPPER LIMIT RECD NUMBER
         DS    AL4           DATA SECURITY PLIST PTR
         DS    AL4           EOX EXIT POINTER ADDRESS
         END

© Copyright IT Doctors.co.uk. 2002