//HBE32PGM JOB ...
//**
//** Assemble the HBE32PGM program
//ASM      EXEC PGM=IEV90,REGION=2500K,
//         PARM='NOXREF,NOESD,NORLD,OBJECT,NODECK'
//SYSPRINT DD SYSOUT=*,DCB=(BLKSIZE=3146)
//SYSLIB DD DISP=SHR,DSN=SYS1.MACLIB
//SYSLIN DD UNIT=SYSDA,SPACE=(CYL,(2,1)),
//       DISP=(,PASS),DCB=(BLKSIZE=3120)
//SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(2,1))
//SYSUT2 DD UNIT=SYSDA,SPACE=(CYL,(2,1))
//SYSUT3 DD UNIT=SYSDA,SPACE=(CYL,(2,1))
//SYSIN DD *
         TITLE 'DFSORT Program for Merging Hiperbatch data with QSAM'
HBE32PGM CSECT
***********************************************************************
* This Program uses QSAM to read Hiperbatch input from a DFSORT E32
* exit for a Merge application.
* The input ddnames must be HBIN01, HBIN02, ... HBINnn.
* SORTCNTL must be specified as follows.  The MERGE statement must
* be first and must contain FILES=nn (e.g. FILES=03).
*
* //SORTCNTL DD *
*  MERGE FILES=nn,FIELDS=(p,m,f,s,...)
*  RECORD TYPE=x,LENGTH=y
*  Other DFSORT statements
*
* If FILES=nn is not found in the first statement or is invalid
* (e.g. FILES=00), a WTO message will be issued and HBE32PGM will
* terminate with RC=16.
*
***********************************************************************
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
         TITLE 'Initialize for merge processing'
         USING HBE32PGM,R12       Show base register
         STM   R14,R12,12(R13)    Save registers
         LA    R12,0(,R15)        Set base register
         ST    R13,SAVEPGM+4      Save backward pointer
         LA    R14,SAVEPGM        Set forward pointer
         ST    R14,8(,R13)          in savearea
         LR    R13,R14            Set our savearea
* Open the control data set.  Get the number of HBINXX data sets
* from FILES=nn in the first statement.
         LA    R2,CNTL            Get pointer to DCB
         USING IHADCB,R2          Show base reg
         OPEN  ((R2),(INPUT))     Open the input data set
         TM    DCBOFLGS,DCBOFOPN  IF Open successful,
         BO    OPENCOK              continue
         DROP  R2                 Drop DCB base
         WTO   'HBE32PGM: OPEN FOR SORTCNTL FAILED'
         B     RTN16              Terminate
OPENCOK  DS    0H
         SLR   R4,R4              Init. number of files to 0
         GET   CNTL               Get MERGE statement with FILES=nn
         MVC   MRGSTMT,0(R1)      Move statement
         LA    R3,71              Set scan limit
         LA    R5,MRGSTMT         Set scan pointer
