TITLE 'NVCSPUT - PUNCH VSE FILE TO CMS'
NVCSPUT  CSECT
**********************************************************************
*   THIS CREATES VSE SEQUENTIAL FILE FROM DISK DUMP DATA             *
*   FILE DEFINITION PASSED BY PARM= ON // EXEC                       *
*   CALLS DDGET TO READ DISK DUMP FORMAT DATA                        *
**********************************************************************
*                                                                    *
**********************************************************************
*        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   RECFM,PARMRECF          * SAVE RECFM
         CLI   PARMRECF,C'V'           * VARIABLE ?
         BNE   PARM0100                * NO - CHECK FIXED
         BAL   R10,OPNV0000            * OPEN VARIABLE
         B     MAIN0000                * GET ON WITH IT
PARM0100 DS    0H
         CLI   PARMRECF,C'F'           * FIXED ?
         BNE   ERROR02                 * NO
         LA    R3,5                    * LOOP COUNT
         LA    R4,PARMRECL             * 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,PARMRECL       * PACK LRECL
         BAL   R10,OPNF0000            * OPEN FIXED
        DROP R2
MAIN0000 DS    0H
         L     R0,=A(IOAREA)           * TARGET
         L     R1,=A(L'IOAREA)         * LENGTH
         LA    R14,0                   * SOURCE (NONE)
         L     R15,=X'40000000'        * 0 LENGTH SPACE PAD
         MVCL  R0,R14                  * SPACE FILL IOAREA
         LA    R1,PLIST                * DDGET PLIST
         L     R15,=V(DDGET)           * DDGET
         BALR  R14,R15                 * CALL
         CLC   RC,=H'0'                * NORMAL RETURN
         BE    MAIN0100                * YES
         CLC   RC,=H'1'                * EOF
         BE    TERM0000                * YES
         CLC   RC,=H'16'               * NO DATA
         BE    TERM0000                * YES
         B     ERROR04                 * BAD RC
MAIN0100 DS    0H
         CLI   RECFM,C'V'              * VARIABLE ?
         BE    MAIN0200                * YES
         LA    R6,IOAREA               * WORKA AREA
         PUT   (9),(6)                 * PUT DATA
         B     MAIN0000                * GET NEXT
MAIN0200 DS    0H
         LH    R1,LRECL                * LRECL
         LA    R1,4(,R1)               * BUMP FOR RDW
         STH   R1,RDW                  * LRECL TO RDW
         LA    R6,RDW                  * WORKA AREA
         PUT   (9),(6)                 * PUT DATA
         B     MAIN0000                * GET NEXT
*
TERM0000 DS    0H
         CLOSE (9)                     * CLOSE INPUT FILE
         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 DTFSOFB,R9
         MVC   SOFBDDN(7),DDNAME       * FIX DDN
         CVB   R1,PACKRECL             * LRECL
         ST    R1,SOFBRECL             * TO DTF
         STH   R1,LRECL                * FOR DDGET
         OPEN  (9)
         BR    R10
        DROP   R2,R9
*
OPNV0000 DS    0H
         LA    R9,VARBLK
        USING PARM,R2
        USING DTFSOVB,R9
         MVC   SOVBDDN(7),DDNAME       * FIX DDN
         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 DDGET - ABENDING'
         DC    H'0'
*
FIXBLK   DTFSD BLKSIZE=MAX,                                            *
               DEVADDR=SYS030,RECFORM=FIXBLK,                          *
               TYPEFLE=OUTPUT,RECSIZE=100,WORKA=YES
*
VARBLK   DTFSD BLKSIZE=MAX,                                            *
               DEVADDR=SYS030,RECFORM=VARBLK,                          *
               TYPEFLE=OUTPUT,WORKA=YES
*
PACKRECL DS    D                       * RECORD LENGTH
SAVEAREA DS    9D                      * SAVE AREA
*
PLIST    DS    0F                      * DDGET PLIST
         DC    A(FNAME)                * CMS FILENAME
         DC    A(LRECL)                * RECORD LENGTH
         DC    A(RC)                   * RETURN CODE
RECADDR  DC    A(IOAREA)               * RECORD ADDRESS
         DC    A(0)                    * TERMINATOR (UNUSED)
*
         DS    0D
         DC    CL16'*** DDGET PARMS'
LRECL    DS    H                       * RECORD LENGTH
RC       DS    H                       * RETURN CODE
FNAME    DS    0CL18                   * CMS FILE NAME
         DC    CL8' '                  * FNAME
         DC    CL8'DATA'               * FTYPE
         DC    CL2'A1'                 * FMODE
FUNC     DC    C'P'                    * DDGET FUNCTION
RECFM    DS    C                       * SAVED RECFM
         LTORG
         DS    0D
         DC    CL16'*** IOAREA ***'
RDW      DC    F'0'                    * RDW
IOAREA   DS    XL32767                 * IO AREA
*
*        DSECT FOR PASSED PARAMETER
*
PARM     DSECT                         * PASSED PARAMETER
DDNAME   DS    CL8                     * DDNAME
         DS    C
PARMRECF DS    C                       * F OR V
         DS    C
PARMRECL DS    CL5                     * RECORD LENGTH (FIXED ONLY)
         EJECT
************************************************************
*                                                          *
*        DTFSD FIXBLK OUTPUT                               *
*                                                          *
************************************************************
*
DTFSOFB  DSECT
SOFBDTF  DS    XL6           CCB
         DS    AL1           LOGICAL UNIT CLASS
SOFBLU   DS    AL1           LOGICAL UNIT NUMBER
SOFBCCWA DS    A             CCB-CCW ADDRESS (SOFBCCW)
         DS    4X            CCB-ST BYTE,CSW CCW ADDRESS
         DS    AL1
         DS    XL3           LOGIC MODULE ADDRESS
         DS    X             DTF TYPE
         DS    AL1           OPEN/CLOSE INDICATORS
SOFBDDN  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
SOFBULA  DS    AL3           USER'S LABEL ADDRESS (*)
         DS    X             DATAFILE VERSION 3 BIT
SOFBIOA  DS    AL3           ADDRESS OF IOAREA (ACTUALLY *)
         DS    XL4           CCHH ADDR OF USER LABEL TRACK
         DS    2X            LOWER HEAD LIMIT
         DS    4X            XTENT UPPER LIMIT
SOFBSEEK DS    2X            SEEK ADDRESS-BB
SOFBSRCH DS    XL4           SEARCH ADDRESS-CCHH
         DS    X             RECORD NUMBER
         DS    X             KEY LENGTH
SOFBDLEN DS    AL2           DATA LENGTH (BLOCKSIZE)
         DS    4X            CCHH CONTROL FIELD
         DS    AL1           R    CONTROL FIELD
         DS    B
SOFBBLKS DS    AL2           SIZE OF BLOCK-1
         DS    5X            CCHHR BUCKET
         DS    X
         DS    H             TRACK CAPACITY CONSTANT
         DS    2H            NOP   0
SOFBDB1  DS    A             DEBLOCKER-INITIAL POINTER (*+8)
SOFBRECL DS    F             DEBLOCKER-RECORD SIZE
SOFBDBL  DS    A             DEBLOCKER LIMIT (*+8+BLKSIZE-1)
         DS    AL1           LOGICAL INDICATORS
SOFBERR  DS    AL3           USER'S ERROR ROUTINE OR 0
SOFBCCW  DS    X             COMMAND SEEK
SOFBCA1  DS    AL3           (SOFBSEEK)
         DS    XL4           FLAGS AND LENGTH
SOFBCCW2 DS    X             COMMAND SEARCH ID EQUAL
SOFBCA2  DS    AL3           (SOFBSRCH)
         DS    XL4           FLAGS AND LENGTH
SOFBCCW3 DS    X             COMMAND TIC
SOFBCA3  DS    AL3           (SOFBCCW2)
         DS    XL4           FLAGS AND LENGTH
SOFBCCW4 DS    X             COMMAND WRITE CNT KEY DATA
SOFBCA4  DS    AL3           (SOFBCCW4)
         DS    XL2           FLAGS
SOFBCBKS DS    XL2           LENGTH (BLOCKSIZE)
SOFBCCW5 DS    X             COMMAND SEARCH ID EQUAL
SOFBCA5  DS    AL3           (SOFBSRCH)
         DS    XL4           FLAGS AND LENGTH
SOFBCCW6 DS    X             COMMAND TIC
SOFBCA6  DS    AL3           (SOFBCCW5)
         DS    XL4           FLAGS AND LENGTH
SOFBCCW7 DS    X             COMMAND VERIFY
SOFBCA7  DS    AL3           (SOFBCCW7)
         DS    XL4           FLAGS AND LENGTH
SOFBV3   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 OUTPUT                               *
*                                                          *
************************************************************
DTFSOVB  DSECT
SOVBDTF  DS    XL6           CCB
         DS    AL1           LOGICAL UNIT CLASS
SOVBLU   DS    AL1           LOGICAL UNIT NUMBER
SOVBCCWA DS    A             CCB-CCW ADDRESS (SOVBCCW)
         DS    4X            CCB-ST BYTE,CSW CCW ADDRESS
         DS    AL1
         DS    AL3           LOGIC MODULE ADDRESS
         DS    X             DTF TYPE
         DS    AL1           OPEN/CLOSE INDICATORS
SOVBDDN  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
         DS    X             X'80'
SOVBULA  DS    AL3           USER'S LABEL ADDRESS (*)
         DS    X             DATAFILE VERSION 3 BIT
SOVBIOA  DS    AL3           ADDRESS OF IOAREA (ACTUALLY *)
         DS    X             CCHH ADDR OF USER LABEL TRACK
         DS    2X            LOWER HEAD LIMIT
         DS    4X            XTENT UPPER LIMIT
SOVBSEEK DS    2X            SEEK ADDRESS-BB
SOVBSRCH DS    XL4           SEARCH ADDRESS-CCHH
         DS    X             RECORD NUMBER
         DS    X             KEY LENGTH
SOVBDLEN DS    AL2           DATA LENGTH (BLKSIZE)
         DS    4X            CCHH CONTROL FIELD
         DS    X             R    CONTROL FIELD
         DS    B
SOVBBLKS DS    AL2           SIZE OF BLOCK-1
         DS    5X            CCHHR BUCKET
         DS    X
         DS    H             TRACK CAPACITY CONSTANT
         DS    2H            NOP   0
SOVBDB1  DS    A             DEBLOCKER-INITIAL POINTER (*+12)
SOVBRECL DS    F             DEBLOCKER-RECORD SIZE
SOVBDBL  DS    A             DEBLOCKER LIMIT (*+8+BLKSIZE-1)
         DS    AL1           LOGICAL INDICATORS
SOVBERR  DS    AL3           USER'S ERROR ROUTINE OR 0
SOVBCCW  DS    X             COMMAND SEEK
SOVBCA1  DS    AL3           (SOVBSEEK)
         DS    XL4           FLAGS AND LENGTH
SOVBCCW2 DS    X             COMMAND SEARCH ID EQUAL
SOVBCA2  DS    AL3           (SOVBSRCH)
         DS    XL4           FLAGS AND LENGTH
SOVBCCW3 DS    X             COMMAND TIC
SOVBCA3  DS    AL3           (SOVBCCW2)
         DS    XL4           FLAGS AND LENGTH
SOVBCCW4 DS    X             COMMAND WRITE CNT KEY DATA
SOVBCA4  DS    AL3           (SOVBCCW4)
         DS    XL2           FLAGS
SOVBCBKS DS    XL2           LENGTH (BLKSIZE)
SOVBCCW5 DS    X             COMMAND SEARCH ID EQUAL
SOVBCA5  DS    AL3           (SOVBSRCH)
         DS    XL4           FLAGS AND LENGTH
SOVBCCW6 DS    X             COMMAND TIC
SOVBCA6  DS    AL3           (SOVBCCW5)
         DS    XL4           FLAGS AND LENGTH
SOVBCCW7 DS    X             COMMAND VERIFY
SOVBCA7  DS    AL3           (SOVBCCW7)
         DS    XL4           FLAGS AND LENGTH
         DS    F             SPACE REMAINING IN OUTPUT AREA
         DS    H             TRACK CAPACITY BUCKET
         DS    2H            NOP   0
SOVBV3   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