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