Program MERG999

© Copyright Edward Soto 2003. All rights reserved.

Merge up to 999 datasets

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.
Running
    Tyrannosaurus Rex 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.