You are invited to browse the list of mainframe-loving sites.
[ Join Now | Ring Hub | Random | << Prev | Next >> ]
© Copyright Edward Soto 2003. All rights reserved.
Remark:
This program is not reentrant.
This software is free; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the Free
Software Foundation; either
version 2 of the License,
or (at your option) any later version.
More information is available from
the Free Software Foundation or
the Open Source Initiative.
This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
You should have received a copy of the GNU General Public License along with this software; if not, write to either of the following:
|
the Free Software Foundation, Inc. 59 Temple Place, Suite 330 Boston, MA 02111-1307 United States of America |
B.V. Bixoft Rogge 9 7261 JA Ruurlo The Netherlands |
|
email: bixoft@bixoft.nl phone: +31-6-22755401 |
Remark:
This software - and more programs and macros - are available in a format more
suitable for uploading to your mainframe. Please e-mail
B.V. Bixoft with your request
and you will receive a zipped IEBUPDTE job with the program sources.
* 00000100
* This program is free software; you can redistribute it and/or modify 00000200
* it under the terms of the GNU General Public License as published by 00000300
* the Free Software Foundation; either version 2 of the License 00000400
* or (at your option) any later version. 00000500
* The license text is available at the following internet addresses: 00000600
* - http://www.bixoft.com/english/gpl.htm 00000700
* - http://fsf.org 00000800
* - http://opensource.org 00000900
* 00001000
* This program is distributed in the hope that it will be useful, 00001100
* but WITHOUT ANY WARRANTY; without even the implied warranty of 00001200
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 00001300
* See the GNU General Public License for more details. 00001400
* 00001500
* You should have received a copy of the GNU General Public License 00001600
* along with this program; if not, write to either of the following: 00001700
* the Free Software Foundation, Inc. B.V. Bixoft 00001800
* 59 Temple Place, Suite 330 Rogge 9 00001900
* Boston, MA 02111-1307 7261 JA Ruurlo 00002000
* United States of America The Netherlands 00002100
* 00002200
* e-mail: bixoft@bixoft.nl 00002300
* phone : +31-6-22755401 00002400
* 00002500
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 , 2005APR16ESOTO
PRINT NOGEN
YREGS , EQUATES REGISTERS 0-15 TO R0-R15.
DC CL8'MERG999',CL8'&SYSDATE',CL8'&SYSTIME',CL8'&VER'
MER000 DS 0D
USING *,R13
STM R14,R12,12(R13) SAVE O/S REGISTERS.
ST R15,8(,R13) SAVE MERG999 R13.
ST R13,4(,R15) SAVE O/S R13.
LR R13,R15 R13 NOW BASE REG/SAVEREGS/WORKAREA.
B 256(,R13) SKIP SAVEREGS/RE-ENTRANT WORK AREA.
ORG MER000
DS 0D,256X 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 R4,INFILE POINT TO DUMMY INFILE SEGMENT.
MER100 DS 0H
LA 0,INPLEN LENGTH OF NEEDED INFILE STORAGE.
GETMAIN R,LV=(0) GET STORAGE FOR ONE INFILE SEGMENT.
MVC 0(INPLEN,R1),INFILE CREATING AN INFILE SEGMENT.
ST R1,0(,R4) POINT BWD.
ST R1,4(,R4) POINT BWD; FOR END OF JOB.
ST R4,8(,R1) POINT FWD.
LR R4,R1 R4 NOW ADR OF CURRENT INFILE.
AP INPNUM,=P'1' CREATING DDNAME NUMBER (001->999).
UNPK 83(3,R4),INPNUM DDNAME NOW INP001->INP999.
OI 85(R4),X'F0' NOW USABLE / PRINTABLE.
MVC 21(3,R4),83(R4) SAVE DDNAME #001->999, FOR EOJ.
LA R5,40(,R4) POINT TO INPUT FILE DCB.
OPEN ((5),INPUT) OPEN INPUT FILE.
BXH R15,R15,MER200 BRANCH IF INPUT FILE NOT FOUND.
GET (5) GET 1ST RECORD OF INPUT FILE.
ST R1,12(,R4) SAVE 1ST RECORD ADDRESS.
MVC 24(16,R4),0(R1) 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 R3,INPNUM R3 NOW NUMBER OF INPUT FILES.
L R4,INFILE R4 POINTS TO 1ST INFILE SEGMENT.
STM R3,R4,EOJCNT NEEDED FOR END OF JOB.
STM R3,R4,INPCNT NEEDED TO SKIP EMPTY INPUT FILES.
MER300 DS 0H
CLC =A(XFFKEY),12(R4) Q, EMPTY INPUT FILE?
BNE MER400 NO, SKIP TO NEXT INFILE SEGMENT.
L R1,8(,R4) R1 NOW ADR OF PREVIOUS INFILE.
MVC 0(4,R1),0(R4) SKIP EMPTY FILE, POINT TO NEXT.
L R1,0(,R4) R1 NOW ADR OF NEXT INFILE SEGMENT.
MVC 8(4,R1),8(R4) NEXT INFILE POINTS TO PREV INFILE.
L R1,INPCNT ADJUSTING INPUT COUNT DOWNWARD.
BCTR R1,R0 LESS ONE EMPTY INPUT FILE.
ST R1,INPCNT SAVE NEW COUNT.
MER400 DS 0H
L R4,0(,R4) POINT TO NEXT INFILE SEGMENT.
BCT R3,MER300 GO TO TEST NEXT INPUT FILE.
L R1,INPCNT TESTING IF ANY INPUT FILE TO MERGE.
LTR R1,R1 Q, ANY INPUT FILE(S) LEFT TO MERGE?
BNP MER750 NO, PRINT EMPTY FILE(S) INFO.
L R4,INFILE R4 NOW ADR OF 1ST INFILE SEGMENT.
L R5,0(,R4) R5 NOW ADR OF 2ND INFILE SEGMENT.
STM R4,R5,INP1ST INP1ST/2ND; INITIAL INPUT PAIR.
UNPK OPRNUM,INPNUM MOVE TO OPERATOR MESSAGE.
OI OPRNUM+L'OPRNUM-1,X'F0' MAKE PRINTABLE.
LA R1,OPRMSG POINT TO OPERATOR MESSAGE.
SVC 35 ISSUE WTO (WRITE TO OPERATOR) SVC.
LTR R15,R15 Q, WTO ERROR?
BZ MER500 NO, START MERGING.
EX R0,* YES, ABORT JOB (EXECUTE EXCEPTION).
EJECT
*---------------------------------------------------------------------*
* M A I N L I N E R O U T I N E
*---------------------------------------------------------------------*
MER500 DS 0H
LM R6,R7,=A(MER600,MER650)
MER550 DS 0H
LM R3,R5,INPCNT LOAD INITIAL INFILE PARAMETERS.
MER600 DS 0H
CLC 24(16,R4),24(R5) Q, 1ST INFILE KEY LOW OR EQUAL?
BNHR R7 YES, KEYS IN SEQUENCE.
LR R4,R5 NO, MAKE 2ND INFILE ADR 1ST.
MER650 DS 0H
L R5,0(,R5) POINT TO NEXT INFILE SEGMENT.
BCTR R3,R6 TEST NEXT PAIR OF INFILE KEYS.
AP 16(5,R4),=P'1' INPUT FILE COPIED COUNT (MERGED).
L R5,12(,R4) R5 NOW ADR OF RECORD TO BE MERGED.
PUT MERGED,(5) COPY RECORD TO OUTPUT MERGED FILE.
LA R5,40(,R4) R5 NOW ADR OF INPUT FILE DCB.
GET (5) GET NEXT INPUT RECORD.
ST R1,12(,R4) SAVE INPUT RECORD ADR.
MVC 24(16,R4),0(R1) SAVE INPUT RECORD KEY.
B MER550 GO TO 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(R4) Q, INPUT FILE INITIALLY EMPTY?
BE MER100 YES, INITIALIZE NEXT INPUT FILE.
L R1,8(,R4) R1 POINTS TO PREVIOUS INFILE ADR.
MVC 0(4,R1),0(R4) SKIP CLOSED FILE; POINT TO NEXT.
L R1,0(,R4) R1 NOW ADR OF NEXT INFILE SEGMENT.
MVC 8(4,R1),8(R4) NEXT INFILE POINTS TO PREV INFILE.
L R1,INFILE IN CASE OF CHANGE RESET POINTERS.
L R2,0(,R1) R2 NOW ADR OF 2ND INFILE AREA.
STM R1,R2,INP1ST INP1ST/2ND; INITIAL INPUT PAIR.
L R1,INPCNT CHECKING FOR ANY REMAINING FILE.
BCTR R1,R0 LESS CLOSED INPUT FILE.
ST R1,INPCNT SAVE NEW INPUT FILES COUNT.
LTR R1,R1 Q, ANY REMAINING FILE?
BP MER500 YES, MERGE REMAINING FILES.
EJECT
*---------------------------------------------------------------------*
* E N D O F J O B R O U T I N E
*---------------------------------------------------------------------*
MER750 DS 0H
LR R1,R13 R1 NOW ADR OF MERG999 ENTRY POINT.
SH R1,=Y(4*8) R1 NOW ADR OF START OF MERG999 CSECT
MVC PRTOUT+1(4*8),0(R1) MOVES, 'MERG999 SYSDATE',ETC.
PUT SYSLST,PRTOUT NEW PAGE; PRINT MERG999 INFO.
MVC PRTOUT,PRTOUT-1 BLANK-OUT PRINT AREA.
LM R3,R4,EOJCNT LOAD EOJ PARAMETERS.
MER800 DS 0H
AP OUTCNT,16(5,R4) ADD INPUT FILE COUNT TO OUTCNT.
MVC PRTOUT+L'EDCNT+4(3),21(R4) 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(R4) EDIT INPUT FILE COUNT.
PUT SYSLST,PRTOUT PRINT INPUT FILE COUNT.
L R4,4(,R4) POINT TO NEXT INFILE SEGMENT.
BCT R3,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 R13,4(,R13) RESTORE O/S R13.
LM R14,R12,12(R13) RESTORE O/S REGISTERS.
XR R15,R15 RETURN CODE: GOOD
BR R14 RETURN TO O/S CONTROL.
*
INPNUM DC 0D,PL8'0' 001-999
DC C' ' 1X4 NEEDED TO BLANK-OUT PRTOUT.
PRTOUT DS 0CL33 2X4 PRINTER OUTPUT AREA.
DC C'1' 3X4 SKIP TO CHANNEL-1, NEW PAGE.
DS CL32 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=33,RECFM=FBA
*
END MER000
|
This site is a member of WebRing. You are invited to browse the list of mainframe-loving sites. |
|
Dinos are not dead. They are alive and well and living in data centers all around you. They speak in tongues and work strange magics with computers. Beware the dino! And just in case you're waiting for the final demise of these dino's: remember that dinos ruled the world for 155-million years! |
|
Dinos and other anachronisms [ Join Now | Ring Hub | Random | << Prev | Next >> ] |
||
Below you find the logo of our sponsor and logos of the web-standards that this page adheres to.
|
|
|
|
||