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