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