TITLE ' M E R G E U P T O 9 9 9 F I L E S'
*---------------------------------------------------------------------*
* OPENS INPUT FILES (INP001->999) UNTIL INPUT FILE NOT FOUND.
*---------------------------------------------------------------------*
SPACE 2
MERG999 CSECT , 2003JUN18ESOTO
PRINT NOGEN
DC CL8'MERG999',CL8'SYSDATE',CL8'SYSTIME'
MER000 DS 0D
USING *,13
STM 14,12,12(13) SAVE O/S REGISTERS.
ST 15,8(,13) SAVE MERG999 R13.
ST 13,4(,15) SAVE O/S R13.
LR 13,15 R13 NOW BASE REGISTER/SAVEREGS.
B 18*4+48(,13) GO TO OPEN MERGED,SYSLST.
ORG MER000
DS 0D,18A,48X SAVEREGS/RE-ENTRANT MODULE WORK AREA
OPEN (MERGED,OUTPUT,SYSLST,OUTPUT)
SPACE 2
*---------------------------------------------------------------------*
* I N I T I A L I Z E S I N P U T F I L E S
*---------------------------------------------------------------------*
LA 4,INFILE POINT TO DUMMY INFILE.
MER100 DS 0H
LA 0,INPLEN LENGTH OF NEEDED INFILE STORAGE.
GETMAIN R,LV=(0) GET STORAGE FOR ONE INFILE SEGMENT.
MVC 0(INPLEN,1),INFILE CREATING AN INFILE SEGMENT.
ST 1,0(,4) POINT BWD.
ST 1,4(,4) POINT BWD; FOR END OF JOB.
ST 4,8(,1) POINT FWD.
LR 4,1 R4 NOW ADR OF CURRENT INFILE.
AP INPNUM,=P'1' CREATING DDNAME NUMBER (001->999).
OI INPNUM+L'INPNUM-1,15 USABLE AFTER UNPACK.
UNPK 83(3,4),INPNUM DDNAME NOW INP001->INP999.
UNPK 21(3,4),INPNUM SAVE DDNAME #001->999, FOR EOJ.
LA 5,40(,4) POINT TO INPUT FILE DCB.
OPEN ((5),INPUT) OPEN INPUT FILE.
LTR 15,15 Q,OPEN ERROR?
BNZ MER200 Y,ASSUMES, INPUT FILE NOT FOUND.
GET (5) GET 1ST RECORD OF INPUT FILE.
ST 1,12(,4) SAVE 1ST RECORD ADDRESS.
MVC 24(16,4),0(1) SAVE 1ST RECORD KEY.
B MER100 INITIALIZE NEXT INPUT FILE.
EJECT
*---------------------------------------------------------------------*
* C O M P L E T E S I N I T I A L I Z A T I O N
*---------------------------------------------------------------------*
MER200 DS 0H
SP INPNUM,=P'1' NOW ACTUAL NUMBER OF INPUT FILES.
BNP MER900 NO INPUT FILES? END OF JOB.
CVB 3,INPNUM R3 NOW NUMBER OF INPUT FILES.
L 4,INFILE R4 POINTS TO 1ST INFILE SEGMENT.
STM 3,4,EOJCNT NEEDED FOR END OF JOB.
STM 3,4,INPCNT NEEDED TO SKIP EMPTY INPUT FILES.
MER300 DS 0H
CLC =A(XFFKEY),12(4) Q,EMPTY INPUT FILE.
BNE MAN400 N,SKIP TO NEXT INFILE SEGMENT.
L 1,8(,4) R1 NOW ADR OF PREVIOUS INFILE.
MVC 0(4,1),0(4) SKIP EMPTY FILE. POINT TO NEXT.
L 1,0(,4) R1 NOW ADR OF NEXT INFILE SEGMENT.
MVC 8(4,1),8(4) NEXT INFILE POINTS TO PREV INFILE.
L 1,INPCNT ADJUSTING INPUT COUNT DOWNWARD.
BCTR 1,0 LESS ONE EMPTY INPUT FILE.
ST 1,INPCNT SAVE NEW COUNT.
MAN400 DS 0H
L 4,0(,4) POINT TO NEXT INFILE SEGMENT.
BCT 3,MER300 TEST NEXT INPUT FILE.
L 1,INPCNT TESTING IF ANY INPUT FILE TO MERGE.
LTR 1,1 Q,ANY INPUT FILES LEFT TO MERGE?
BNP MER750 N,PRINT EMPTY FILE(S) INFO.
L 4,INFILE R4 NOW ADR OF 1ST INFILE SEGMENT.
L 5,0(,4) R5 NOW ADR OF 2ND INFILE SEGMENT.
STM 4,5,INP1ST INP1ST/2ND; INITIAL INPUT PAIR.
OI INPNUM+L'INPNUM-1,15 MAKE PRINTABLE.
UNPK OPRNUM,INPNUM MOVE TO OPERATOR MESSAGE.
LA 1,OPRMSG POINT TO OPERATOR MESSAGE.
SVC 35 ISSUE WTO (WRITE TO OPERATOR) SVC.
LTR 15,15 Q,WTO ERROR?
BZ MER500 N,START MERGING.
EX 0,* Y,ABORT JOB (EXECUTE EXCEPTION).
EJECT
*---------------------------------------------------------------------*
* M A I N L I N E R O U T I N E
*---------------------------------------------------------------------*
MER500 DS 0H
LM 3,5,INPCNT LOAD INITIAL INFILE PARAMETERS.
MER550 DS 0H
CLC 24(16,4),24(5) Q,1ST INFILE KEY LOW OR EQUAL?
BNH MER600 Y,KEYS IN SEQUENCE.
LR 4,5 N,MAKE 2ND INFILE 1ST.
MER600 DS 0H
L 5,0(,5) POINT TO NEXT INFILE SEGMENT.
BCT 3,MER550 TEST NEXT PAIR OF INFILE KEYS.
AP 16(5,4),=P'1' INPUT FILE COPIED COUNT (MERGED).
L 5,12(,4) R5 NOW ADR OF RECORD TO BE MERGED.
PUT MERGED,(5) COPY RECORD TO OUTPUT MERGED FILE.
LA 5,40(,4) R5 NOW ADR OF INPUT FILE DCB.
GET (5) GET NEXT INPUT RECORD.
ST 1,12(,4) SAVE INPUT RECORD ADR.
MVC 24(16,4),0(1) SAVE INPUT RECORD KEY.
B MER500 FIND NEXT RECORD TO BE MERGED.
SPACE 2
*---------------------------------------------------------------------*
* E N D O F F I L E R O U T I N E
*---------------------------------------------------------------------*
MER700 DS 0H
CLOSE (5) CLOSE INPUT FILE.
CLC =A(XFFKEY),12(4) Q,INPUT FILE INITIALLY EMPTY?
BE MER100 Y,INITIALIZE NEXT INPUT FILE.
L 1,8(,4) R1 POINTS TO PREVIOUS INFILE ADR.
MVC 0(4,1),0(4) SKIP CLOSED FILE; POINT TO NEXT.
L 1,0(,4) R1 NOW ADR OF NEXT INFILE SEGMENT.
MVC 8(4,1),8(4) NEXT INFILE POINTS TO PREV INFILE.
L 1,INFILE IN CASE OF CHANGE RESET POINTERS.
L 2,0(,1) R2 NOW ADR OF 2ND INFILE AREA.
STM 1,2,INP1ST INP1ST/2ND; INITIAL INPUT PAIR.
L 1,INPCNT CHECKING FOR ANY REMAINING FILE.
BCTR 1,0 LESS CLOSED INPUT FILE.
ST 1,INPCNT SAVE NEW INPUT FILES COUNT.
LTR 1,1 Q,ANY REMAINING FILE?
BP MER500 Y,MERGE REMAINING FILES.
EJECT
*---------------------------------------------------------------------*
* E N D O F J O B R O U T I N E
*---------------------------------------------------------------------*
MER750 DS 0H
LR 1,13
SH 1,=Y(3*8) R1 NOW ADR OF MERG999 SYSDATE,ETC.
MVC PRTOUT+1(3*8),0(1) MOVES ‘MERG999 MM/DD/YYHH/MM/SS’
PUT SYSLST,PRTOUT NEW PAGE PRINT MERG999 INFO.
MVC PRTOUT,PRTOUT-1 BLANK-OUT PRINT AREA.
LM 3,4,EOJCNT LOAD EOJ PARAMETERS.
MER800 DS 0H
AP OUTCNT,16(5,4) ADD INPUT FILE COUNT TO OUTCNT.
MVC PRTOUT+L'EDCNT+4(3),21(4) INPUT FILE # 001->999.
MVC PRTOUT+L'EDCNT+1(3),=C'INP' NOW INP001->INP999.
MVC PRTOUT(L'EDCNT),EDCNT MOVE EDIT PATTERN.
ED PRTOUT(L'EDCNT),16(4) EDIT INPUT FILE COUNT.
PUT SYSLST,PRTOUT PRINT INPUT FILE COUNT.
L 4,4(,4) POINT TO NEXT INFILE SEGMENT.
BCT 3,MER800 GO TO PRINT NEXT INPUT FILE COUNT.
MER900 DS 0H
MVC PRTOUT+L'EDCNT+1(6),=C'MERGED'
MVC PRTOUT(L'EDCNT),EDCNT
ED PRTOUT(L'EDCNT),OUTCNT
PUT SYSLST,PRTOUT PRINT FINAL OUTPUT MERGED COUNT.
CLOSE (MERGED,,SYSLST)
L 13,4(,13) RESTORE O/S R13.
LM 14,12,12(13) RESTORE O/S REGISTERS.
XR 15,15 RETURN CODE: ALWAYS GOOD
BR 14 RETURN TO O/S CONTROL.
*
INPNUM DC 0D,PL8'0' 001-999
DC C’ ‘ 1X4 NEEDED TO BLANK-OUT PRTOUT.
PRTOUT DS 0CL25 2X4 PRINTER OUTPUT AREA.
DC C’1’ 3X4 SKIP TO CHANNEL-1, NEW PAGE.
DS CL24 4X4
OUTCNT DC PL5'0' OUTPUT MERGED COUNT.
EDCNT DC X'402020206B2020206B212020'
*
OPRMSG DC 0F,Y(OPRLEN,0) 1X3
OPRNUM DC C'000',C' INPUT FILES FOUND.' 2X3
OPRLEN EQU *-OPRMSG 3X3
*
INPCNT DS A 1X3 ACTUAL # OF FILES TO BE MERGED.
INP1ST DS A 2X3 ADR OF 1ST INFILE SEGMENT.
INP2ND DS A 3X3 ADR OF 2ND INFILE SEGMENT.
EOJCNT DS A 1X2 ACTUAL # OF FILES (FOR EOJ).
EOJ1ST DS A 2X2 ADR OF 1ST INFILE (FOR EOJ).
*
INFILE DC A(0,0,0,XFFKEY),PL5'0',C'000' 1X4
XFFKEY DC 0XL16,16X'FF' 2X4
INP000 DCB DDNAME=INP000,DSORG=PS,MACRF=GL,EODAD=MER700 3X4
INPLEN EQU *-INFILE 4X4
*
MERGED DCB DDNAME=MERGED,DSORG=PS,MACRF=PM,RECFM=FB
*
SYSLST DCB DDNAME=SYSLST,DSORG=PS,MACRF=PM,LRECL=25,RECFM=FBA
*
END MER000
|
© Copyright Edward Soto & IT Doctors.co.uk. 2003