FILESLP  DS    0H
         CLC   0(L'FILES,R5),FILES  If FILES=
         BE    FILESFND               GET nn
         LA    R5,1(,R5)          Point to next scan position
         BCT   R3,FILESLP         Keep scanning for FILES=
FILESNG1 DS    0H
     WTO   'HBE32PGM: FILES=NN NOT FOUND IN FIRST SORTCNTL STATEMENT'
FILESNGO DS    0H
         CLOSE CNTL               Close the control data set
         FREEPOOL CNTL            Free buffers
RTN16    DS    0H
         LA    R15,16             Set RC=16 (terminate)
         B     RTN                Return to DFSORT
FILESFND DS    0H
         TM    6(R5),X'F0'        If not n,
         BNO   FILESNG2             terminate
         TM    7(R5),X'F0'        If nn,
         BO    FILESCV              it's ok
FILESNG2 DS    0H
         WTO   'HBE32PGM: NN VALUE IN FILES=NN IS NOT NUMERIC'
         B     FILESNGO
FILESCV  DS    0H
         CLC   6(2,R5),=C'00'     If not FILES=00,
         BNE   FILESCV1             continue
         WTO   'HBE32PGM: FILES=00 FOUND'
         B     FILESNGO
FILESCV1 DS    0H
         PACK  DOUBLE,6(2,R5)     Get nn (number of files)
         CVB   R4,DOUBLE            in binary
CNTLEOD  DS    0H
         CLOSE CNTL               Close the control data set
         FREEPOOL CNTL            Free buffers
         LTR   R4,R4              If number of files is 0,
         BZ    FILESNG1             FILES=nn not found - terminate
FILESOK  DS    0H
         STH   R4,FILENUM         Save number of files
*
* Create a GETMAINed area with DCB pointers, Buffer pointers,
* DCBs and Buffers as follows:
*
* DCBPTRP                 BUFPTRP
* |                       |
* V                       V
* | @DCB01 | ... | @DCBnn | @BUF01 | ... | @BUFnn |
*
* | DCB01 | BUF01 | ... | DCBnn | BUFnn |
*
         LA    R9,INMDLLN         Get length of a DCB
         A     R9,F32K            Add length of maximum buffer
         ST    R9,DCBBUFLN        Save DCB + Buffer length
         LA    R9,8(,R9)          Add length of DCB/Buffer pointers
         SLR   R10,R10            Zero reg for multiply
         LH    R11,FILENUM        Get number of data sets
         MR    R10,R9             Get storage needed
         LA    R11,7(,R11)        Round length up
         N     R11,=F'-8'           to a doubleword
         ST    R11,AREALEN        Save size for Freemain
         GETMAIN R,LV=(R11)       Get area for DCB pointers and DCBs
         LR    R11,R1             Get pointer to first DCB pointer
         ST    R11,DCBPTRP        Save pointer to DCB pointers
         LR    R2,R4              Copy number of files
         SLL   R2,2               Get length of pointer lists
         LA    R3,0(R2,R11)       Get pointer to Buffer pointers
         ST    R3,BUFPTRP         Save pointer to Buffer pointers
         LA    R2,0(R2,R3)        Get pointer to first DCB/Buffer
         LA    R5,1               Set nn=01
         USING IHADCB,R2          Show DCB base
DCBLOOP  DS    0H
         ST    R2,0(,R11)         Save pointer to DCB
         LA    R9,INMDLLN(,R2)    Point to Buffer
         ST    R9,0(,R3)          Save pointer to Buffer
         MVC   0(INMDLLN,R2),INMDL  Move in model DCB
         CVD   R5,DOUBLE          Convert nn to decimal
         UNPK  DCBDDNAM+4(2),DOUBLE Convert nn to EBCDIC
         OI    DCBDDNAM+5,X'F0'   Fix sign
         OPEN  ((R2),(INPUT))     Open the input data set
         TM    DCBOFLGS,DCBOFOPN  IF Open successful,
         BO    OPENIOK              continue
         WTO   'HBE32PGM: OPEN FOR INPUT DATA SET FAILED'
* Close all Open input data sets
         LH    R4,FILENUM         Get number of files
         L     R5,DCBPTRP         Point to first DCB pointer
         USING IHADCB,R6          Show DCB base
CLOSLP   DS    0H
         L     R6,0(,R5)          Point to DCB
         TM    DCBOFLGS,DCBOFOPN  IF Open failed,
         BZ    CLOSNXT              skip Close
         CLOSE ((R6))             Close input data set
         FREEPOOL (R6)            Free buffers
CLOSNXT  DS    0H
         LA    R5,4(,R5)          Point to next DCB pointer
         BCT   R4,CLOSLP          Close next
         DROP  R6                 Drop DCB base
         LA    R15,16             Set RC=16 (terminate)
         B     FREESTG            Free storage and terminate
OPENIOK  DS    0H
         LA    R5,1(,R5)          Increment file number
         LA    R11,4(,R11)        Point to next DCB pointer
         LA    R3,4(,R3)          Point to next Buffer pointer
         AL    R2,DCBBUFLN        Point to next DCB/Buffer
         BCT   R4,DCBLOOP         Continue if more
* Call DFSORT with control statements and E32 exit that uses QSAM
* to read the input data sets
         LA    R1,SORTPARM        Set R1 to sort parameters
         LINK  EP=SORT            LINK to sort
* Freemain storage
FREESTG  DS    0H
         LR    R3,R15             Save RC over Freemain
         L     R2,AREALEN         Get length of area
         L     R4,DCBPTRP         Get pointer to area
         FREEMAIN R,LV=(R2),A=(R4) Free storage
         LR    R15,R3             Restore RC
RTN      DS    0H
         L     R13,4(,R13)
         L     R14,12(,R13)
         LM    R2,R12,28(R13)     Restore registers
         BR    R14                Return to caller
         DROP  R12                Drop base reg
*** E32 Exit - uses QSAM to read Hiperbatch input
HBE32    DS    0H
         USING HBE32,R12          Show base register
         STM   R14,R12,12(R13)    Save registers
         LA    R12,0(,R15)        Set base register
         ST    R13,SAVE32+4       Save backward pointer
         LA    R14,SAVE32         Set forward pointer
         ST    R14,8(,R13)          in savearea
         LR    R13,R14            Set our savearea
         LR    R2,R1              Copy pointer to parameter list
         L     R4,0(,R1)          Get increment of input data set
         L     R5,DCBPTRP         Get pointer to DCB pointers
         L     R5,0(R4,R5)        Get pointer to DCB
         L     R6,BUFPTRP         Get pointer to Buffer pointers
         L     R6,0(R4,R6)        Get pointer to Buffer
         GET   (R5),(R6)          GET a record
         ST    R6,4(,R2)          Set pointer to it in parameter list
         LA    R15,12             Set RC=12 (insert record)
GOBACK   DS    0H
         L     R13,4(,R13)
         L     R14,12(,R13)
         LM    R2,R12,28(R13)     Restore registers
         BR    R14                Return to DFSORT
INEOD    DS    0H
         CLOSE ((R5))             Close input data set
         FREEPOOL (R5)            Free buffers
         LA    R15,8              Set RC=8 (EOD for data set)
         B     GOBACK             Return to DFSORT
*
***********************************************************************
*    Data areas follow                                                *
***********************************************************************
DOUBLE   DS    D                  Doubleword work area
SAVEPGM  DS    18F
SAVE32   DS    18F
F32K     DC    F'32768'           Input buffer length
DCBPTRP  DS    A                  Pointer to DCB pointers and
*                                   Getmained area
BUFPTRP  DS    A                  Pointer to Buffer pointers
AREALEN  DS    F                  Size of Getmained area
DCBBUFLN DS    F                  Length of DCB + Buffer
FILENUM  DS    H                  Number of input files
FILES    DC    C'FILES='
MRGSTMT  DS    CL80               MERGE control statement
*
         CNOP  0,4
SORTPARM DC    A(0)               No control statements
         DC    A(HBE32)           E32 Exit
         DC    F'-1'              End of list
CNTL     DCB   DDNAME=SORTCNTL,MACRF=GL,EODAD=CNTLEOD,DSORG=PS
INMDL    DCB   DDNAME=HBIN00,MACRF=GM,EODAD=INEOD,DSORG=PS
INMDLLN  EQU   *-INMDL            End of model DCB
         LTORG
         DCBD  DSORG=PS
         DROP  R12                Drop base reg
         END
//**
//** Linkedit the HBE32PGM program
//**
//LKED     EXEC PGM=IEWL,REGION=512K,COND=(8,LT,ASM),
//        PARM='MAP,LIST,NCAL,LET,SIZE=(490K,40K),AMODE=24,RMODE=24'
//SYSLIN   DD  DSN=*.ASM.SYSLIN,DISP=(OLD,DELETE)
//         DD  DDNAME=SYSIN
//SYSUT1   DD  UNIT=SYSDA,SPACE=(3156,(24,20))
//SYSPRINT DD  SYSOUT=*,DCB=(BLKSIZE=2420,LRECL=121,RECFM=FBSA)
//SYSLMOD DD DSN=linklib(HBE32PGM),DISP=OLD
//**
//** Merge Example - Fixed-Length Hiperbatch Input
//**
//HBMERGEF EXEC PGM=HBE32PGM,REGION=8M
//STEPLIB  DD  DSN=linklib,DISP=SHR
//SYSUDUMP DD  SYSOUT=*
//SYSPRINT DD  SYSOUT=*
//SYSOUT   DD  SYSOUT=*
//HBIN01   DD  DSN=finput1,DISP=SHR
//HBIN02   DD  DSN=finput2,DISP=SHR
//HBIN03   DD  DSN=finput3,DISP=SHR
//SORTOUT DD DSN=foutput1,UNIT=SYSDA,SPACE=(CYL,(5,5),RLSE),
// DISP=(NEW,CATLG,DELETE)
//SORTCNTL DD *
 MERGE FILES=03,FIELDS=(21,4,CH,A)
 RECORD TYPE=F,LENGTH=80
//**
//** Merge Example - Variable-Length Hiperbatch Input
//**
//HBMERGV  EXEC PGM=HBE32PGM,REGION=8M
//STEPLIB  DD  DSN=linklib,DISP=SHR
//SYSUDUMP DD  SYSOUT=*
//SYSPRINT DD  SYSOUT=*
//SYSOUT   DD  SYSOUT=*
//HBIN01   DD  DSN=vinput1,DISP=SHR
//HBIN02   DD  DSN=vinput2,DISP=SHR
//HBIN03   DD  DSN=vinput3,DISP=SHR
//HBIN04   DD  DSN=vinput4,DISP=SHR
//HBIN05   DD  DSN=vinput5,DISP=SHR
//SORTOUT DD DSN=voutput1,UNIT=SYSDA,SPACE=(CYL,(5,5),RLSE),
// DISP=(NEW,CATLG,DELETE)
//SORTCNTL DD *
 MERGE FILES=05,FIELDS=(10,5,ZD,D)
 RECORD TYPE=V,LENGTH=2000
/*
