//COMPARE JOB (JOB),
//             'INSTALL COMPARE',
//             CLASS=A,
//             MSGCLASS=A,
//             MSGLEVEL=(1,1),
//             USER=IBMUSER,
//             PASSWORD=SYS1
//*
//*  ASM1 -- ASSEMBLES COMPARE (IFOX00 CAN BE USED INSTEAD OF IEV90)
//*  LNK1 -- LINKS COMPARE INTO 'SYS1.CMDLIB(COMPARE)'
//*                WITH ALIAS COMPARE$ FOR PDS USE
//*
//*  ASM2 -- ASSEMBLES COMPAREB (IFOX00 CAN BE USED INSTEAD OF IEV90)
//*  LNK2 -- LINKS COMPAREB INTO 'SYS1.CMDLIB(COMPAREB)'
//*
//*  COPH -- COPIES COMPARE HELP TO 'SYS2.HELP(COMPARE)'
//*          USING IEBGENER AND SHARED ALLOCATION
//*
//*  COPP -- COPIES COMPARE PANEL TO 'SYS3.HAL.PLIB(COMPR#P)'
//*          USING IEBGENER AND SHARED ALLOCATION
//*
//*  COPC -- COPIES COMPARE CLIST TO 'SYS3.HAL.CLIB(COMPR#C)'
//*          USING IEBGENER AND SHARED ALLOCATION
//*
//*  COPS -- COPIES COMPARE SKELETON TO 'SYS3.HAL.SLIB(COMPR#S)'
//*          USING IEBGENER AND SHARED ALLOCATION
//*
//*********************************************************************
//*                                                                   *
//* THIS IS AN ENHANCEMENT (COMBINATION) OF TWO FLAVORS OF THE YALE   *
//* COMPARE PROGRAM. THE FIRST WAS TAKEN FROM FILE 45 OF THE CBT      *
//* TAPE AND WAS MODIFIED FROM THE ORIGINAL BY MR. BRENT TOLMAN.      *
//* THE SECOND SOURCE IS THE VERSION FROM FILE 300 OF THE CBT TAPE    *
//* AND WAS MODIFIED BY MR. BILL GODFREY AND MR. JIM MARSHALL         *
//* ADDITIONAL CODE FROM THE VERSION FROM FILE 296 OF THE CBT TAPE    *
//* HAS BEEN ADDED TO ALLOW THIS VERSION TO ALSO FUNCTION UNDER       *
//* THE PDS COMMAND. FILE 296 IS FROM MR. BRUCE LELAND                *
//*                                                                   *
//* THE INTEND OF THIS COMBINATION IS TO PRODUCE A VERSION THAT       *
//* CAN COMPARE EITHER TWO ENTIRE PDS'S, OR TWO SEQUENTIAL FILES.     *
//* IT IS ALSO DESIRED THAT IT CAN BE INVOKED BY THE 'COMPARE'        *
//* TSO COMMAND WRITTEN BY MR. BILL GODFREY.                          *
//*                                                                   *
//*                                                                   *
//* THE FEATURES IN THIS PROGRAM ARE:                                 *
//*  1. USES THE YALE COMPARE PROGRAM LOGIC FOR COMPARING AND RESYNC- *
//*     RONIZATRION.                                                  *
//*  2. SUPPORTS COMPARES OF FULL PDS DATASETS (DON'T SPECIFY A       *
//*     MEMBER NAME TO USE THIS FEATURE).                             *
//*  3. SUPPORTS COMPARES OF TWO SEQUENTIAL DATASETS (EITHER REAL     *
//*     SEQUENTIAL DATASETS OR MEMBERS SPECIFIED IN JCL).             *
//*  4. SUPPORTS RECORD SIZES DIFFERENT FROM 80 BYTES BUT LESS THAN   *
//*     256 BYTES (NOTE IGNORE CARDS MUST BE 80 BYTES LONG)           *
//*  5. CAN BE INVOKED WITH A DDNAME PARAMETER LIST FROM THE          *
//*     THE 'COMPARE' TSO COMMAND (MODIFIED FROM CBT FILE 300).       *
//*  6. ALSO ENCLOSED IS THE NECESSARY PANEL, CLIST, AND SKELETON     *
//*     TO INVOKE IT UNDER ISPF                                       *
//*  7. CODE FROM MR. BRUCE LELAND TO SUPPORT THE PDS COMMAND HAS     *
//*     ALSO BEEN IMPLEMENTED.                                        *
//*                                                                   *
//* GUY L. ALBERTELLI                                                 *
//* B. F. GOODRICH                                                    *
//* 3925 EMBASSY PARKWAY                                              *
//* AKRON, OHIO  44313                                                *
//*     216-374-4071                                                  *
//*                                                                   *
//*                                                                   *
//* SEVERAL CHANGES WERE MADE TO THIS PROGRAM ON 6/10/88 TO BETTER    *
//* SUPPORT ITS USE FROM THE PDS COMMAND PROCESSOR:                   *
//*  1. CHANGES WERE MADE TO ALLOW PDS CHECKPOINT PROCESSING TO       *
//*     TERMINATE THE COMPARISON.                                     *
//*  2. ADDED CODE TO SUPPRESS PAGES CONTAINING ONLY HEADER           *
//*     INFORMATION FOR MEMBERS THAT COMPARE AS EQUAL.                *
//*  3. ADDED CODE TO SUPPRESS OUTPUT LINES IN THE RECAP REPORT       *
//*     FOR MEMBERS THAT COMPARE AS EQUAL.                            *
//*  4. ADDED FREEPOOL INSTRUCTIONS AFTER DCB CLOSE STATEMENTS SO     *
//*     THAT PDS CAN LINK TO THIS ROUTINE WITHOUT LOSING STORAGE.     *
//*  5. ADDED FREEMAIN INSTRUCTIONS FOR THE DYNAMIC AREA AND THE      *
//*     MEMBER STORAGE ARRAY.                                         *
//*  6. ADDED OBTAIN MACROS TO GET THE FMT1DSCB FOR THE INPUT AND     *
//*     OUTPUT DATA SETS TO DETERMINE IF SEQUENTIAL OR PARTITIONED    *
//*     COMPARE IS REQUIRED.                                          *
//*                                                                   *
//* ON 1/12/88 COMPARE WAS MODIFIED TO RETURN FULL LENGTH LINES    ABL*
//* TO PDS.  PDS 8.3 AND ABOVE HAVE ENHANCED LOG FACILITIES.       ABL*
//*                                                                   *
//*
//* *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
//*                                                                   *
//* PLEASE REPORT ANY PROBLEMS, ENHANCEMENTS, SUGGESTIONS OR COMMENTS *
//* CONCERNING THIS PROGRAM TO:                                       *
//*                                                                   *
//*   A. BRUCE LELAND           OR         A. BRUCE LELAND            *
//*   SERENA INTERNATIONAL                 1103 KENDAL COURT          *
//*   500 AIRPORT BLVD. 2ND FLOOR          SAN JOSE, CALIF 95120      *
//*   BURLINGAME, CA  94010                                           *
//*   (415) 696-1800                       HOME (408) 997-2366        *
//*   INTERNET: BRUCE_LELAND@SERENA.COM                               *
//*                                                                   *
//* *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
//*                                                                   *
//* THE PROGRAM IS SELF CONTAINED;  SIMPLY RUN THIS JCL STREAM        *
//* AND ITS READY TO USE.                                             *
//*                                                                   *
//* THE JCL NEEDED TO EXECUTE COMPAREB FOLLOWS:                       *
//*     1) //         EXEC PGM=COMPAREB,REGION=2000K,                 *
//*     2) //             PARM='SIZE=NNNN,TYPE=OPT1,PRINT=OPT2'       *
//*     3) //SYSPRINT DD  SYSOUT=*                                    *
//*     4) //NEW      DD  DSN=PDS1,DISP=SHR                           *
//*     5) //OLD      DD  DSN=PDS2,DISP=SHR                           *
//*     6) //IGNORE   DD  *      OPTIONAL                             *
//*                                                                   *
//* WHERE    NNNN IS 3 OR 4 NUMERICS INDICATING AN ESTIMATE OF HOW    *
//*               MANY MEMBERS EXIST IN THE PDS WITH THE MOST MEMBERS.*
//*               THE DEFAULT VALUE IS 9999.  IF A VALUE OF LESS THAN *
//*               100 IS SUPPLIED, THE PROGRAM WILL CHANGE THE VALUE  *
//*               TO 100.  IF THERE ARE MORE MEMBERS THAN INDICATED   *
//*               BY THE SIZE PARAMETER, THE PROGRAM MAY ABEND.       *
//*                                                                   *
//*          OPT1 IS EITHER 'FULL', 'ASM', OR NOT SPECIFIED (THE      *
//*               DEFAULT). ACTUALLY, IF THE USER PROVIDES ANY VALUE  *
//*               OTHER THAN 'FULL', OR 'ASM' THEN THE DEFAULT WILL BE*
//*               ASSUMED.                                            *
//*               -TYPE=FULL INDICATES THAT ALL 80 COLS OF THE CARD   *
//*                IMAGE PDS WILL BE USED IN THE COMPARISON.          *
//*               -TYPE=ASM INDICATES THAT COLS 1-72 OF THE CARD      *
//*                IMAGE PDS WILL BE USED IN THE COMPARISON AND THE   *
//*                DEFAULT IGNORE ASSEMBLER DATA WILL BE USED.        *
//*               -IF NOT SPECIFIED ONLY COLS 1-72 WILL BE COMPARED,  *
//*                AND NO DEFAULT IGNORE DATA WILL BE USED.           *
//*                                                                   *
//*          OPT2 IS 'MEM', 'DIR', OR 'NAME'; 'NAME' IS THE DEFAULT   *
//*               VALUE.  PRINT=MEM INDICATES THAT IF ONE PDS CONTAINS*
//*               A MEMBER, BUT THE OTHER PDS DOES NOT CONTAIN A MEMBER
//*               WITH THE SAME NAME, THE  ENTIRE MEM WILL BE LISTED. *
//*               PRINT=DIR INDICATES THAT THE COMPARISON OF MEMBERS  *
//*               WON'T TAKE PLACE, BUT THE RECAP RPT WILL BE PRODUCED*
//*               TO SHOW WHICH MEMBERS EXISTS IN EACH PDS.  PRINT=NAME
//*               INDICATES THAT UNMATCHED MEMBERS WILL NOT BE PRINTED*
//*               IN THEIR ENTIRITY, HOWEVER, THEY WILL BE FLAGGED AS *
//*               UNMATCHED ON THE RECAP REPORT.                      *
//*                                                                   *
//*   THE 'NEW' AND 'OLD' DD STATEMENTS SHOULD BOTH POINT TO EITHER   *
//*   PDS DATASETS OR SEQUENTIAL DATASETS (OR A MEMBER OF A PDS). IF  *
//*   THE DATASET TYPES ARE MISMATCHED THEN THE COMPARISON TERMINATES *
//*   WITH A RETURN CODE OF 16.                                       *
//*                                                                   *
//*********************************************************************
//ASM1  EXEC  PGM=IFOX00,REGION=6000K,
//             PARM=(DECK,NOOBJECT,NORLD,RENT,TERM,'XREF(SHORT)')
//SYSLIB   DD  DSN=SYS1.AMODGEN,DISP=SHR
//         DD  DSN=SYS1.MACLIB,DISP=SHR
//SYSUT1   DD  UNIT=SYSDA,SPACE=(CYL,(10,5))
//SYSUT2   DD  UNIT=SYSDA,SPACE=(CYL,(10,5))
//SYSUT3   DD  UNIT=SYSDA,SPACE=(CYL,(10,5))
//SYSPUNCH DD  UNIT=SYSDA,SPACE=(TRK,(5,5)),DISP=(,PASS),DSN=&&X,
//         DCB=BLKSIZE=3120
//SYSPRINT DD  SYSOUT=*
//SYSTERM  DD  SYSOUT=*
//SYSLIN   DD  DUMMY
//SYSIN    DD  *
         TITLE '   C O M P A R E  '
***********************************************************************
*                                                                     *
*        'COMPARE' TSO COMMAND                                        *
*                                                                     *
***********************************************************************
*
*        WRITTEN BY. BILL GODFREY,  PLANNING RESEARCH CORPORATION.
*        INSTALLATION. PRC COMPUTER CENTER INC, MCLEAN VA.
*        DATE WRITTEN. MAY 12 1981.
*        DATE UPDATED. SEPTEMBER 17 1981.
*        ATTRIBUTES. RE-ENTRANT.
*        DESCRIPTION.
*         THIS TSO COMMAND INVOKES A COMPARE UTILITY PROGRAM
*         TO COMPARE TWO SEQUENTIAL DATA SETS (OR MEMBERS).
*
*         THE INVOKED UTILITY PROGRAM 'COMPAREB' IS A MODIFIED
*         VERSION OF THE YALE COMPARE PROGRAM FROM THE CBT TAPE.
*
*         THE COMMAND CAN OPTIONALLY INVOKE THE IBM UTILITY
*         'IEBCOMPR' OR A ZAPPED IEBCOMPR NAMED 'ZEBCOMPR'.
*         ZEBCOMPR DISPLAYS UNMATCHED RECORDS IN EBCDIC INSTEAD OF HEX.
*
*         THE COMMAND ALLOCATES THE TWO DATA SETS AND PASSES
*         THEIR DDNAMES TO THE UTILITY PROGRAM.
*
*        LOG OF CHANGES.
*         14MAY81 - COMPARE MEMBERNAMES BEFORE ISSUING MSG03.
*         15JUN81 - ZEBCOMPR KEYWORD ADDED.
*         16JUN81 - FULL KEYWORD ADDED.
*         16JUN81 - USERS CAN NOW USE THE NAME 'COMPARE' FOR BOTH
*                   THE TSO COMMAND AND THE BATCH PROGRAM (COMPAREB).
*                   IF A USER EXECUTES COMPARE AS A BATCH PROGRAM
*                   (EXEC PGM=COMPARE) OR FROM THE CALL COMMAND,
*                   THE COMMAND SIMPLY PASSES CONTROL DIRECTLY TO
*                   THE COMPAREB PROGRAM, AS IF THE USER HAD SPECIFIED
*                   EXEC PGM=COMPAREB.  THIS IS USEFUL AT INSTALLATIONS
*                   THAT INSTALLED THE BATCH PROGRAM AS 'COMPARE'
*                   BEFORE THEY HAD THE COMPARE COMMAND, AND DONT WANT
*                   TO MAKE THE USERS CHANGE THEIR EXISTING JCL.
*         17SEP81 - ASM/NOASM KEYWORD ADDED.
*         15OCT86 - CHANGE PROMPTS FOR DATASET NAMES TO INCLUDE OLD
*                   AND NEW. ALSO UPDATED THE HELP WITH ALL THE
*                   OPTIONS.     JIM MARSHALL
*         30MAR88 - ELIMINATE CHECK FOR SEQUENTIAL DS ONLY. COMPAREB
*                   WILL NOW HANDLE FULL PDS SPECIFICATION.
*                          GUY ALBERTELLI.
*         10MAY88 - ADD IN CODE FROM VERSION IN CBT FILE 296 FROM
*                   MR. BRUCE LELAND TO
*                     1. SUPPORT PDS COMMAND
*                     2. USER UNIT SYSALLDA IN MVS
*                     3. ELIMINATE 013-18 IF SPECIFIED MEMBER DOES
*                        NOT EXIST
*                           GUY ALBERTELLI
*         10JUN88 - ADD IN CODE TO PROVIDE A FREEPOOL AFTER DCB CLOSE
*                   TO FREE STORAGE OBTAINED FOR DCB BUFFERS
*                           BRUCE LELAND
*         31NOV92 - ADD IN CODE TO AVOID S013 FOR MISSING MEMBERS
*                   ALSO, ADD CODE TO DEFAULT THE NEW DATA SET MEMBER
*                   NAME IF IT IS LEFT OFF (THIS CAN BE USED TO
*                   COMPARE TWO DIFFERENT LEVELS OF THE SAME MODULE).
*                           BRUCE LELAND
*         01OCT09 - WHEN COMPARING ENTIRE PDS DATA SETS (THAT IS,
*                   OLD DATA SET DSORG IS PO AND NO MEMBER NAME IS
*                   SPECIFIED) CHANGE THE TYPORG PARAMETER ON THE
*                   IEBCOMPR/ZEBCOMPR CONTROL STATEMENT FROM 'PS'
*                   TO 'PO' SO IEBCOMPR/ZEBCOMPR DOES NOT CHOKE
*                   ON THE PDS DIRECTORY, BUT COMPARES SAME-NAMED
*                   MEMBERS INCLUDING DIRECTORY ENTRY USERDATA.
*                           GREG PRICE                           GP2009
*
*
***********************************************************************
         EJECT
***********************************************************************
*
*        SYNTAX.
*               COMPARE 'OLDDSNAME' 'NEWDSNAME'
*
*            OPTIONAL KEYWORDS ARE:
*               FULL     - INCLUDE THE SEQUENCE NUMBERS (YALE PGM).
*               ASM      - COMPARING ASSEMBLER SOURCE CODE (YALE PGM).
*               IEBCOMPR - THE IEBCOMPR UTILITY IS TO BE USED.
*               ZEBCOMPR - THE MODIFIED IEBCOMPR IS TO BE USED.
*               OVOL(VOLUME) - VOLUME CONTAINING THE OLD DATA SET.
*                          NOT NEEDED IF CATALOGED.
*               NVOL(VOLUME) - VOLUME CONTAINING THE NEW DATA SET.
*                          NOT NEEDED IF CATALOGED.
*               OUNIT(UNIT) - UNIT NAME FOR ALLOCATING THE OLD
*                          DATA SET. NOT NEEDED IF CATALOGED.
*               NUNIT(UNIT) - UNIT NAME FOR ALLOCATING THE NEW
*                          DATA SET. NOT NEEDED IF CATALOGED.
*               SYSOUT   - MESSAGES TO A SYSOUT DATA SET.
*               PRINT    - MESSAGES TO TERMINAL (DEFAULT).
*               NOPRINT  - MESSAGES TO DUMMY FILE.
*               OUTFILE(FILENAME) - MESSAGES TO SPECIFIED DDNAME.
*
*            WHEN THE OVOL OR NVOL KEYWORDS ARE USED TO INDICATE
*            TWO IDENTICALLY NAMED DATASETS ON DIFFERENT VOLUMES
*            ARE BEING USED, UNEXPECTED RESULTS CAN OCCUR UNLESS
*            BOTH OVOL AND NVOL ARE SPECIFIED.  FOR EXAMPLE, IF
*            OVOL IS SPECIFIED AND NVOL IS NOT, THE ALLOCATION
*            OF 'NEWDSNAME' WITH NO VOLUME SPECIFIED MAY PICK UP
*            THE ALREADY ALLOCATED 'OLDDSNAME' INSTEAD OF THE
*            'NEWDSNAME' IN THE CATALOG.
*
***********************************************************************
         EJECT
         GBLB  &MVS
&MVS     SETB  1                   1 - MVS    0 - SVS,MVT
         SPACE
COMPARE  START
         USING *,R10,R11
         B     @PROLOG-*(,15)
         DC    AL1(11),CL11'COMPARE '
         DC    CL16' &SYSDATE &SYSTIME '
@SIZE    DC    0F'0',AL1(1),AL3(@DATAL) SUBPOOL AND LENGTH
@PROLOG  STM   14,12,12(R13)
         LR    R10,R15             FIRST BASE REGISTER
         LA    R15,1
         LA    R11,4095(R15,R10)   SECOND BASE REGISTER
         LR    R2,R1               PARM POINTER
         TM    0(R2),X'80'         IS THIS A CPPL
         BO    PGM                 NO, GO INVOKE COMPAREB
         TM    4(R2),X'80'         IS THIS A CPPL
         BZ    CP                  YES, BRANCH
         SPACE
PGM      LA    R0,80
         GETMAIN R,LV=(0)
         ST    R13,4(,R1)          CHAIN FORWARD
         ST    R1,8(,R13)          CHAIN BACK
         LR    R13,R1              UPDATE SAVEAREA POINTER
         LA    R3,72(,R13)         POINT TO LINK MF=L
         XC    0(8,R3),0(R3)       CLEAR LINK MF=L
         LR    R1,R2
         LINK  EP=COMPAREB,SF=(E,(R3))
         LR    R2,R15              SAVE RETURN CODE
         LR    R1,R13              FOR FREEMAIN
         LA    R0,80               FOR FREEMAIN
         L     R13,4(,R13)         BACK TO OLD SAVEAREA
         FREEMAIN R,LV=(0),A=(1)
         LR    R15,R2              RETURN CODE
         LM    0,12,20(R13)
         L     R14,12(,R13)
         BR    R14
         SPACE
         USING CPPL,R2
CP       L     R0,@SIZE
         GETMAIN R,LV=(0)
         LR    R9,R1               INITIALIZE WORKAREA POINTER
         USING @DATA,R9
         SPACE 1
         LR    R15,R1              AREA TO BE CLEARED
         L     R1,@SIZE            LENGTH TO BE CLEARED
         LA    R0,0(,R1)           CLEAR HIGH ORDER BYTE
         SRDL  R0,8                DIVIDE BY 256
         SRL   R1,24               ISOLATE REMAINDER
         LTR   R0,R0               IS QUOTIENT ZERO
         BZ    CLEARR              YES, GO CLEAR REMAINDER
CLEARQ   XC    0(256,R15),0(R15)   CLEAR 256 BYTES
         LA    R15,256(,R15)
         BCT   R0,CLEARQ           DECREMENT QUOTIENT AND BRANCH
CLEARR   LTR   R1,R1               IS REMAINDER ZERO
         BZ    CLEARX              YES, BRANCH TO FINISH
         BCTR  R1,0                LENGTH MINUS 1 FOR EX
         B     *+10                BYPASS EXECUTED INSTR
         XC    0(0,R15),0(R15)     (EXECUTED)
         EX    R1,*-6              DO THE ABOVE XC
CLEARX   EQU   *
         SPACE 1
         ST    R13,4(,R9)          CHAIN FORWARD
         ST    R9,8(,R13)          CHAIN BACK
         LR    R13,R9              UPDATE SAVEAREA POINTER
         SPACE 1
************************************************************
*                                                          *
*        SET UP IOPL FOR PUTLINE                           *
*                                                          *
************************************************************
         SPACE
         ST    R2,VECTOR                                        ABL GLA
         LA    R15,MYIOPL
         USING IOPL,R15
         MVC   IOPLUPT(4),CPPLUPT
         MVC   IOPLECT(4),CPPLECT
         LA    R0,MYECB
         ST    R0,IOPLECB
         XC    MYECB,MYECB
         LA    R0,MYPTPB
         ST    R0,IOPLIOPB
         DROP  R15                 IOPL
         SPACE
         AIF   (NOT &MVS).SKIP1
         L     R15,16              LOAD CVT POINTER
         TM    444(R15),X'80'      IS PUTLINE LOADED? (VS2)
         BNO   PUTLOAD             NO - BRANCH TO LOAD
         L     R15,444(,R15)       YES - USE CVTPUTL
         B     PUTLODED            BRANCH AROUND LOAD
.SKIP1   ANOP
PUTLOAD  LA    R0,=CL8'IKJPUTL '
         LOAD  EPLOC=(0)
         LR    R15,R0              GET ENTRY ADDRESS
         LA    R15,0(,R15)         CLEAR HI BYTE FOR DELETE ROUTINE
PUTLODED ST    R15,MYPUTLEP        SAVE PUTLINE ENTRY ADDRESS
         SPACE
************************************************************
*                                                          *
*        SET UP DAPL FOR IKJDAIR                           *
*                                                          *
************************************************************
         SPACE
         LA    R15,MYDAPL
         USING DAPL,R15
         MVC   DAPLUPT(12),MYIOPL  UPT,ECT,ECB
         MVC   DAPLPSCB,CPPLPSCB
         LA    R0,MYDAPB
         ST    R0,DAPLDAPB
         DROP  R15                 DAPL
         SPACE
************************************************************
*                                                          *
*        SET UP PPL FOR PARSE                              *
*                                                          *
************************************************************
         SPACE
         LA    R15,MYPPL
         USING PPL,R15
         MVC   PPLUPT(4),CPPLUPT
         MVC   PPLECT(4),CPPLECT
         LA    R0,MYECB
         ST    R0,PPLECB
         XC    MYECB,MYECB
         L     R0,=A(COMPRPCL)
         ST    R0,PPLPCL
         LA    R0,MYANS
         ST    R0,PPLANS
         MVC   PPLCBUF(4),CPPLCBUF
         ST    R9,PPLUWA
         DROP  R15                 PPL
         SPACE 1
************************************************************
*                                                          *
*        CALL THE PARSE SERVICE ROUTINE                    *
*                                                          *
************************************************************
         SPACE 1
         LR    R1,R15              POINT TO PPL
         AIF   (NOT &MVS).SKIP2
         L     R15,16              CVTPTR
         TM    524(R15),X'80'      IF HI ORDER BIT NOT ON
         BNO   PARSELNK               THEN DO LINK, NOT CALL
         L     R15,524(,R15)       CVTPARS
         BALR  R14,R15             CALL IKJPARS
         B     PARSEEXT            SKIP AROUND LINK
PARSELNK EQU   *
.SKIP2   ANOP
         LINK  EP=IKJPARS,SF=(E,LINKAREA)
PARSEEXT EQU   *
         SPACE 1
         LTR   R15,R15             PARSE SUCCESSFUL?
         BZ    PARSEOK             YES, BRANCH
         LA    R1,MSG01
         LA    R0,L'MSG01
         BAL   R14,PUTMSG
         B     EXIT12
PARSEOK  EQU   *
         L     R3,MYANS
         USING IKJPARMD,R3
         MVI   DSNAME+2,C' '
         MVC   DSNAME+3(43),DSNAME+2
         MVC   DSNAM2+2(44),DSNAME+2
         MVC   MEMBER1,DSNAME+2
         MVC   MEMBER2,MEMBER1
         SPACE
************************************************************
*                                                          *
*         PROCESS 'OLD' DSNAME                             *
*                                                          *
************************************************************
         SPACE
         LA    R4,DSN
         TM    6(R4),X'80'         DSNAME PRESENT
         BZ    ERRNODSN            NO, BRANCH
         LH    R1,4(,R4)           GET LENGTH OF DSNAME
         STH   R1,DSNAME           DSN LENGTH IN DAIR BUFFER
         L     R15,0(,R4)          GET ADDRESS OF DSNAME
         BCTR  R1,0                LENGTH MINUS 1 FOR EX
         B     *+10                BRANCH AROUND EXECUTED INS
         MVC   DSNAME+2(0),0(R15)  (EXECUTED)
         EX    R1,*-6              MOVE DSNAME TO DAIR BUFFER
         SPACE
         LA    R5,MYDAPB           POINT TO DAIR PARAMETER BLOCK
         USING DAPB08,R5
         MVC   DA08CD(84),MODEL08  MOVE 08 MODEL DAPB
         LA    R0,DSNAME
         ST    R0,DA08PDSN
         SPACE
         TM    14(R4),X'80'        MEMBER NAME SPECIFIED?
         BZ    MEMDS1X             NO, BRANCH
         LH    R1,12(,R4)          YES, GET LENGTH OF MEMBER NAME
         L     R15,08(,R4)         GET ADDRESS OF MEMBER NAME
         BCTR  R1,0                LENGTH MINUS 1 FOR EX
         B     *+10                BRANCH AROUND EXECUTED INST
         MVC   DA08MNM(0),0(R15)   (EXECUTED)
         EX    R1,*-6              MOVE MEMBER NAME TO DAPB
         MVC   MEMBER1,DA08MNM
MEMDS1X  EQU   *
         SPACE
         TM    22(R4),X'80'        DSNAME/PASSWORD SPECIFIED?
         BZ    NOPASS              NO, BRANCH
         LH    R1,20(,R4)          YES, GET LENGTH OF PASSWORD
         L     R15,16(,R4)         GET ADDRESS OF PASSWORD
         BCTR  R1,0                LENGTH MINUS 1 FOR EX
         B     *+10                BRANCH AROUND EXECUTED INST
         MVC   DA08PSWD(0),0(R15)  (EXECUTED)
         EX    R1,*-6              MOVE PASSWORD TO DAPB
NOPASS   EQU   *
         SPACE
         OI    DA08DSP1,X'08'      DISP=SHR
         AIF   (&MVS).SKIP3        DAIR TO PREFIX DSNAME
         TM    6(R4),X'40'         IS DSNAME IN QUOTES
         BO    *+8                 YES, BRANCH
         OI    DA08CTL,X'20'       NO, TELL DAIR TO PREFIX DSNAME
.SKIP3   ANOP
         SPACE
************************************************************
*                                                          *
*        'OLD' UNIT AND VOLUME                             *
*                                                          *
************************************************************
         SPACE
         LA    R4,OVOL
         TM    6(R4),X'80'         VOLUME SPECIFIED
         BZ    NOOVOL              NO, BRANCH
         LH    R1,4(,R4)           GET LENGTH OF VOLUME
         LTR   R1,R1               IS LENGTH ZERO
         BZ    NOOVOL              YES, BRANCH
         L     R15,0(,R4)          GET ADDRESS OF VOLUME
         BCTR  R1,0                LENGTH MINUS 1 FOR EX
         B     *+10                BRANCH AROUND EXECUTED INS
         MVC   DA08SER(0),0(R15)   (EXECUTED)
         EX    R1,*-6              MOVE VOLUME TO DAIR PARAM
         SPACE
         LA    R4,OUNI
         TM    6(R4),X'80'         UNIT SPECIFIED
         BZ    OUNIT2              NO, BRANCH
         LH    R1,4(,R4)           GET LENGTH OF UNIT
         LTR   R1,R1               IS LENGTH ZERO
         BZ    OUNIT2              YES, BRANCH
         L     R15,0(,R4)          GET ADDRESS OF UNIT
         BCTR  R1,0                LENGTH MINUS 1 FOR EX
         B     *+10                BRANCH AROUND EXECUTED INS
         MVC   DA08UNIT(0),0(R15)  (EXECUTED)
         EX    R1,*-6              MOVE VOLUME TO DAIR PARAM
         B     OUNITX
         SPACE
OUNIT2   LA    R1,DA08SER          POINT TO VOLSER FOR UCB SEARCH
         AIF   (NOT &MVS).SKIP11                                    GLA
         MVC   DA08UNIT(8),=C'SYSALLDA'                             GLA
         AGO   .SKIP12                                              GLA
.SKIP11  ANOP                                                       GLA
         BAL   R14,CUU             FIND UCB FOR VOLUME
         LTR   R15,R15             DASD UCB FOUND?
         BZ    OUNITX              NO, LEAVE UNIT TO SESSION DEFAULT
         CLI   19(R15),X'0B'       3350?
         BNE   *+10                NO
         MVC   DA08UNIT(4),=C'3350'
         CLI   19(R15),X'0D'       3330-1?
         BNE   *+10                NO
         MVC   DA08UNIT(6),=C'3330-1'
         CLI   19(R15),X'09'       3330?
         BNE   OUNITX              NO
         MVC   DA08UNIT(4),=C'3330-1'  NOTE. ONLY MOVE 4 BYTES.
         TM    17(R15),X'08'       3330V (MSS VIRTUAL VOLUME)
         BZ    *+8
         MVI   DA08UNIT+4,C'V'     MAKE IT 3330V
.SKIP12  ANOP                                                       GLA
OUNITX   EQU   *
NOOVOL   EQU   *
         SPACE
************************************************************
*                                                          *
*        ALLOCATE THE 'OLD' DATA SET                       *
*                                                          *
************************************************************
         SPACE
         BAL   R14,CALLDAIR
         SPACE
         LTR   R15,R15
         BNZ   ERRDAIR
         MVC   DDUT1(8),DA08DDN    SAVE DDNAME
         SPACE
*                                                                   GLA
**   NO NEED TO FORCE MEMBER SINCE COMPAREB CAN HANDLE FULL PDS     GLA
**   BUT IF MEMBER SPECIFIED THEN VALIDATE THAT IT IS THERE         GLA
*                                                                   GLA
*   ************************************************************    GLA
*   *                                                          *    GLA
*   *         MEMBER MUST BE SPECIFIED IF DSORG IS PDS         *    GLA
*   *                                                          *    GLA
*   ************************************************************    GLA
         SPACE
         MVC   DSORG1,DA08DSO
         TM    DA08DSO,X'02'
         BZ    OKSEQ1
         CLI   DA08MNM,C' '
         BE    OKSEQ1              DONT WORRY IF NO MEMBER          GLA
         MVC   MSGWK(8),DA08MNM                                 ABL GLA
         MVC   DA08DDN(8),=CL8' '                                   ABL
         MVC   DA08MNM(8),=CL8' '                                   ABL
         BAL   R14,CALLDAIR                                         ABL
         LTR   R15,R15                                              ABL
         BNZ   ERRDAIR                                              ABL
         MVC   DDUT3(8),DA08DDN                                     ABL
         SPACE 1                                                    ABL
         LA    R6,VERDCBW                                       ABL GLA
         MVC   0(VERDCBL,R6),VERDCB                             ABL GLA
         MVC   DDNAM(8,R6),DA08DDN                              ABL GLA
         LA    R1,OPEN                                          ABL GLA
         XC    0(4,R1),0(R1)                                    ABL GLA
         MVI   0(R1),X'80'                                      ABL GLA
         OPEN  ((R6),INPUT),MF=(E,(1))                          ABL GLA
         TM    OFLGS(R6),X'10'                                  ABL GLA
         BNO   EXIT12                                           ABL GLA
         MVC   VERBLDL(4),=X'00010010'                          ABL GLA
         MVC   VERBLDL+4(8),MSGWK                               ABL GLA
         BLDL  (R6),VERBLDL                                     ABL GLA
         LR    R4,R15                                           ABL GLA
         LA    R1,OPEN                                          ABL GLA
         XC    0(4,R1),0(R1)                                    ABL GLA
         MVI   0(R1),X'80'                                      ABL GLA
         CLOSE ((R6)),MF=(E,(1))                                ABL GLA
         LTR   R4,R4                                            ABL GLA
         BNZ   MEMERROR                                         ABL GLA
*                                                               ABL GLA
OKSEQ1   EQU   *
         SPACE
************************************************************
*                                                          *
*         PROCESS 'NEW' DATA SET NAME                      *
*                                                          *
************************************************************
         SPACE
         LA    R4,DS2
         TM    6(R4),X'80'         DSNAME PRESENT
         BZ    ERRNODSN            NO, BRANCH
         LH    R1,4(,R4)           GET LENGTH OF DSNAME
         LTR   R1,R1               IS LENGTH ZERO
         BZ    EXIT12              YES, BRANCH
         STH   R1,DSNAM2           DSN LENGTH IN DAIR BUFFER
         L     R15,0(,R4)          GET ADDRESS OF DSNAME
         BCTR  R1,0                LENGTH MINUS 1 FOR EX
         B     *+10                BRANCH AROUND EXECUTED INS
         MVC   DSNAM2+2(0),0(R15)  (EXECUTED)
         EX    R1,*-6              MOVE DSNAME TO DAIR BUFFER
         SPACE
         LA    R5,MYDAPB           POINT TO DAIR PARAMETER BLOCK
         USING DAPB08,R5
         MVC   DA08CD(84),MODEL08  MOVE 08 MODEL DAPB
         LA    R0,DSNAM2
         ST    R0,DA08PDSN
         SPACE
         TM    14(R4),X'80'        MEMBER NAME SPECIFIED?
         BZ    MEMDS2X             NO, BRANCH
         LH    R1,12(,R4)          YES, GET LENGTH OF MEMBER NAME
         L     R15,08(,R4)         GET ADDRESS OF MEMBER NAME
         BCTR  R1,0                LENGTH MINUS 1 FOR EX
         B     *+10                BRANCH AROUND EXECUTED INST
         MVC   DA08MNM(0),0(R15)   (EXECUTED)
         EX    R1,*-6              MOVE MEMBER NAME TO DAPB
         MVC   MEMBER2,DA08MNM
MEMDS2X  EQU   *
         SPACE
         TM    22(R4),X'80'        DSNAME/PASSWORD SPECIFIED?
         BZ    NOPAS2              NO, BRANCH
         LH    R1,20(,R4)          YES, GET LENGTH OF PASSWORD
         LTR   R1,R1               LENGTH ZERO
         BZ    NOPAS2              YES, BRANCH
         L     R15,16(,R4)         GET ADDRESS OF PASSWORD
         BCTR  R1,0                LENGTH MINUS 1 FOR EX
         B     *+10                BRANCH AROUND EXECUTED INST
         MVC   DA08PSWD(0),0(R15)  (EXECUTED)
         EX    R1,*-6              MOVE PASSWORD TO DAPB
NOPAS2   EQU   *
         SPACE
         OI    DA08DSP1,X'08'      DISP=SHR
         AIF   (&MVS).SKIP4        DAIR TO PREFIX DSNAME
         TM    6(R4),X'40'         IS DSNAME IN QUOTES
         BO    *+8                 YES, BRANCH
         OI    DA08CTL,X'20'       NO, TELL DAIR TO PREFIX DSNAME
.SKIP4   ANOP
         SPACE
************************************************************
*                                                          *
*         'NEW' UNIT AND VOLUME                            *
*                                                          *
************************************************************
         SPACE
         LA    R4,NVOL
         TM    6(R4),X'80'         VOLUME SPECIFIED
         BZ    NONVOL              NO, BRANCH
         LH    R1,4(,R4)           GET LENGTH OF VOLUME
         LTR   R1,R1               IS LENGTH ZERO
         BZ    NONVOL              YES, BRANCH
         L     R15,0(,R4)          GET ADDRESS OF VOLUME
         BCTR  R1,0                LENGTH MINUS 1 FOR EX
         B     *+10                BRANCH AROUND EXECUTED INS
         MVC   DA08SER(0),0(R15)   (EXECUTED)
         EX    R1,*-6              MOVE VOLUME TO DAIR PARAM
         LA    R4,NUNI
         TM    6(R4),X'80'         UNIT SPECIFIED
         BZ    NUNIT2              NO, BRANCH
         LH    R1,4(,R4)           GET LENGTH OF UNIT
         LTR   R1,R1               IS LENGTH ZERO
         BZ    NUNIT2              YES, BRANCH
         L     R15,0(,R4)          GET ADDRESS OF UNIT
         BCTR  R1,0                LENGTH MINUS 1 FOR EX
         B     *+10                BRANCH AROUND EXECUTED INS
         MVC   DA08UNIT(0),0(R15)  (EXECUTED)
         EX    R1,*-6              MOVE VOLUME TO DAIR PARAM
         B     NUNITX
         SPACE
NUNIT2   LA    R1,DA08SER          POINT TO VOLSER FOR UCB SEARCH
         AIF   (NOT &MVS).SKIP21                                    GLA
         MVC   DA08UNIT(8),=C'SYSALLDA'                             GLA
         AGO   .SKIP22                                              GLA
.SKIP21  ANOP                                                       GLA
         BAL   R14,CUU             FIND UCB FOR VOLUME
         LTR   R15,R15             DASD UCB FOUND?
         BZ    NUNITX              NO, LEAVE UNIT TO SESSION DEFAULT
         CLI   19(R15),X'0B'       3350?
         BNE   *+10                NO
         MVC   DA08UNIT(4),=C'3350'
         CLI   19(R15),X'0D'       3330-1?
         BNE   *+10                NO
         MVC   DA08UNIT(6),=C'3330-1'
         CLI   19(R15),X'09'       3330?
         BNE   NUNITX              NO
         MVC   DA08UNIT(4),=C'3330-1'  NOTE. ONLY MOVE 4 BYTES.
         TM    17(R15),X'08'       3330V (MSS VIRTUAL VOLUME)
         BZ    *+8
         MVI   DA08UNIT+4,C'V'     MAKE IT 3330V
.SKIP22  ANOP                                                       GLA
NUNITX   EQU   *
NONVOL   EQU   *
         SPACE
************************************************************
*                                                          *
*        ALLOCATE THE 'NEW' DATA SET                       *
*                                                          *
************************************************************
         SPACE
         BAL   R14,CALLDAIR
         SPACE
         LTR   R15,R15
         BNZ   ERRDAIR
         MVC   DDUT2(8),DA08DDN    SAVE DDNAME
         SPACE
*                                                                   GLA
**   NO NEED TO FORCE MEMBER SINCE COMPAREB CAN HANDLE FULL PDS     GLA
**   BUT IF MEMBER SPECIFIED THEN VALIDATE THAT IT IS THERE         GLA
*                                                                   GLA
*   ************************************************************    GLA
*   *                                                          *    GLA
*   *         MEMBER NAME REQUIRED IF DSORG IS PARTITIONED     *    GLA
*   *                                                          *    GLA
*   ************************************************************    GLA
         SPACE
         MVC   DSORG2,DA08DSO
         TM    DA08DSO,X'02'
         BZ    OKSEQ2
**                                                                  ABL
**   IF MEMBER NAME FOR "NEW" BUT NOT FOR "OLD", DEFAULT TO         ABL
**   SAME MEMBER NAME (THIS IS A PDS).                              ABL
**                                                                  ABL
         MVC   MSGWK(8),DA08MNM                                 ABL GLA
         CLI   MEMBER1,C' '        A MEMBER NAME FOR "OLD"?         ABL
         BH    NOMEMBA             YES, BRANCH                      ABL
         CLI   DA08MNM,C' '
         BE    OKSEQ2              DONT WORRY IF NO MEMBER          GLA
NOMEMBA  CLI   DA08MNM,C' '        ANY MEMBER FOR "NEW"?            ABL
         BNE   NOMEMBB             YES, BRANCH                      ABL
         MVC   MSGWK(8),MEMBER1                                     ABL
         LA    R6,VERDCBW                                           ABL
         MVC   0(VERDCBL,R6),VERDCB                                 ABL
         MVC   DDNAM(8,R6),DA08DDN                                  ABL
         LA    R1,OPEN                                              ABL
         XC    0(4,R1),0(R1)                                        ABL
         MVI   0(R1),X'80'                                          ABL
         OPEN  ((R6),INPUT),MF=(E,(1))                              ABL
         TM    OFLGS(R6),X'10'                                      ABL
         BNO   EXIT12                                               ABL
         MVC   VERBLDL(4),=X'00010010'                              ABL
         MVC   VERBLDL+4(8),MSGWK                                   ABL
         BLDL  (R6),VERBLDL                                         ABL
         LR    R4,R15                                               ABL
         LA    R1,OPEN                                              ABL
         XC    0(4,R1),0(R1)                                        ABL
         MVI   0(R1),X'80'                                          ABL
         CLOSE ((R6)),MF=(E,(1))                                    ABL
         LTR   R4,R4                                                ABL
         BNZ   MEMERROR                                             ABL
         SPACE 1                                                    ABL
         MVC   MYDAPH(21*4),MYDAPB SAVE THE PARAMETER BLOCK         ABL
         USING DAPB18,R5                                            ABL
         MVC   DA18CD(MODEL18L),MODEL18                             ABL
         MVC   DA18DDN,DDUT2                                        ABL
         BAL   R14,CALLDAIR                                         ABL
         MVC   MYDAPB(21*4),MYDAPH RESTORE THE PARAMETER BLOCK      ABL
         USING DAPB08,R5                                            ABL
         MVC   MEMBER2,MEMBER1                                      ABL
         MVC   DA08MNM,MEMBER1                                      ABL
         MVC   DA08DDN(8),=CL8'NEWDD'                               ABL
         BAL   R14,CALLDAIR                                         ABL
         SPACE 1                                                    ABL
         LTR   R15,R15                                              ABL
         BNZ   ERRDAIR                                              ABL
         MVC   DDUT2(8),DA08DDN    SAVE DDNAME                      ABL
         B     OKSEQ2              CONTINUE WITH MEMBER COMPARE     ABL
NOMEMBB  DS    0H                                                   ABL
         MVC   DA08DDN(8),=CL8' '                                   ABL
         MVC   DA08MNM(8),=CL8' '                                   ABL
         BAL   R14,CALLDAIR                                         ABL
         LTR   R15,R15                                              ABL
         BNZ   ERRDAIR                                              ABL
         MVC   DDUT4(8),DA08DDN                                     ABL
         SPACE 1                                                    ABL
         LA    R6,VERDCBW                                       ABL GLA
         MVC   0(VERDCBL,R6),VERDCB                             ABL GLA
         MVC   DDNAM(8,R6),DA08DDN                              ABL GLA
         LA    R1,OPEN                                          ABL GLA
         XC    0(4,R1),0(R1)                                    ABL GLA
         MVI   0(R1),X'80'                                      ABL GLA
         OPEN  ((R6),INPUT),MF=(E,(1))                          ABL GLA
         TM    OFLGS(R6),X'10'                                  ABL GLA
         BNO   EXIT12                                           ABL GLA
         MVC   VERBLDL(4),=X'00010010'                          ABL GLA
         MVC   VERBLDL+4(8),MSGWK                               ABL GLA
         BLDL  (R6),VERBLDL                                     ABL GLA
         LR    R4,R15                                           ABL GLA
         LA    R1,OPEN                                          ABL GLA
         XC    0(4,R1),0(R1)                                    ABL GLA
         MVI   0(R1),X'80'                                      ABL GLA
         CLOSE ((R6)),MF=(E,(1))                                ABL GLA
         LTR   R4,R4                                            ABL GLA
         BNZ   MEMERROR                                         ABL GLA
*                                                               ABL GLA
         LA    R6,VERDCBW                                       ABL GLA
         MVC   0(VERDCBL,R6),VERDCB                             ABL GLA
         MVC   DDNAM(8,R6),DA08DDN                              ABL GLA
         LA    R1,OPEN                                          ABL GLA
         XC    0(4,R1),0(R1)                                    ABL GLA
         MVI   0(R1),X'80'                                      ABL GLA
         OPEN  ((R6),INPUT),MF=(E,(1))                          ABL GLA
         TM    OFLGS(R6),X'10'                                  ABL GLA
         BNO   EXIT12                                           ABL GLA
         MVC   VERBLDL(4),=X'00010010'                          ABL GLA
         MVC   VERBLDL+4(8),MSGWK                               ABL GLA
         BLDL  (R6),VERBLDL                                     ABL GLA
         LR    R4,R15                                           ABL GLA
         LA    R1,OPEN                                          ABL GLA
         XC    0(4,R1),0(R1)                                    ABL GLA
         MVI   0(R1),X'80'                                      ABL GLA
         CLOSE ((R6)),MF=(E,(1))                                ABL GLA
         LTR   R4,R4                                            ABL GLA
         BNZ   MEMERROR                                         ABL GLA
*                                                               ABL GLA
OKSEQ2   EQU   *                                                GLA
         SPACE
************************************************************
*                                                          *
*        CHECK FOR IDENTICAL DSNAMES AND VOLUMES           *
*                                                          *
************************************************************
         SPACE
         CLC   DSNAME+2(44),DSNAM2+2
         BNE   OKDIFF
         CLC   MEMBER1,MEMBER2
         BNE   OKDIFF
         LA    R4,DDUT1            POINT TO INPUT DDNAME
         BAL   R14,TIOTSCAN
         MVC   DOUBLE(6),28(R1)    HOLD VOL FROM UCB
         LA    R4,DDUT2            POINT TO OUTPUT DDNAME
         BAL   R14,TIOTSCAN
         CLC   DOUBLE(6),28(R1)    IS IT SAME VOLUME
         BNE   OKDIFF              NO, BRANCH
         LA    R1,MSG03
         LA    R0,L'MSG03
         BAL   R14,PUTMSG
         B     OKDIFF
*        B     EXIT12
         SPACE
TIOTSCAN L     R15,16              CVTPTR
         L     R15,0(,R15)         TCB WORDS
         L     R15,4(,R15)         CURRENT TCB
         L     R15,12(,R15)        TCBTIOT
         LA    R15,24(,R15)        TIOENTRY
         USING TIOENTRY,R15
TIOTLOOP CLI   TIOENTRY,X'00'      END OF TIOT?
         BER   R14                 YES - RETURN
         CLC   TIOEDDNM,0(R4)      DOES DDNAME MATCH?
         BE    TIOTEXIT            YES - RETURN
         SR    R1,R1
         IC    R1,TIOELNGH         GET LENGTH OF ENTRY
         LA    R15,0(R1,R15)       POINT TO NEXT ENTRY
         B     TIOTLOOP
TIOTEXIT L     R1,TIOEFSRT-1       GET UCB ADDRESS
         BR    R14
         SPACE
OKDIFF   EQU   *
         SPACE
************************************************************
*                                                          *
*        ALLOCATE THE SYSIN FILE                           *
*                                                          *
************************************************************
         SPACE
         CLI   IEBKW+1,0           IEBCOMPR REQUESTED
         BE    NOIN                NO, SKIP SYSIN
         MVC   DA08CD(84),MODEL08
         MVC   DA08UNIT,@UNITVIO
         MVI   DA08PQTY+3,1        1 TRACK
         MVI   DA08DSP1,DA08NEW
         OI    DA08CTL,DA08TRKS
         BAL   R14,CALLDAIR
         LTR   R15,R15
         BNZ   ERRDAIR
         MVC   DDIN,DA08DDN
         SPACE
************************************************************
*                                                          *
*        WRITE SYSIN CONTROL STATEMENTS                    *
*                                                          *
************************************************************
         SPACE
         LA    R6,CTLDCBW
         MVC   0(CTLDCBL,R6),CTLDCB
         MVC   DDNAM(8,R6),DDIN
         LA    R1,OPEN
         MVI   0(R1),X'80'
         OPEN  ((R6),OUTPUT),MF=(E,(1))
         TM    OFLGS(R6),X'10'
         BNO   EXIT12
         MVI   CARD,C' '
         MVC   CARD+1(79),CARD
         MVC   CARD+1(17),=C'COMPARE TYPORG=PS'
         TM    DSORG1,X'02'        PDS?                          GP2009
         BZ    TYPORGOK            NO, ASSUME SEQUENTIAL         GP2009
         CLI   MEMBER1,C' '        MEMBER NAME SPECIFIED?        GP2009
         BH    TYPORGOK            YES, TREAT AS SEQUENTIAL      GP2009
         MVI   CARD+17,C'O'        NO, TREAT AS PARTITIONED      GP2009
TYPORGOK EQU   *                   TYPORG NOW DECIDED            GP2009
         PUT   (R6),CARD
         SPACE
MEMX     MVI   CLOSE,X'80'
         CLOSE ((R6)),MF=(E,CLOSE)
         FREEPOOL (R6)                                              ABL
NOIN     EQU   *
         SPACE
************************************************************
*                                                          *
*        ALLOCATE THE SYSPRINT FILE (DUMMY)                *
*                                                          *
************************************************************
         SPACE
         CLI   PRINTKW+1,4         'NOPRINT' SPECIFIED?
         BNE   PRINTERM            NO
         MVC   DA08CD(84),MODEL08
         OI    DA08CTL,DA08DMMY
         BAL   R14,CALLDAIR
         LTR   R15,R15
         BNZ   ERRDAIR
         MVC   DDPRINT,DA08DDN
         B     PRINTX
         DROP  R5                  DAPB08
         SPACE
************************************************************
*                                                          *
*        ALLOCATE THE SYSPRINT FILE TO THE TERMINAL        *
*                                                          *
************************************************************
         SPACE
PRINTERM CLI   PRINTKW+1,1         PRINT
         BH    PRINTSYS
         USING DAPB1C,R5
         MVC   DA1CCD(MODEL1CL),MODEL1C
         BAL   R14,CALLDAIR
         LTR   R15,R15
         BNZ   ERRDAIR
         MVC   DDPRINT,DA1CDDN
         DROP  R5                  DAPB1C
         B     PRINTX
         SPACE
PRINTSYS CLI   PRINTKW+1,2         SYSOUT
         BNE   PRINTOUT
         USING DAPB30,R5
         MVC   DA30CD(MODEL30L),MODEL30
         BAL   R14,CALLDAIR
         LTR   R15,R15
         BNZ   ERRDAIR
         MVC   DDPRINT,DA30DDN
         MVI   FREEOPT,1           FREE DDPRINT WITH CLASS
         DROP  R5                  DAPB30
         B     PRINTX
         SPACE
PRINTOUT CLI   PRINTKW+1,3         OUTFILE
         BNE   PRINTX              NO, USE SYSPRINT
         LA    R4,OUT
         TM    6(R4),X'80'         OUTFILE PRESENT?
         BZ    PRINTX              NO, USE SYSPRINT
         LH    R1,4(,R4)           GET LENGTH
         L     R15,0(,R4)
         MVC   DDPRINT,=CL8' '
         BCTR  R1,0
         B     *+10
         MVC   DDPRINT(0),0(R15)
         EX    R1,*-6
         MVI   FREEOPT,2           DO NOT FREE DDPRINT
         B     PRINTX
         SPACE
PRINTX   EQU   *
         SPACE
************************************************************
*                                                          *
*        BUILD PARM FIELD AND DDNAME POINTERS              *
*                                                          *
************************************************************
         SPACE
         LA    R1,PARMPTR
         LA    R15,PARMLEN
         ST    R15,0(,R1)
         LA    R15,DDNAMES
         ST    R15,4(,R1)
         OI    4(R1),X'80'
         LA    R14,88
         STH   R14,0(,R15)
         MVC   LINKEP,=CL8'IEBCOMPR'
         CLI   IEBKW+1,1           IEBCOMPR REQUESTED
         BE    OKCOMPR             YES
         MVI   LINKEP,C'Z'         NO, TRY ZEBCOMPR
         CLI   IEBKW+1,2           ZEBCOMPR REQUESTED
         BE    OKCOMPR             YES
         MVC   LINKEP,=CL8'COMPAREB' NO, USE DEFAULT YALE COMPARE
         XC    DDIN,DDIN
         L     R14,VECTOR                                       ABL GLA
         L     R14,0(,R14)                                      ABL GLA
         CLI   PRINTKW+1,0         PRINT, DUMMY, SYSOUT OR FILE?ABL GLA
         BNE   PRINTZ              YES, BRANCH                  ABL GLA
         AH    R14,0(,R14)         POINT TO END OF PARSE STRING ABL GLA
         CLC   2(7,R14),=C'PDSCALL'  CALLED BY PDS FOR PUTLINE SUPPORT?
         BNE   PRINTZ                NO, BRANCH                 ABL GLA
         MVC   DDRETURN(4),10(R14) YES, COPY REENTRY VECTOR ADDRESS GLA
         MVI   DDRETURN,C'*'       YES, MARK FOR COMPAREB       ABL GLA
PRINTZ   DS    0H                                               ABL GLA
         CLI   FULLKW+1,1          FULL SPECIFIED
         BNE   NOTFULL             NO, BRANCH
         MVI   PARMLEN+1,9                                          GLA
         MVC   PARM(9),=C'TYPE=FULL'                                GLA
         CLI   ASMKW+1,1           ASM SPECIFIED
         BNE   OKCOMPR             NO, BRANCH
         MVI   PARMLEN+1,18                                         GLA
         MVC   PARM+9(9),=C',TYPE=ASM'                              GLA
         B     OKCOMPR
NOTFULL  CLI   ASMKW+1,1           ASM SPECIFIED
         BNE   OKCOMPR             NO, BRANCH
         MVI   PARMLEN+1,8                                          GLA
         MVC   PARM(8),=C'TYPE=ASM'                                 GLA
OKCOMPR  EQU   *
         SPACE
         LINK  EPLOC=LINKEP,SF=(E,LINKAREA)
         SPACE
         ST    R15,RETURNC                                          ABL
         LTR   R15,R15
         BZ    EXIT0
         B     ERRCOPY
         SPACE
************************************************************
*                                                          *
*         CALL DYNAMIC ALLOCATION                          *
*                                                          *
************************************************************
         SPACE
CALLDAIR LR    R8,R14
         LA    R1,MYDAPL
         AIF   (NOT &MVS).SKIP5
         L     R15,16              CVTPTR
         TM    X'02DC'(R15),X'80'  IF HI ORDER BIT NOT ON
         BNO   DAIRLINK               THEN DO LINK, NOT CALL
         L     R15,X'02DC'(,R15)   CVTDAIR
         BALR  R14,R15             CALL IKJDAIR
         B     DAIREXIT            SKIP AROUND LINK
DAIRLINK EQU   *
.SKIP5   ANOP
         LINK  EP=IKJDAIR,SF=(E,LINKAREA)
DAIREXIT EQU   *
         LR    R14,R8
         BR    R14
         SPACE
************************************************************
*                                                          *
*        DYNAMIC ALLOCATION FAILURE ROUTINE                *
*                                                          *
************************************************************
         SPACE
DAIRFAIL ST    R14,MYDFREGS
         AIF   (NOT &MVS).SKIP6
         LA    R1,MYDFPARM
         USING DFDSECTD,R1
         ST    R15,MYDFRC
         LA    R15,MYDFRC
         ST    R15,DFRCP
         LA    R15,MYDAPL
         ST    R15,DFDAPLP
         SLR   R15,R15
         ST    R15,MYJEFF02
         LA    R15,MYJEFF02
         ST    R15,DFJEFF02
         LA    R15,DFDAIR
         STH   R15,MYDFID
         LA    R15,MYDFID
         ST    R15,DFIDP
         ST    R2,DFCPPLP
         LINK  EP=IKJEFF18,SF=(E,LINKAREA)
         L     R15,MYDFRC
         DROP  R1                  DFDSECTD
.SKIP6   AIF   (&MVS).SKIP7
         LA    R1,MSGDAIR
         LA    R0,L'MSGDAIR
         BAL   R14,PUTMSG
.SKIP7   ANOP
         L     R14,MYDFREGS
         BR    R14
         SPACE
************************************************************
*                                                          *
*        CUU - GET UCB ADDRESS FOR A GIVEN VOLUME          *
*                                                          *
************************************************************
         SPACE
CUU      LR    0,14                SAVE RETURN ADDRESS
         L     14,16               CVTPTR
         L     14,X'28'(,14)       CVTILK2
CUU1     LH    15,0(,14)           LOAD UCB ADDRESS
         LTR   15,15               VALID ADDRESS?
         BZ    CUU2                NULL - TRY NEXT
         BM    CUU3                END OF LIST
         CLI   18(15),X'20'        DASD?
         BNE   CUU2                NO - TRY NEXT
         TM    3(15),X'80'         ONLINE?
         BZ    CUU2                NO - TRY NEXT
         CLC   28(6,15),0(1)       DOES VOLUME SERIAL MATCH?
         BNE   CUU2                NO - TRY NEXT
         LR    14,0                RESTORE RETURN ADDRESS
         BR    14                  RETURN
CUU2     LA    14,2(,14)           INCREMENT UCB POINTER
         B     CUU1                CONTINUE
CUU3     SLR   15,15               CLEAR UCB POINTER
         LR    14,0                RESTORE RETURN ADDRESS
         BR    14                  RETURN
         SPACE
************************************************************
*                                                          *
*        ERROR HANDLERS                                    *
*                                                          *
************************************************************
         SPACE
ERRNODSN LA    R1,MSG06
         LA    R0,L'MSG06
         BAL   R14,PUTMSG
         B     EXIT12
         SPACE
ERRDAIR  BAL   R14,DAIRFAIL
         B     EXIT12
         SPACE
ERRPDS   LA    R15,MSGWK
         BAL   R14,DSNOUT
ERRPDSC  MVC   0(30,R15),=CL30' IS A PARTITIONED DATA SET'
         LA    R15,30(,R15)
         LA    R1,MSGWK
         LR    R0,R15
         SR    R0,R1
         BAL   R14,PUTMSG
         B     EXIT12
ERRPD2   LA    R15,MSGWK
         BAL   R14,DSNOU2
         B     ERRPDSC
         SPACE
MEMERROR LA    R15,MSGWK+8
         MVC   0(30,R15),=CL30' IS NOT IN THE DATA SET'
         LA    R15,30(,R15)
         LA    R1,MSGWK
         LR    R0,R15
         SR    R0,R1
         BAL   R14,PUTMSG
         B     EXIT12
         SPACE
ERRCOPY  CVD   R15,DOUBLE
         LA    R15,MSGWK
         BAL   R14,DSNOUT
         MVC   0(21,R15),=CL21' COMPARE RETURN CODE'
         LA    R15,21(,R15)
         MVI   0(R15),C' '
         UNPK  1(3,R15),DOUBLE+6(2)
         OI    3(R15),X'F0'
         CLI   1(R15),C'0'
         BNE   *+14
         MVC   1(2,R15),2(R15)
         MVI   3(R15),C' '
         CLI   1(R15),C'0'
         BNE   *+14
         MVC   1(2,R15),2(R15)
         MVI   3(R15),C' '
         LA    R15,4(,R15)
         LA    R1,MSGWK
         LR    R0,R15
         SR    R0,R1
         L     R15,RETURNC         GET RETURN CODE                  ABL
         CLI   DDRETURN,C'*'       INVOKED BY PDS INTERNAL CALL?    GLA
         BE    EXIT                YES, BRANCH                  ABL/GLA
         BAL   R14,PUTLINE
         L     R15,RETURNC         GET RETURN CODE                  ABL
         B     EXIT                                                 ABL
         SPACE
DSNOUT   LH    R1,DSNAME
         BCTR  R1,0
         B     *+10
         MVC   0(0,R15),DSNAME+2
         EX    R1,*-6
         LA    R15,1(R1,R15)
         BR    R14
         SPACE
DSNOU2   LH    R1,DSNAM2
         BCTR  R1,0
         B     *+10
         MVC   0(0,R15),DSNAM2+2
         EX    R1,*-6
         LA    R15,1(R1,R15)
         BR    R14
         SPACE
************************************************************
*                                                          *
*        PUTMSG ROUTINE                                    *
*                                                          *
************************************************************
         SPACE
PUTMSG   STM   R14,R1,MYREGS
         XC    MYOLD(8),MYOLD
         XC    MYSEG1(4),MYSEG1
         MVC   MYPTPB(12),MODLPTPM
         LA    R14,1               NO. OF MESSAGE SEGMENTS
         ST    R14,MYOLD
         LA    R14,MYSEG1          POINT TO 1ST SEGMENT
         ST    R14,MYOLD+4
         LR    R14,R0              LENGTH IN R0
         LA    R14,4(,R14)         ADD 4
         LA    R15,MYSEG1+4
         CLC   0(3,R1),=C'IKJ'     IS DATA PRECEEDED BY MESSAGE ID?
         BE    *+16                YES - BRANCH
         LA    R14,1(,R14)         ADD 1 TO LENGTH
         MVI   0(R15),C' '         INSERT LEADING BLANK
         LA    R15,1(,R15)         BUMP POINTER
         STH   R14,MYSEG1
         LR    R14,R0
         BCTR  R14,0
         B     *+10
         MVC   0(0,R15),0(R1)      MOVE MESSAGE IN
         EX    R14,*-6
         LA    R1,MYIOPL
         L     R15,MYPUTLEP
         SPACE
         PUTLINE PARM=MYPTPB,OUTPUT=(MYOLD),ENTRY=(15),MF=(E,(1))
         SPACE
         LM    R14,R1,MYREGS
         BR    R14
         SPACE
************************************************************
*                                                          *
*        PUTLINE ROUTINE                                   *
*                                                          *
************************************************************
         SPACE
PUTLINE  STM   R14,R1,MYREGS
         XC    MYSEG1(4),MYSEG1
         MVC   MYPTPB(12),MODLPTPB
         LR    R14,R0              LENGTH IN R0
         LA    R14,4(,R14)         ADD 4
         STH   R14,MYSEG1
         LR    R14,R0
         BCTR  R14,0
         B     *+10
         MVC   MYSEG1+4(0),0(R1)   MOVE TEXT IN
         EX    R14,*-6
         LA    R1,MYIOPL
         L     R15,MYPUTLEP
         SPACE
         PUTLINE PARM=MYPTPB,OUTPUT=(MYSEG1,DATA),ENTRY=(15),MF=(E,(1))
         SPACE
         LM    R14,R1,MYREGS
         BR    R14
         SPACE
EXIT12   LA    R15,12
         B     EXIT
         SPACE 1
EXIT0    SR    R15,R15             RETURN CODE ZERO
EXIT     LR    R2,R15              HOLD RETURN CODE
         IKJRLSA MYANS
         DROP  R3
         SPACE
         USING DAPB18,R5
         CLI   DDUT1,0
         BE    FFUT1
         MVC   DA18CD(MODEL18L),MODEL18
         MVC   DA18DDN,DDUT1
         BAL   R14,CALLDAIR
FFUT1    EQU   *
         CLI   DDUT2,0
         BE    FFUT2
         MVC   DA18CD(MODEL18L),MODEL18
         MVC   DA18DDN,DDUT2
         BAL   R14,CALLDAIR
FFUT2    EQU   *
         CLI   DDUT3,0                                              ABL
         BE    FFUT3                                                ABL
         MVC   DA18CD(MODEL18L),MODEL18                             ABL
         MVC   DA18DDN,DDUT3                                        ABL
         BAL   R14,CALLDAIR                                         ABL
FFUT3    EQU   *                                                    ABL
         CLI   DDUT4,0                                              ABL
         BE    FFUT4                                                ABL
         MVC   DA18CD(MODEL18L),MODEL18                             ABL
         MVC   DA18DDN,DDUT4                                        ABL
         BAL   R14,CALLDAIR                                         ABL
FFUT4    EQU   *                                                    ABL
         CLI   DDIN,0
         BE    FFIN
         MVC   DA18CD(MODEL18L),MODEL18
         MVC   DA18DDN,DDIN
         BAL   R14,CALLDAIR
FFIN     EQU   *
         CLI   DDPRINT,0
         BE    FFPRINT
         CLI   FREEOPT,2           OUTFILE
         BE    FFPRINT             YES, LEAVE ALLOCATED
         MVC   DA18CD(MODEL18L),MODEL18
         MVC   DA18DDN,DDPRINT
         CLI   FREEOPT,1           SYSOUT?
         BNE   *+8                 NO
         MVI   DA18SCLS,C'A'       YES
         BAL   R14,CALLDAIR
FFPRINT  EQU   *
         DROP  R5                  DAPB18
         TM    MYPUTLEP,X'80'      WAS PUTLINE LOADED
         BO    DELPUTLX            NO, BRANCH
         LA    R0,=CL8'IKJPUTL'    YES, DELETE IT
         DELETE EPLOC=(0)
DELPUTLX EQU   *
         LTR   R2,R2               IS RC ZERO?
         BZ    STACKDX             YES, BRANCH
         MVC   MYSTPB(STACKDL),STACKD
         SPACE
         STACK DELETE=ALL,PARM=MYSTPB,MF=(E,MYIOPL)
         SPACE
         TCLEARQ
STACKDX  EQU   *
EXITX    LR    R15,R2              RESTORE RETURN CODE
         LR    1,R13               SET UP FREE ADDRESS
         L     R13,4(,R13)         RESTORE PREVIOUS SAVEAREA
         ST    R15,16(,R13)        STORE RETURN CODE FOR LM
         L     R0,@SIZE
         FREEMAIN R,A=(1),LV=(0)
         LM    14,12,12(R13)       LOAD RETURN ADDRESS AND RC
         BR    14                  RETURN
         SPACE
************************************************************
*                                                          *
*        CONSTANTS                                         *
*                                                          *
************************************************************
         SPACE
@UNITVIO DC    CL8'SYSDA'
MODLPTPM PUTLINE OUTPUT=(1,TERM,SINGLE,INFOR),                         X
               TERMPUT=(EDIT,WAIT,NOHOLD,NOBREAK),MF=L
         SPACE
MODLPTPB PUTLINE OUTPUT=(1,TERM,SINGLE,DATA),                          X
               TERMPUT=(EDIT,WAIT,NOHOLD,NOBREAK),MF=L
         SPACE
MODEL08  DC    AL2(8),XL10'0',CL24' ',XL16'0',CL16' ',XL8'0',CL8' '
MODEL08L EQU   *-MODEL08
MODEL18  DC    X'0018',XL10'0',CL18' ',XL2'0',CL8' '
MODEL18L EQU   *-MODEL18
MODEL1C  DC    X'001C',XL6'0',CL16' '
MODEL1CL EQU   *-MODEL1C
MODEL30  DC    X'0030',XL10'0',CL24' ',XL12'0',CL14' ',XL2'0',CL8' '
MODEL30L EQU   *-MODEL30
         SPACE
MSG01    DC    C'PARSE ERROR'
MSG03    DC    C'YOU ARE COMPARING A DATA SET TO ITSELF'
MSG06    DC    C'IKJ58509I DATA SET NAME REQUIRED WHEN MEMBER IS SPECIF+
               IED'
MSGDAIR  DC    C'UNABLE TO ALLOCATE'
         LTORG
         PRINT NOGEN
CTLDCB   DCB   DDNAME=DYNAM,DSORG=PS,MACRF=PM,BUFNO=2,                 +
               RECFM=FB,LRECL=80,BLKSIZE=800
CTLDCBL  EQU   *-CTLDCB
VERDCB   DCB   DDNAME=DYNAM,DSORG=PO,MACRF=R,DEVD=DA            ABL GLA
VERDCBL  EQU   *-VERDCB
         PRINT GEN
DDNAM    EQU   40
OFLGS    EQU   48
         SPACE
OBTAIN   CAMLST SEARCH,2,3,4
OBTAINL  EQU   *-OBTAIN
         SPACE
STACKD   STACK DELETE=ALL,MF=L
STACKDL  EQU   *-STACKD
         SPACE
************************************************************
*                                                          *
*        PARSE PCL                                         *
*                                                          *
************************************************************
         SPACE
         PRINT NOGEN
COMPRPCL IKJPARM
DSN      IKJPOSIT DSNAME,USID,PROMPT='OLD DATA SET NAME',              +
               HELP='FIRST (OR OLD) DATA SET NAME'
DS2      IKJPOSIT DSNAME,USID,PROMPT='NEW DATA SET NAME',              +
               HELP='SECOND (OR NEW) DATA SET NAME'
OUNIKW   IKJKEYWD
         IKJNAME 'OUNIT',SUBFLD=OUNISF
NUNIKW   IKJKEYWD
         IKJNAME 'NUNIT',SUBFLD=NUNISF
OVOLKW   IKJKEYWD
         IKJNAME 'OVOLUME',SUBFLD=OVOLSF
NVOLKW   IKJKEYWD
         IKJNAME 'NVOLUME',SUBFLD=NVOLSF
PRINTKW  IKJKEYWD
         IKJNAME 'PRINT'
         IKJNAME 'SYSOUT'
         IKJNAME 'OUTFILE',SUBFLD=OUTSF
         IKJNAME 'NOPRINT'
IEBKW    IKJKEYWD
         IKJNAME 'IEBCOMPR'
         IKJNAME 'ZEBCOMPR'
FULLKW   IKJKEYWD
         IKJNAME 'FULL'
ASMKW    IKJKEYWD DEFAULT='ASM'
         IKJNAME 'ASM'
         IKJNAME 'NOASM'
OUNISF   IKJSUBF
OUNI     IKJIDENT 'UNIT',FIRST=ALPHANUM,OTHER=ANY,MAXLNTH=8,           +
               PROMPT='UNIT NAME FOR OLD DATA SET'
NUNISF   IKJSUBF
NUNI     IKJIDENT 'UNIT',FIRST=ALPHANUM,OTHER=ANY,MAXLNTH=8,           +
               PROMPT='UNIT NAME FOR NEW DATA SET'
OVOLSF   IKJSUBF
OVOL     IKJIDENT 'VOLUME',FIRST=ALPHANUM,OTHER=ALPHANUM,MAXLNTH=6,    +
               PROMPT='VOLUME SERIAL FOR OLD DATA SET'
NVOLSF   IKJSUBF
NVOL     IKJIDENT 'VOLUME',FIRST=ALPHANUM,OTHER=ALPHANUM,MAXLNTH=6,    +
               PROMPT='VOLUME SERIAL FOR NEW DATA SET'
OUTSF    IKJSUBF
OUT      IKJIDENT 'OUTFILE FILENAME',                                  +
               FIRST=ALPHA,OTHER=ALPHANUM,MAXLNTH=8,                   +
               PROMPT='OUTFILE FILENAME'
         IKJENDP
         PRINT GEN
         SPACE
************************************************************
*                                                          *
*        DSECTS                                            *
*                                                          *
************************************************************
         SPACE
TIOT     DSECT
         DS    CL24                JOBNAME, ETC
TIOENTRY DS    0C
TIOELNGH DS    AL1                 LENGTH OF THIS ENTRY
         DS    XL3
TIOEDDNM DS    CL8                 DD NAME
TIOEJFCB DS    CL3                 TTR OF JFCB
         DS    XL2
TIOEFSRT DS    AL3                 ADDRESS OF UCB
         SPACE
@DATA    DSECT
         DS    18F                 REGISTER SAVEAREA
DOUBLE   DS    D
LINKAREA DS    2F
LINKEP   DS    0CL8
MYPPL    DS    7F
VECTOR   DS    F                                                ABL GLA
RETURNC  DS    F                  RETURN CODE                       ABL
MYANS    DS    F
MYECB    DS    F                  USED BY PUTLINE ROUTINE
MYIOPL   DS    4F                 USED BY PUTLINE ROUTINE
MYPTPB   DS    3F                 USED BY PUTLINE ROUTINE
MYPUTLEP DS    F                  USED BY PUTLINE ROUTINE
MYOLD    DS    2F                 USED BY PUTLINE ROUTINE
MYSEG1   DS    2H,CL100           USED BY PUTLINE ROUTINE
MYREGS   DS    4F                 USED BY PUTLINE ROUTINE
MYDFREGS DS    F
MYSTPB   DS    0F                 USED BY STACK DELETE (5F)
MYDAPL   DS    5F
MYDAPB   DS    21F
MYDAPH   DS    21F                                                  ABL
DSNAME   DS    H,CL44
DSNAM2   DS    H,CL44
MEMBER1  DS    CL8
MEMBER2  DS    CL8
MEMDSPDE DS    5F                 FAKE SELECT PDE
MYDFPARM DS    5F  USED BY DAIRFAIL
MYDFRC   DS    F   USED BY DAIRFAIL
MYJEFF02 DS    F   USED BY DAIRFAIL
MYDFID   DS    H   USED BY DAIRFAIL
*
FREEOPT  DS    H
*
PARMPTR  DS    2F,H
PARMLEN  DS    H
PARM     DS    0F,CL20
DDNAMES  DS    H,CL32
DDIN     DS    CL8
DDPRINT  DS    CL8
DDRETURN DS    CL8                                              ABL GLA
DDUT1    DS    CL8
DDUT2    DS    CL8
DDUT3    DS    CL8
DDUT4    DS    CL8
*
MSGWK    DS    CL72
OPEN     DS    0F
CLOSE    DS    F
CTLDCBW  DS    0D,(CTLDCBL)X
VERDCBW  DS    0D,(VERDCBL)X
VERREGS  DS    F
VERBLDL  DS    2H,CL8,CL4
DSORG1   DS    C
DSORG2   DS    C
OBTVOL   DS    CL6
OBTAINW  DS    4F
DSCB     DS    CL140
         DS    0D
CARD     DS    CL80
@DATAL   EQU   *-@DATA
         SPACE
         IKJCPPL
         SPACE
         IKJIOPL
         SPACE
         IKJPPL
         SPACE
         IKJDAPL
         SPACE
         IKJDAP08
         SPACE
         IKJDAP18
         SPACE
         IKJDAP1C
         SPACE
         IKJDAP30
         SPACE
         AIF   (NOT &MVS).SKIP8
         IKJEFFDF DFDSECT=YES
.SKIP8   ANOP
         SPACE
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
         END
//*
//LNK1   EXEC  PGM=IEWL,PARM='LIST,MAP,RENT,REUS,REFR',COND=(5,LT)
//SYSPRINT DD  SYSOUT=*
//SYSLINX  DD  DSN=&&X,DISP=(OLD,DELETE)
//SYSLMOD  DD  DISP=SHR,DSN=SYS2.CMDLIB(COMPARE)
//SYSUT1   DD  UNIT=SYSDA,SPACE=(TRK,(5,5))
//SYSLIN   DD  *
  INCLUDE SYSLINX
  ALIAS   COMPARE$
  NAME    COMPARE(R)
//*
//ASM2  EXEC  PGM=IFOX00,REGION=6000K,
//             PARM=(DECK,NOOBJECT,NORLD,TERM,
//             'XREF(SHORT)')
//SYSLIB   DD  DSN=SYS1.AMODGEN,DISP=SHR
//         DD  DSN=SYS1.MACLIB,DISP=SHR
//SYSUT1   DD  UNIT=SYSDA,SPACE=(CYL,(10,5))
//SYSUT2   DD  UNIT=SYSDA,SPACE=(CYL,(10,5))
//SYSUT3   DD  UNIT=SYSDA,SPACE=(CYL,(10,5))
//SYSPUNCH DD  UNIT=SYSDA,SPACE=(TRK,(5,5)),DISP=(,PASS),DSN=&&X,
//         DCB=BLKSIZE=3120
//SYSPRINT DD  SYSOUT=*
//SYSLIN   DD  DUMMY
//SYSTERM  DD  SYSOUT=*
//SYSIN    DD  *
         TITLE 'PDS/SEQ COMPARE PROGRAM -- USE YALE COMPARE PGM LOGIC'
*$DOC$*****************************************************************
*                                                                     *
*   THIS IS AN ENHANCEMENT (COMBINATION) OF TWO FLAVORS OF THE YALE   *
*   COMPARE PROGRAM. THE FIRST WAS TAKEN FROM FILE 45 OF THE CBT      *
*   TAPE AND WAS MODIFIED FROM THE ORIGINAL BY MR. BRENT TOLMAN.      *
*   THE SECOND SOURCE IS THE VERSION FROM FILE 300 OF THE CBT TAPE    *
*   AND WAS MODIFIED BY MR. BILL GODFREY AND MR. JIM MARSHALL         *
*   ADDITIONAL CODE FROM THE VERSION FROM FILE 296 OF THE CBT TAPE    *
*   HAS BEEN ADDED TO ALLOW THIS VERSION TO ALSO FUNCTION UNDER       *
*   THE PDS COMMAND. FILE 296 IS FROM MR. BRUCE LELAND                *
*                                                                     *
*   THE INTEND OF THIS COMBINATION IS TO PRODUCE A VERSION THAT       *
*   CAN COMPARE EITHER TWO ENTIRE PDS'S, OR TWO SEQUENTIAL FILES.     *
*   IT IS ALSO DESIRED THAT IT CAN BE INVOKED BY THE 'COMPARE'        *
*   TSO COMMAND WRITTEN BY MR. BILL GODFREY.                          *
*                                                                     *
*                                                                     *
*   THE FEATURES IN THIS PROGRAM ARE:                                 *
*    1. USES THE YALE COMPARE PROGRAM LOGIC FOR COMPARING AND RESYNC- *
*       RONIZATRION.                                                  *
*    2. SUPPORTS COMPARES OF FULL PDS DATASETS (DON'T SPECIFY A       *
*       MEMBER NAME TO USE THIS FEATURE).                             *
*    3. SUPPORTS COMPARES OF TWO SEQUENTIAL DATASETS (EITHER REAL     *
*       SEQUENTIAL DATASETS OR MEMBERS SPECIFIED IN JCL).             *
*    4. SUPPORTS RECORD SIZES DIFFERENT FROM 80 BYTES BUT LESS THAN   *
*       256 BYTES (NOTE IGNORE CARDS MUST BE 80 BYTES LONG) -SEE BELOW*
*    5. CAN BE INVOKED WITH A DDNAME PARAMETER LIST FROM THE          *
*       'COMPARE' TSO COMMAND (MODIFIED FROM CBT FILE 300).           *
*    6. ALSO ENCLOSED IS THE NECESSARY PANEL, CLIST, AND SKELETON     *
*       TO INVOKE IT UNDER ISPF                                       *
*    7. CODE FROM MR. BRUCE LELAND TO SUPPORT THE PDS COMMAND HAS     *
*       ALSO BEEN IMPLEMENTED.                                        *
*                                                                     *
*   GUY L. ALBERTELLI                                                 *
*   B. F. GOODRICH                                                    *
*   3925 EMBASSY PARKWAY                                              *
*   AKRON, OHIO  44313                                                *
*       216-374-4071                                                  *
*                                                                     *
*                                                                     *
*   SEVERAL CHANGES WERE MADE TO THIS PROGRAM ON 6/10/88 TO BETTER    *
*   SUPPORT ITS USE FROM THE PDS COMMAND PROCESSOR:                   *
*    1. CHANGES WERE MADE TO ALLOW PDS CHECKPOINT PROCESSING TO       *
*       TERMINATE THE COMPARISON.                                     *
*    2. ADDED CODE TO SUPPRESS PAGES CONTAINING ONLY HEADER           *
*       INFORMATION FOR MEMBERS THAT COMPARE AS EQUAL.                *
*    3. ADDED CODE TO SUPPRESS OUTPUT LINES IN THE RECAP REPORT       *
*       FOR MEMBERS THAT COMPARE AS EQUAL.                            *
*    4. ADDED FREEPOOL INSTRUCTIONS AFTER DCB CLOSE STATEMENTS SO     *
*       THAT PDS CAN LINK TO THIS ROUTINE WITHOUT LOSING STORAGE.     *
*    5. ADDED FREEMAIN INSTRUCTIONS FOR THE DYNAMIC AREA AND THE      *
*       MEMBER STORAGE ARRAY.                                         *
*                                                                     *
*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
*                                                                     *
* PLEASE REPORT ANY PROBLEMS, ENHANCEMENTS, SUGGESTIONS OR COMMENTS   *
* CONCERNING THIS PROGRAM TO:                                         *
*                                                                     *
*     A. BRUCE LELAND           OR         A. BRUCE LELAND            *
*     SERENA INTERNATIONAL                 1103 KENDAL COURT          *
*     500 AIRPORT BLVD. 2ND FLOOR          SAN JOSE, CALIF 95120      *
*     BURLINGAME, CA  94010                                           *
*     (415) 696-1800                       HOME (408) 997-2366        *
*     INTERNET: BRUCE_LELAND@SERENA.COM                               *
*                                                                     *
*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
*                                                                     *
*   THE PROGRAM IS SELF CONTAINED;  SIMPLY ASSEMBLE AND LINK          *
*   AND ITS READY TO USE.                                             *
*                                                                     *
*   THE JCL NEEDED TO EXECUTE COMPAREB FOLLOWS:                       *
*       1) //         EXEC PGM=COMPAREB,REGION=2000K,                 *
*       2) //             PARM='SIZE=NNNN,TYPE=OPT1,PRINT=OPT2'       *
*       3) //SYSPRINT DD  SYSOUT=*                                    *
*       4) //NEW      DD  DSN=PDS1,DISP=SHR                           *
*       5) //OLD      DD  DSN=PDS2,DISP=SHR                           *
*       6) //IGNORE   DD  *      OPTIONAL                             *
*                                                                     *
*   WHERE    NNNN IS 3 OR 4 NUMERICS INDICATING AN ESTIMATE OF HOW    *
*                 MANY MEMBERS EXIST IN THE PDS WITH THE MOST MEMBERS.*
*                 THE DEFAULT VALUE IS 9999.  IF A VALUE OF LESS THAN *
*                 100 IS SUPPLIED, THE PROGRAM WILL CHANGE THE VALUE  *
*                 TO 100.  IF THERE ARE MORE MEMBERS THAN INDICATED   *
*                 BY THE SIZE PARAMETER, THE PROGRAM MAY ABEND.       *
*                                                                     *
*            OPT1 IS EITHER 'FULL', 'ASM', OR NOT SPECIFIED (THE      *
*                 DEFAULT). ACTUALLY, IF THE USER PROVIDES ANY VALUE  *
*                 OTHER THAN 'FULL', OR 'ASM' THEN THE DEFAULT WILL BE*
*                 ASSUMED.                                            *
*                 -TYPE=FULL INDICATES THAT ALL 80 COLS OF THE CARD   *
*                  IMAGE PDS WILL BE USED IN THE COMPARISON.          *
*                 -TYPE=ASM INDICATES THAT COLS 1-72 OF THE CARD      *
*                  IMAGE PDS WILL BE USED IN THE COMPARISON AND THE   *
*                  DEFAULT IGNORE ASSEMBLER DATA WILL BE USED.        *
*                 -IF NOT SPECIFIED ONLY COLS 1-72 WILL BE COMPARED,  *
*                  AND NO DEFAULT IGNORE DATA WILL BE USED.           *
*                                                                     *
*            OPT2 IS 'MEM', 'DIR', OR 'NAME'; 'NAME' IS THE DEFAULT   *
*                 VALUE.  PRINT=MEM INDICATES THAT IF ONE PDS CONTAINS*
*                 A MEMBER, BUT THE OTHER PDS DOES NOT CONTAIN A MEMBER
*                 WITH THE SAME NAME, THE  ENTIRE MEM WILL BE LISTED. *
*                 PRINT=DIR INDICATES THAT THE COMPARISON OF MEMBERS  *
*                 WON'T TAKE PLACE, BUT THE RECAP RPT WILL BE PRODUCED*
*                 TO SHOW WHICH MEMBERS EXISTS IN EACH PDS.  PRINT=NAME
*                 INDICATES THAT UNMATCHED MEMBERS WILL NOT BE PRINTED*
*                 IN THEIR ENTIRITY, HOWEVER, THEY WILL BE FLAGGED AS *
*                 UNMATCHED ON THE RECAP REPORT.                      *
*                                                                     *
*     THE 'NEW' AND 'OLD' DD STATEMENTS SHOULD BOTH POINT TO EITHER   *
*     PDS DATASETS OR SEQUENTIAL DATASETS (OR A MEMBER OF A PDS). IF  *
*     THE DATASET TYPES ARE MISMATCHED THEN THE COMPARISON TERMINATES *
*     WITH A RETURN CODE OF 16.                                       *
*                                                                     *
*$DOC$*****************************************************************
         EJECT                                                      BFG
*          DATA SET CBT1274J   AT LEVEL 002 AS OF 07/20/83
* CHANGED PARM DEFAULT FROM 1000 TO 9999     AXC-CBT
*
*   THIS IS AN ENHANCEMENT TO THE YALE COMPARE PROGRAM THAT IS
*   DISTRIBTED AS FILE 226 ON THE CONN. BANK MODS TAPE.  THE PURPOSE
*   OF THE ENHANCEMENT IS TO ALLOW THE COMPARE PROGRAM TO PROCESS
*   TWO PDS FILES RATHER THAN TWO SEQUENTIAL FILES.  THE ORIGINAL
*   PROGRAM HAS BEEN MODIFIED A LITTLE TO ACCOMODATE THE FRONT
*   END PDS PROCESSOR.
*
*
*
*   THE OUTPUT OF THE PROGRAM CONSISTS OF A DETAILED LISTING AND A
*   RECAP REPORT.  THE DETAILED LISTING SHOWS:
*      - THE MEMBER NAME, DATA SET NAME, AND VOL/SER OF EACH MEMBER
*        PROCESSED.
*      - ANY DIFFERENCES THAT EXIST BETWEEN THE MEMBERS.
*      - A COUNT OF UNEQUAL BLOCKS OF DATA AS WELL AS THE RECORD COUNTS
*        FOR EACH MEMBER.
*   THE RECAP LISTING FORMAT IS:
*      OLD MEM=XXXXXXXX PAGE NNNN NEW MEM=YYYYYYYY STATUS
*      THE STATUS MAY BE
*          - EQUAL           BOTH MEMBERS ARE THE SAME
*          - NOT EQUAL       THERE ARE DIFFERENCES
*          - NO MATCH        THE MEMBER EXISTS IN ONLY ONE PDS
*
*   WE USE THE PROGRAM TO COMPARE PARMLIB, PROCLIBS, ETC. FROM ONE
*   CPU TO ANOTHER AND ALSO AS AN AID WHEN INSTALLING NEW SCP RELEASES.
*
*   BRENT TOLMAN
*   TRANSPORTAION MANAGEMENT SERVICES
*   SALT LAKE CITY, UT
*
*
*
*
          EJECT
*$DOC$*****************************************************************
*                                                                     *
* COMPAREB - A MODIFIED VERSION OF THE YALE COMPARE PROGRAM.          *
*                                                                     *
* MODIFICATIONS AT AFDSC/PENTAGON:                                    *
*  07MAY81 - BILL GODFREY, PLANNING RESEARCH CORP.                    *
*   .  CHECK FOR 'IGNORE' DD WITH DEVTYPE AND BYPASS OPEN IF NOT      *
*      FOUND, SO OPEN WILL NOT WTO 'DD STATEMENT MISSING'.            *
*   .  NAME CHANGED TO 'COMPAREB' (SAVING NAME 'COMPARE' FOR A TSO    *
*      COMMAND WHICH WILL INVOKE THIS PROGRAM).                       *
*   .  ACCEPT ALTERNATE DDNAMES FROM INVOKER.                         *
*      DDNAMES ARE IN SAME SLOTS AS IBM UTILITIES.                    *
*   .  USE R11 AS BASE REGISTER INSTEAD OF R13                        *
*   .  CONVERT PARM TO CAPS.                                          *
*   .  CHANGE SYSPRINT LRECL FROM 109 TO 121                          *
*   .  TEST ALL DCB'S FOR SUCCESSFUL OPEN                             *
*  09JUN81 - BILL GODFREY                                             *
*   .  PROGRAM CHANGED TO ALLOW RECORDS LONGER THAN 80 BYTES TO       *
*      BE COMPARED.  A GOOD WAY TO COMPARE LOAD MODULES IS TO         *
*      COMPARE HEX DUMPS OF THEM. NOW THIS PROGRAM CAN COMPARE        *
*      PRINT FILES (IF THEY ARE FIXED LENGTH RECORDS).                *
*   .  CHANGE ALL BAL-R10 INSTRUCTIONS TO USE BAL-R14 INSTEAD,        *
*      (AND SAVE R14) SO WE CAN USE R10 FOR ANOTHER PURPOSE.          *
*   .  PUT THE RECORD LENGTH IN R10.                                  *
*   .  CHANGE ALL INSTRUCTIONS THAT USE THE RECORD LENGTH (80)        *
*      OR 2 RECORD LENGTHS (160) TO USE THE VALUE IN REGISTER R10     *
*      INSTEAD, SO THE PROGRAM CAN COMPARE MORE THAN 80 BYTES.        *
*   .  CHANGE MLENGTH FIELD TO A HALFWORD AND USE IT TO HOLD          *
*      A ZERO OR AN EIGHT INSTEAD OF A 79 OR 71.                      *
*   .  FIX S0C9 IN DCB OPEN EXIT, DIVIDING BY LRECL ZERO WHEN         *
*      RECFM IS UNBLOCKED.                                            *
*   .  PROGRAM WILL NO LONGER USE DEFAULT IGNORE DATA (FOR ASSEMBLER  *
*      SOURCE) UNLESS PARM=ASM IS SPECIFIED.                          *
*   .  FIX PARM FIELD BUG INTRODUCED 07MAY81, PARM=FULL WAS NEVER     *
*      RECOGNIZED AFTER THAT CHANGE.                                  *
*   .  CHECK PARM FIELD FOR 'FULL' OR 'ASM' ANYWHERE IN FIRST 16      *
*      BYTES.                                                         *
*  16JUN81 - BILL GODFREY                                             *
*   .  FIX PARM DD BUG INTRODUCED 09JUN81.                            *
*      R1 WAS DESTROYED PRIOR TO PARMX. USE R4 INSTEAD OF R1.         *
*   .  CHANGE R10 TO 256 IF LRECL GREATER THAN 256.                   *
*                                                                     *
*   NOTE: THIS PROGRAM WORKS CORRECTLY ONLY ON FIXED LENGTH RECORDS   *
*   FROM 80 TO 256 BYTES LONG. ONLY THE FIRST 80 BYTES OF A RECORD    *
*   ARE LISTED. NO WARNING MESSAGE IS ISSUED FOR RECORDS LONGER THAN  *
*   256 OR VARIABLE LENGTH.  ** NO LONGER APPLICABLE -- GP MAR 92 **  *
*                                                                     *
*  21NOV91 - GREG PRICE (GP@P6)                                       *
*   .  HANDLE LRECL LESS THAN 80                                      *
*      - NEVER MOVE MORE THAN LRECL BYTES TO PRINT LINE BUFFER        *
*      - FORCE 'FULL' IF LRECL IS NOT GREATER THAN 8                  *
*  30MAR92 - GREG PRICE (GP)                                          *
*   .  CORRECTLY DETECT TYPE=ASM, DO NOT CORRUPT PARM LENGTH REG R2   *
*   .  ADD ROUTCDE=(11) TO ALL WTOS EXCEPT ONE WHICH ALREADY HAD IT   *
*   .  PUT TIME AND JULIAN DATE IN PAGE HEADING LINE                  *
*   .  COMPARE WHOLE RECORD EVEN IF MORE THAN 256 BYTES LONG          *
*   .  HANDLE UNDEFINED AND VARIABLE LENGTH RECORDS                   *
*  12OCT92 - GREG PRICE (GP@FT)                                       *
*   .  AVOID S0C4 BY SKIPPING IGNORE TEST IF NOT FIXED LENGTH RECORDS *
*  12JUN93 - BRUCE LELAND AS SUGGESTED BY GREG PRICE                  *
*   .        MADE CHANGES TO GETMAIN A VARIABLE AMOUNT OF             *
*   .        STORAGE BETWEEN 100K AND 2000K; THEN FREEMAIN 16K        *
*   .        (PREVIOUSLY BETWEEN 80K AND 800K; THEN FREEMAIN 4K)      *
*                                                                     *
*$DOC$*****************************************************************
         EJECT
         TITLE 'PDS/SEQ COMPARE PROGRAM -- USE YALE COMPARE PGM LOGIC'
*$DOC$*****************************************************************
*                                                                     *
*   THIS IS AN ENHANCEMENT (COMBINATION) OF TWO FLAVORS OF THE YALE   *
*   COMPARE PROGRAM. THE FIRST WAS TAKEN FROM FILE 45 OF THE CBT      *
*   TAPE AND WAS MODIFIED FROM THE ORIGINAL BY MR. BRENT TOLMAN.      *
*   THE SECOND SOURCE IS THE VERSION FROM FILE 300 OF THE CBT TAPE    *
*   AND WAS MODIFIED BY MR. BILL GODFREY AND MR. JIM MARSHALL         *
*   ADDITIONAL CODE FROM THE VERSION FROM FILE 296 OF THE CBT TAPE    *
*   HAS BEEN ADDED TO ALLOW THIS VERSION TO ALSO FUNCTION UNDER       *
*   THE PDS COMMAND. FILE 296 IS FROM MR. BRUCE LELAND                *
*                                                                     *
*   THE INTEND OF THIS COMBINATION IS TO PRODUCE A VERSION THAT       *
*   CAN COMPARE EITHER TWO ENTIRE PDS'S, OR TWO SEQUENTIAL FILES.     *
*   IT IS ALSO DESIRED THAT IT CAN BE INVOKED BY THE 'COMPARE'        *
*   TSO COMMAND WRITTEN BY MR. BILL GODFREY.                          *
*                                                                     *
*                                                                     *
*   THE FEATURES IN THIS PROGRAM ARE:                                 *
*    1. USES THE YALE COMPARE PROGRAM LOGIC FOR COMPARING AND RESYNC- *
*       RONIZATRION.                                                  *
*    2. SUPPORTS COMPARES OF FULL PDS DATASETS (DON'T SPECIFY A       *
*       MEMBER NAME TO USE THIS FEATURE).                             *
*    3. SUPPORTS COMPARES OF TWO SEQUENTIAL DATASETS (EITHER REAL     *
*       SEQUENTIAL DATASETS OR MEMBERS SPECIFIED IN JCL).             *
*    4. SUPPORTS RECORD SIZES DIFFERENT FROM 80 BYTES BUT LESS THAN   *
*       256 BYTES (NOTE IGNORE CARDS MUST BE 80 BYTES LONG) -SEE BELOW*
*    5. CAN BE INVOKED WITH A DDNAME PARAMETER LIST FROM THE          *
*       'COMPARE' TSO COMMAND (MODIFIED FROM CBT FILE 300).           *
*    6. ALSO ENCLOSED IS THE NECESSARY PANEL, CLIST, AND SKELETON     *
*       TO INVOKE IT UNDER ISPF                                       *
*    7. CODE FROM MR. BRUCE LELAND TO SUPPORT THE PDS COMMAND HAS     *
*       ALSO BEEN IMPLEMENTED.                                        *
*                                                                     *
*   GUY L. ALBERTELLI                                                 *
*   B. F. GOODRICH                                                    *
*   3925 EMBASSY PARKWAY                                              *
*   AKRON, OHIO  44313                                                *
*       216-374-4071                                                  *
*                                                                     *
*                                                                     *
*   SEVERAL CHANGES WERE MADE TO THIS PROGRAM ON 6/10/88 TO BETTER    *
*   SUPPORT ITS USE FROM THE PDS COMMAND PROCESSOR:                   *
*    1. CHANGES WERE MADE TO ALLOW PDS CHECKPOINT PROCESSING TO       *
*       TERMINATE THE COMPARISON.                                     *
*    2. ADDED CODE TO SUPPRESS PAGES CONTAINING ONLY HEADER           *
*       INFORMATION FOR MEMBERS THAT COMPARE AS EQUAL.                *
*    3. ADDED CODE TO SUPPRESS OUTPUT LINES IN THE RECAP REPORT       *
*       FOR MEMBERS THAT COMPARE AS EQUAL.                            *
*    4. ADDED FREEPOOL INSTRUCTIONS AFTER DCB CLOSE STATEMENTS SO     *
*       THAT PDS CAN LINK TO THIS ROUTINE WITHOUT LOSING STORAGE.     *
*    5. ADDED FREEMAIN INSTRUCTIONS FOR THE DYNAMIC AREA AND THE      *
*       MEMBER STORAGE ARRAY.                                         *
*                                                                     *
*   A. BRUCE LELAND                                                   *
*   HITACHI AMERICA LTD.                                              *
*   2210 O'TOOLE AVENUE                                               *
*   SAN JOSE, CAL.  95131                                             *
*       408-435-2078                                                  *
*                                                                     *
*                                                                     *
*   THE PROGRAM IS SELF CONTAINED;  SIMPLY ASSEMBLE AND LINK          *
*   AND ITS READY TO USE.                                             *
*                                                                     *
*   THE JCL NEEDED TO EXECUTE COMPAREB FOLLOWS:                       *
*       1) //         EXEC PGM=COMPAREB,REGION=2000K,                 *
*       2) //             PARM='SIZE=NNNN,TYPE=OPT1,PRINT=OPT2'       *
*       3) //SYSPRINT DD  SYSOUT=*                                    *
*       4) //NEW      DD  DSN=PDS1,DISP=SHR                           *
*       5) //OLD      DD  DSN=PDS2,DISP=SHR                           *
*       6) //IGNORE   DD  *      OPTIONAL                             *
*                                                                     *
*   WHERE    NNNN IS 3 OR 4 NUMERICS INDICATING AN ESTIMATE OF HOW    *
*                 MANY MEMBERS EXIST IN THE PDS WITH THE MOST MEMBERS.*
*                 THE DEFAULT VALUE IS 9999.  IF A VALUE OF LESS THAN *
*                 100 IS SUPPLIED, THE PROGRAM WILL CHANGE THE VALUE  *
*                 TO 100.  IF THERE ARE MORE MEMBERS THAN INDICATED   *
*                 BY THE SIZE PARAMETER, THE PROGRAM MAY ABEND.       *
*                                                                     *
*            OPT1 IS EITHER 'FULL', 'ASM', OR NOT SPECIFIED (THE      *
*                 DEFAULT). ACTUALLY, IF THE USER PROVIDES ANY VALUE  *
*                 OTHER THAN 'FULL', OR 'ASM' THEN THE DEFAULT WILL BE*
*                 ASSUMED.                                            *
*                 -TYPE=FULL INDICATES THAT ALL 80 COLS OF THE CARD   *
*                  IMAGE PDS WILL BE USED IN THE COMPARISON.          *
*                 -TYPE=ASM INDICATES THAT COLS 1-72 OF THE CARD      *
*                  IMAGE PDS WILL BE USED IN THE COMPARISON AND THE   *
*                  DEFAULT IGNORE ASSEMBLER DATA WILL BE USED.        *
*                 -IF NOT SPECIFIED ONLY COLS 1-72 WILL BE COMPARED,  *
*                  AND NO DEFAULT IGNORE DATA WILL BE USED.           *
*                                                                     *
*            OPT2 IS 'MEM', 'DIR', OR 'NAME'; 'NAME' IS THE DEFAULT   *
*                 VALUE.  PRINT=MEM INDICATES THAT IF ONE PDS CONTAINS*
*                 A MEMBER, BUT THE OTHER PDS DOES NOT CONTAIN A MEMBER
*                 WITH THE SAME NAME, THE  ENTIRE MEM WILL BE LISTED. *
*                 PRINT=DIR INDICATES THAT THE COMPARISON OF MEMBERS  *
*                 WON'T TAKE PLACE, BUT THE RECAP RPT WILL BE PRODUCED*
*                 TO SHOW WHICH MEMBERS EXISTS IN EACH PDS.  PRINT=NAME
*                 INDICATES THAT UNMATCHED MEMBERS WILL NOT BE PRINTED*
*                 IN THEIR ENTIRITY, HOWEVER, THEY WILL BE FLAGGED AS *
*                 UNMATCHED ON THE RECAP REPORT.                      *
*                                                                     *
*     THE 'NEW' AND 'OLD' DD STATEMENTS SHOULD BOTH POINT TO EITHER   *
*     PDS DATASETS OR SEQUENTIAL DATASETS (OR A MEMBER OF A PDS). IF  *
*     THE DATASET TYPES ARE MISMATCHED THEN THE COMPARISON TERMINATES *
*     WITH A RETURN CODE OF 16.                                       *
*                                                                     *
*$DOC$*****************************************************************
         EJECT                                                      BFG
*          DATA SET CBT1274J   AT LEVEL 002 AS OF 07/20/83
* CHANGED PARM DEFAULT FROM 1000 TO 9999     AXC-CBT
*
*   THIS IS AN ENHANCEMENT TO THE YALE COMPARE PROGRAM THAT IS
*   DISTRIBTED AS FILE 226 ON THE CONN. BANK MODS TAPE.  THE PURPOSE
*   OF THE ENHANCEMENT IS TO ALLOW THE COMPARE PROGRAM TO PROCESS
*   TWO PDS FILES RATHER THAN TWO SEQUENTIAL FILES.  THE ORIGINAL
*   PROGRAM HAS BEEN MODIFIED A LITTLE TO ACCOMODATE THE FRONT
*   END PDS PROCESSOR.
*
*
*
*   THE OUTPUT OF THE PROGRAM CONSISTS OF A DETAILED LISTING AND A
*   RECAP REPORT.  THE DETAILED LISTING SHOWS:
*      - THE MEMBER NAME, DATA SET NAME, AND VOL/SER OF EACH MEMBER
*        PROCESSED.
*      - ANY DIFFERENCES THAT EXIST BETWEEN THE MEMBERS.
*      - A COUNT OF UNEQUAL BLOCKS OF DATA AS WELL AS THE RECORD COUNTS
*        FOR EACH MEMBER.
*   THE RECAP LISTING FORMAT IS:
*      OLD MEM=XXXXXXXX PAGE NNNN NEW MEM=YYYYYYYY STATUS
*      THE STATUS MAY BE
*          - EQUAL           BOTH MEMBERS ARE THE SAME
*          - NOT EQUAL       THERE ARE DIFFERENCES
*          - NO MATCH        THE MEMBER EXISTS IN ONLY ONE PDS
*
*   WE USE THE PROGRAM TO COMPARE PARMLIB, PROCLIBS, ETC. FROM ONE
*   CPU TO ANOTHER AND ALSO AS AN AID WHEN INSTALLING NEW SCP RELEASES.
*
*   BRENT TOLMAN
*   TRANSPORTAION MANAGEMENT SERVICES
*   SALT LAKE CITY, UT
*
*
*
*
          EJECT
*$DOC$*****************************************************************
*                                                                     *
* COMPAREB - A MODIFIED VERSION OF THE YALE COMPARE PROGRAM.          *
*                                                                     *
* MODIFICATIONS AT AFDSC/PENTAGON:                                    *
*  07MAY81 - BILL GODFREY, PLANNING RESEARCH CORP.                    *
*   .  CHECK FOR 'IGNORE' DD WITH DEVTYPE AND BYPASS OPEN IF NOT      *
*      FOUND, SO OPEN WILL NOT WTO 'DD STATEMENT MISSING'.            *
*   .  NAME CHANGED TO 'COMPAREB' (SAVING NAME 'COMPARE' FOR A TSO    *
*      COMMAND WHICH WILL INVOKE THIS PROGRAM).                       *
*   .  ACCEPT ALTERNATE DDNAMES FROM INVOKER.                         *
*      DDNAMES ARE IN SAME SLOTS AS IBM UTILITIES.                    *
*   .  USE R11 AS BASE REGISTER INSTEAD OF R13                        *
*   .  CONVERT PARM TO CAPS.                                          *
*   .  CHANGE SYSPRINT LRECL FROM 109 TO 121                          *
*   .  TEST ALL DCB'S FOR SUCCESSFUL OPEN                             *
*  09JUN81 - BILL GODFREY                                             *
*   .  PROGRAM CHANGED TO ALLOW RECORDS LONGER THAN 80 BYTES TO       *
*      BE COMPARED.  A GOOD WAY TO COMPARE LOAD MODULES IS TO         *
*      COMPARE HEX DUMPS OF THEM. NOW THIS PROGRAM CAN COMPARE        *
*      PRINT FILES (IF THEY ARE FIXED LENGTH RECORDS).                *
*   .  CHANGE ALL BAL-R10 INSTRUCTIONS TO USE BAL-R14 INSTEAD,        *
*      (AND SAVE R14) SO WE CAN USE R10 FOR ANOTHER PURPOSE.          *
*   .  PUT THE RECORD LENGTH IN R10.                                  *
*   .  CHANGE ALL INSTRUCTIONS THAT USE THE RECORD LENGTH (80)        *
*      OR 2 RECORD LENGTHS (160) TO USE THE VALUE IN REGISTER R10     *
*      INSTEAD, SO THE PROGRAM CAN COMPARE MORE THAN 80 BYTES.        *
*   .  CHANGE MLENGTH FIELD TO A HALFWORD AND USE IT TO HOLD          *
*      A ZERO OR AN EIGHT INSTEAD OF A 79 OR 71.                      *
*   .  FIX S0C9 IN DCB OPEN EXIT, DIVIDING BY LRECL ZERO WHEN         *
*      RECFM IS UNBLOCKED.                                            *
*   .  PROGRAM WILL NO LONGER USE DEFAULT IGNORE DATA (FOR ASSEMBLER  *
*      SOURCE) UNLESS PARM=ASM IS SPECIFIED.                          *
*   .  FIX PARM FIELD BUG INTRODUCED 07MAY81, PARM=FULL WAS NEVER     *
*      RECOGNIZED AFTER THAT CHANGE.                                  *
*   .  CHECK PARM FIELD FOR 'FULL' OR 'ASM' ANYWHERE IN FIRST 16      *
*      BYTES.                                                         *
*  16JUN81 - BILL GODFREY                                             *
*   .  FIX PARM DD BUG INTRODUCED 09JUN81.                            *
*      R1 WAS DESTROYED PRIOR TO PARMX. USE R4 INSTEAD OF R1.         *
*   .  CHANGE R10 TO 256 IF LRECL GREATER THAN 256.                   *
*                                                                     *
*   NOTE: THIS PROGRAM WORKS CORRECTLY ONLY ON FIXED LENGTH RECORDS   *
*   FROM 80 TO 256 BYTES LONG. ONLY THE FIRST 80 BYTES OF A RECORD    *
*   ARE LISTED. NO WARNING MESSAGE IS ISSUED FOR RECORDS LONGER THAN  *
*   256 OR VARIABLE LENGTH.  ** NO LONGER APPLICABLE -- GP MAR 92 **  *
*                                                                     *
*  21NOV91 - GREG PRICE (GP@P6)                                       *
*   .  HANDLE LRECL LESS THAN 80                                      *
*      - NEVER MOVE MORE THAN LRECL BYTES TO PRINT LINE BUFFER        *
*      - FORCE 'FULL' IF LRECL IS NOT GREATER THAN 8                  *
*  30MAR92 - GREG PRICE (GP)                                          *
*   .  CORRECTLY DETECT TYPE=ASM, DO NOT CORRUPT PARM LENGTH REG R2   *
*   .  ADD ROUTCDE=(11) TO ALL WTOS EXCEPT ONE WHICH ALREADY HAD IT   *
*   .  PUT TIME AND JULIAN DATE IN PAGE HEADING LINE                  *
*   .  COMPARE WHOLE RECORD EVEN IF MORE THAN 256 BYTES LONG          *
*   .  HANDLE UNDEFINED AND VARIABLE LENGTH RECORDS                   *
*  12OCT92 - GREG PRICE (GP@FT)                                       *
*   .  AVOID S0C4 BY SKIPPING IGNORE TEST IF NOT FIXED LENGTH RECORDS *
*  12JUN93 - BRUCE LELAND AS SUGGESTED BY GREG PRICE                  *
*   .  MADE CHANGES TO GETMAIN A VARIABLE AMOUNT OF                   *
*      STORAGE BETWEEN 100K AND 2000K; THEN FREEMAIN 16K              *
*      (PREVIOUSLY BETWEEN 80K AND 800K; THEN FREEMAIN 4K)            *
*  10MAY96 - GREG PRICE (-GP)                                         *
*   .  TRANSLATE UNPRINTABLES OUT OF SYSPRINT WHEN GOING TO TSO       *
*      TERMINAL TO AVOID PROG753 WITH PC/3270 FOR WINDOWS.            *
*                                                                     *
*$DOC$*****************************************************************
         EJECT
COMPAREB CSECT
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
         SPACE 3
         STM   R14,R12,12(R13)     SAVE THEIR REGS IN THEIR AREA
         LR    R11,R15             LOAD BASE REG WITH ENTRY ADDR
         LA    R6,4095(,R11)       LOAD SECOND BASE
         LA    R6,1(,R6)           WITH PROPER ADDRESS
         LA    R7,4095(,R6)        LOAD THIRD BASE
         LA    R7,1(,R7)           WITH PROPER ADDRESS
         USING COMPAREB,R11,R6,R7  ESTABLISH ADDRESSABILITY
         ST    R7,SAVER07          MAKE SURE ADDRESS READY FOR RELOAD
*  R7 IS USED LATER AT LABEL NUMB.  MAKE SURE IT'S RELOADED FROM
*   STORAGE PLACE SAVER07 AFTER ALL BRANCHES FROM THE NUMB ROUTINE.
         B     PDSLINK             NOW GO LINK SAVE AREAS
         SPACE
PDSPGM   DC    CL8'COMPAREB'       PROGRAM NAME
         DC    CL1' '
PDSDATE  DC    CL8'&SYSDATE'       SYSTEM DATE OF ASSEMBLY
         DC    CL1' '
PDSTIME  DC    CL5'&SYSTIME'       SYSTEM TIME OF ASSEMBLY
         DC    CL1' '
         SPACE 2
PDSSAVE  DC    9D'0'               SAVE AREA FOR COMPAREB
RETCODE  DC    F'0'                RETURN CODE
RETURN   L     R15,RETCODE         GET RETURN CODE
         L     R13,PDSSAVE+4       GET ADD OF THEIR SAVE AREA
         L     R14,12(,R13)        RESTORE RETURN ADDRESS
         LM    R0,R12,20(R13)      RESTORE R0 THRU R12
         BR    R14                 RETURN TO CALLER
         SPACE 2
PDSLINK  LA    R14,PDSSAVE         GET ADDR OF OUR SAVE AREA
         ST    R14,8(,R13)         SAVE OUR ADDR IN THEIR AREA
         ST    R13,4(,R14)         SAVE THEIR ADDR IN OUR AREA
         LR    R13,R14             POINT R13 TO OUR AREA NOW
         EJECT
* PARM
*        R1 - SCP POINTER TO PARM AT ENTRY
*        R2 - PARM LENGTH
*        R3 - POINTER TO PARM DATA WHILE EVALUATING
*        R4 - POINTER TO PARM VALUE SAVE AREAS
*        R5 - LOOP CONTROL AND SAVE AREA POINTER
*
*        BAL   R12,NUMB  - CONVERT VALUE TO BINARY
*        B     GETM
***********************************************************************
         ST    R1,ORIGPARM          SAVE INPUT PARMS                BFG
         L     R1,0(,R1)           POINT TO PARM AREA
         LH    R2,0(,R1)           GET LENGTH IN R2
         STM   R1,R2,PARMVALS      SAVE ADDR AND LEN
         LTR   R2,R2               IS THERE A PARM FROM USER?
         BZ    PARMEND             NO  -- TAKE DEFAULTS
         SPACE
         LA    R3,1(,R1)           IN LOOP R3 POINTS TO DATA
         LA    R2,1(,R2)           ADJUST LEN FOR 1ST PASS
PARM2    EQU   *                   EVALUATE NEXT KEYWORD
         L     R7,SAVER07          MAKE SURE BASE IS LOADED
         LTR   R2,R2               IS THERE SOME LENGTH LEFT?
         BNP   PARMEND             NO  -- EVALUATION COMPLETE
         LA    R3,1(,R3)           POINT TO START OF KEYWORD
         BCT   R2,PARM2B           REDUCE LEN - BRANCH AT END
         B     PARMEND
PARM2B   EQU   *                   DETERMINE WHICH KEYWORD NOW
         L     R7,SAVER07          MAKE SURE BASE IS LOADED
         CLC   =C'TYPE=',0(R3)     LIBRARY TYPE SPECIFICATION?    PAN
         BE    PARM5                                              PAN
         CLC   =C'PRINT=',0(R3)    RANGE SPECIFICATION?
         BE    PARM6               YES
         CLC   =C'SIZE=',0(R3)     SIZE OF PDS?
         BE    PARM8
         SPACE
PARM2D   EQU   *                   INVALID PARAMETER
         L     R7,SAVER07          MAKE SURE BASE IS LOADED
         WTO   'INVALID PARM VALUE SPECIFIED -- PROCESSING TERMINATED',X
               ROUTCDE=(11)                                         GP
         MVC   RETCODE,=F'16'      SET RETURN CODE TO 16
         B     RETURN              RETURN TO SCP
         SPACE
PARM5    EQU   *                   LIBRARY TYPE ANALYSIS
         LA    R3,5(,R3)           POINT PAST KEYWORD
         SH    R2,=H'5'            KEEP REMAINING LEN ACCURATE
         MVC   PARMTYPE,=F'0'      INITIALIZE SAVE AREA
         LA    R4,PARMTYPE         POINT TO SAVE AREA
         BAL   R12,PARM10          GO GET USER VAUE
         CLC   =C'FULL',PARMTYPE   DID USER SPECIFY FULL COMPARE?   GP
         BNE   PARM5A              NO  -- CHECK FOR ASSEMBLER
         MVI   MLENGTH+1,0         YES, CHANGE 8 TO ZERO
         B     PARM2               NO FURTHER EVALUATION
PARM5A   CLC   =C'ASM',PARMTYPE    DID USER SPECIFY ASSEMBLER??  GP BFG
         BNE   PARM2               NO SO IGNORE                     BFG
         LA    R0,ENDDFTIG     GP  YES, POINT TO END OF DEFAULT DATABFG
         ST    R0,IGASMS+4     GP  STORE ENDING ADDRESS             BFG
         B     PARM2                KEEP LOOKING                    BFG
         SPACE 2                                                    BFG
PARM6    EQU   *                   RANGE PROCESSING
         LA    R3,6(,R3)           POINT PAST KEYWORD
         SH    R2,=H'6'            KEEP LEN CORRECT
         LA    R4,PARMPRNT         POINT TO FIRST SAVE AREA
         BAL   R12,PARM10          GO GET USER VALUE
         CLC   PARMPRNT(3),=C'MEM' DID USER SAY TO PRINT ENTIRE MEMBER?
         BE    PARM6H              YES
         CLC   PARMPRNT(3),=C'DIR' DID USER SAY TO PRINT DIRECTRY ONLY?
         BE    PARM6H              YES
         MVC   PARMPRNT,=C'NAME'   NO -- SET TO NAME ONLY
PARM6H   EQU   *                   EVALUATE
         B     PARM2               GO GET NEXT KEYWORD
         SPACE 2
PARM8    EQU   *                   SIZE SPECIFICATION
         LA    R3,5(,R3)           POINT TO VALUE
         SH    R2,=H'5'            CORRECT REMAINING LEN
         MVC   PARMSIZE,=F'0'      INITIALIZE SAVE AREA
         LA    R4,PARMSIZE         POINT TO SAVE AREA
         BAL   R12,PARM10          GO GET USER VALUE
PARM8D   EQU   *                   EVALUALTE
         LA    R5,PARMSIZE+3       POINT TO END OF SAVE AREA
         BAL   R12,NUMB            CONVERT VAUE TO BINARY
         CLC   PARMSIZE,=F'100'    LESS THAN 100 MEMBERS?
         BH    PARM8F              NO  -- OK
         MVC   PARMSIZE,=F'100'    PUT IN MINIMUM VALUE
PARM8F   EQU   *
         B     PARM2               AND RETURN
         SPACE 2
PARM10   EQU   *                   ISSOLATE VALUE SUPPLIED BY USER
         LA    R5,5                MAX OF FOUR CHAR + DLM ALLOWED
PARM10B  EQU   *                   MOVE VALUE TO SAVE AREA
         CLC   0(1,R3),PARMDLM     DELIMITING VALUE?
         BE    0(,R12)             YES -- WE NOW HAVE THE VALUE
         MVC   0(1,R4),0(R3)       MOVE ONE CHAR FROM PARM TO SAVE ARE
         LA    R4,1(,R4)           BUMP POINTER TO SAVE AREA
         LA    R3,1(,R3)           UPDATE PARM DATA POINTER
         BCT   R2,PARM10D          REDUCE REMAINING LEN
         BR    R12                 RETURN TO CALLER IF EXHAUSTED
PARM10D  EQU   *
         BCT   R5,PARM10B          LOOP TIL VALUE IS DONE
         B     PARM2D              MORE THAN FOUR CHARS IN VALUE
         SPACE 2
PARMEND  EQU   *                                                  PAN
         SPACE
*                                                                   BFG
**       HANDLE DDNAMES PASSED AS INPUT                             BFG
*                                                                   BFG
         L     R1,ORIGPARM          SAVE INPUT PARMS                BFG
         TM    0(R1),X'80'         ONLY 1 PARAMETER
         BO    NODD                YES, BYPASS DD ROUTINE
         L     R2,4(,R1)           POINT TO DDNAME LIST
         LH    R1,0(,R2)           GET LENGTH OF DDNAME LIST
         LA    R2,2(,R2)           POINT PAST LENGTH
         SPACE
         CH    R1,=H'40'           LONG ENOUGH FOR SYSIN
         BL    NODD                NO, BRANCH
         CLI   32(R2),0            SYSIN OVERRIDE
         BE    NWDD1               NO, SKIP MVC
         MVC   IGNORE+DDNAM(8),32(R2)
         SPACE
NWDD1    CH    R1,=H'48'           LONG ENOUGH FOR SYSPRINT
         BL    NODD                NO, BRANCH
         CLI   40(R2),0            SYSPRINT OVERRIDE
         BE    NWDD2               NO, SKIP MVC
         MVC   SYSPRINT+DDNAM(8),40(R2)
         SPACE
NWDD2    DS    0H                                                   GLA
         CH    R1,=H'56'           LONG ENOUGH FOR ECHO         ABL GLA
         BL    NODD                NO, BRANCH                   ABL GLA
         CLI   48(R2),0            REENTRY OVERRIDE             ABL GLA
         BE    NWDD2A              NO, SKIP MVC                 ABL GLA
         MVC   PVECTOR(4),48(R2)   YES, SAVE THE REENTRY VECTOR ABL GLA
         SPACE
NWDD2A   CH    R1,=H'64'           LONG ENOUGH FOR SYSUT1
         BL    NODD                NO, BRANCH
         CLI   56(R2),0            SYSUT1 OVERRIDE
         BE    NWDD3               NO, SKIP MVC
         MVC   OLDDCB+DDNAM(8),56(R2)
         MVC   OLDDIR+DDNAM(8),56(R2)
         SPACE
NWDD3    CH    R1,=H'72'           LONG ENOUGH FOR SYSUT2
         BL    NODD                NO, BRANCH
         CLI   64(R2),0            SYSUT2 OVERRIDE
         BE    NODD                NO, SKIP MVC
         MVC   NEWDCB+DDNAM(8),64(R2)
         MVC   NEWDIR+DDNAM(8),64(R2)
NODD     EQU   *
         B     GETM                GET STORAGE FOR WORK AREAS AND TBLS
         EJECT
NUMB     EQU   *                   CONVERT PARM VALUE TO BINARY
         ST    R7,SAVER07          SAVE 3RD BASE REG VALUE
* NUMB
*        R5 - PARM SAVE AREA POINTER AT ENTRY
*        R9 - LOOP CONTROL
*        R7    WORK AREA POINTER    (THIRD BASE - SAVE OFF)
*        R8 - PARM VALUE SAVE ARA POINTER
*
*        RETURN WITH BR R12
***********************************************************************
         SPACE 2
         LR    R8,R5               SAVE POINTER TO END OF SAVE ARA
         SH    R8,=H'3'            POINT TO START OF SAVE AREA
         LA    R7,FULL+3           POINT TO END OF WORK AREA
         LA    R9,4                MAX NUMBER OF TIMES THRU LOOP
         MVC   FULL,=C'0000'       INITIALIZE WORK AREAA
NUMB2    EQU   *                   MOVE DATA TO WORK AREA(RIGHT JUSTIFY
         CLI   0(R5),X'00'         DATA CHAR?
         BE    NUMB2D              NO  -- SKIP TO NEXT COL
         CLI   0(R5),C'0'          LESS THAN ZERO?
         BL    PARM2D              YES -- ERROR
         CLI   0(R5),C'9'          GREATERTHAN NINE
         BH    PARM2D              YES -- ERROR
         MVC   0(1,R7),0(R5)       MOVE ONE DATA CHAR
         BCTR  R7,0                BACKUP WORK AREA POINTER
NUMB2D   EQU   *
         BCTR  R5,0                BACKUP SAVE AREA POINTER
         BCT   R9,NUMB2            CHECK FOUR COLS
         SPACE
         PACK  DOUBLE,FULL         CONVERT FROM CHAR TO DECIMAL
         CVB   R7,DOUBLE           CONVERT DECIMAL TO BINARY
         ST    R7,0(,R8)           SAVE BINARY VALUE
         L     R7,SAVER07          RELOAD 3RD BASE REG VALUE
         BR    R12                 RETURN TO CALLER
         EJECT
GETM     EQU   *                   OBTAIN STORAGE
* 1 12 BYTE ENTRY NEEDED FOR EACH NEW MEMBER
*           (8 BYTE MEMBER NAME, 2 BYTE PAGE NUMBER, 2 BYTE FLAGS)
*
* 1 12 BYTE ENTRY NEEDED FOR EACH OLD MEMBER
*           (SAME AS NEW ENTRY)
*
*
* GETM
*        R2 - PARMSIZE VALUE (ESTIMATED NUMBER OF MEMS)
*        R3 - GOTTEN STORAGE POINTER
*
*        B     NDIR
***********************************************************************
         SPACE 2
         L     R2,PARMSIZE         GET BINARY NUMBER OF MEMBERS
GETM2    EQU   *                   GET STORAGE FOR NEW OLD AND SEQ
         MH    R2,=H'24'           12 BYTES FOR NEW - 12 BYTES FOR OLD
GETM2D   EQU   *                   REQUEST STORAGE
         GETMAIN EC,LV=(R2),A=NMEM
         LTR   R15,R15             WAS STORAGE AVAILABLE?
         BZ    GETM4               YES -- CONTINUE
         WTO   'GETMAIN FAILURE -- RUN IN LARGER REGION',              X
               ROUTCDE=(11)                                         GP
         MVC   RETCODE,=F'16'      SET RETURN CODE TO U6
         B     RETURN              RETURN TO SCP
         SPACE 3
GETM4    EQU   *                   DIVIDE STORAGE UP
         L     R3,PARMSIZE         NUMBER OF ESTIMATED MEMBERS
         MH    R3,=H'12'           12 BYTES PER MEMBER IN EACH LIST
         L     R4,NMEM             ADDRESS OF OBTAINED STORAGE
         AR    R4,R3               END OF FIRST LIST
         ST    R4,OMEM             START ADDR OF OLD MEMBER LIST
         EJECT
         TIME  DEC                 PUT TIMESTAMP IN PAGE HEADER     GP*
         SRL   R0,8                SHIFT OUT FRACTIONS OF SECOND      *
         STM   R0,R1,DOUBLE        STORE TIME AND DATE                *
         AP    DOUBLE,=PL4'1900000' GET 4 DIGIT YEAR - OK FOR MILLENIA*
         MVC   EJECT+60(19),=X'4021207A20207A20204040202020204B202020'
         ED    EJECT+60(19),DOUBLE+1  FORMAT 'HH:MM:SS  YYYY.DDD'   GP*
******************************************************************
*        THIS CODE HAS BEEN MOVED FROM THE YALE COMP PGM         *
******************************************************************
         OPEN  (SYSPRINT,OUTPUT)
         GETMAIN VU,LA=MIN,A=STARTADD    GET ALL AVAILABLE STORAGE
         LM    R0,R2,SIXTEENK      LOAD 16K, START, SIZE            ABL
*        SR    R2,R0               SUBTRACT OFF 4K              ABL GLA
         ST    R2,SIZE             UPDATE REGION SIZE
         AR    R1,R2               LAST USEABLE BYTE
         ST    R1,HIGHCORE         SAVE FOR LATER
         SPACE
*                                                                   BFG
**       MOVED CODE FROM BG COMPARE TO HERE TO ELIMINATE MESSAGE    BFG
*                                                                   BFG
         SPACE 1                                                    BFG
         LA    R2,IGNORE+DDNAM                                      BFG
         DEVTYPE (R2),DEVAREA                                       BFG
         LTR   R15,R15             IS IGNORE DD PRESENT             BFG
         BNZ   IGNAB               NO, SKIP OPEN                    BFG
         OPEN  (IGNORE)                                             BFG
IGNAB    EQU   *                                                    BFG
         L     R2,STARTADD         STARTADD
         ST    R2,FIRSTIG          SAVE AS FIRST IGNORE ADDR
         TM    IGNORE+48,X'10'     DID IGNORE OPEN?
         BO    GETIG               YES -- GO READ AND STORE
         MVC   FIRSTIG(8),IGASMS   NO  -- FIRST AND LAST IGNORES
         ST    R2,BSTRTA           SAVE ADDRESS AFTER IGNORES       BFG
         B     NDIR
GETIG    GET   IGNORE,(R2)         GET A RECORD
         LA    R2,80(,R2)          BUMP PONITER
         B     GETIG               READ TIL END OF FILE
ENDIG    CLOSE (IGNORE)            CLOSE THE DCB
         FREEPOOL IGNORE                                            ABL
         ST    R2,LASTIG           SAVE ADDR OF LAST IGNORE REC
         ST    R2,BSTRTA           SAVE ADDRESS AFTER IGNORES       BFG
         SPACE 3
         B     NDIR                GO PROCESS NEW DIRECTORY
         EJECT
NDIR     EQU   *                   OPEN AND PROCEES NEW DIRECTORY
*
* NDIR
*        R1 - WORK REG
*        R2 - LOOP CONTROL (MAX NUMBER OF MEMS)
*        R3 - POINTER TO NEW DIRECTORY LIST
*        R4 - DIRECTORY RECORD POINTER IN WORK AREA
*
*        BAL   R12,JSORT    SORT ENTRIES IN DESIRED SEQUENCE
*        B     ODIR
***********************************************************************
         RDJFCB (NEWDCB)
         MVC   NEWDSN,NEWJFCB
         MVC   NEWVOL,NEWJFCB+118
         RDJFCB (OLDDCB)
         MVC   OLDDSN,OLDJFCB
         MVC   OLDVOL,OLDJFCB+118
         SPACE 2
         RDJFCB (NEWDIR,,OLDDIR)   GET JFCB DATA FROM DD STATEMENT
         OI    NJFCB+52,X'0A'      TURN ON DON'T MERGE DCB TO JFCB BIT
         OI    OJFCB+52,X'0A'      TURN ON DON'T MERGE DCB TO JFCB BIT
         L     R14,OBTAIN          OBTAIN FLAGS                     ABL
         LA    R15,NJFCB           ADDRESS OF DSNAME                ABL
         LA    R0,NJFCB+118        VOLUME SERIAL                    ABL
         LA    R1,DS1FMTID         OUTPUT START ADDRESS             ABL
         STM   R14,R1,PARMLIST     SAVE CAMLIST PARAMETERS          ABL
         OBTAIN PARMLIST           GET THE FORMAT 1 DSCB            ABL
         MVC   NEWDSORG,DS1DSORG   SAVE THE NEW DSORG               ABL
         L     R14,OBTAIN          OBTAIN FLAGS                     ABL
         LA    R15,OJFCB           ADDRESS OF DSNAME                ABL
         LA    R0,OJFCB+118        VOLUME SERIAL                    ABL
         LA    R1,DS1FMTID         OUTPUT START ADDRESS             ABL
         STM   R14,R1,PARMLIST     SAVE CAMLIST PARAMETERS          ABL
         OBTAIN PARMLIST           GET THE FORMAT 1 DSCB            ABL
         MVC   OLDDSORG,DS1DSORG   SAVE THE NEW DSORG               ABL
         CLC   NJFCB+44(8),BLANK    Q. ANY MEMBER SPECIFIED         BFG
         BNE   NEWSEQ               A. YES SO MUST BE SEQ DS        BFG
         CLC   OJFCB+44(8),BLANK    Q. ANY MEMBER SPECIFIED         BFG
         BNE   OLDSEQ               A. YES SO MUST BE SEQ DS        BFG
         TM    NEWDSORG,DS1DSGPS    Q. IS THIS SEQ DS           ABL/BFG
         BO    NEWSEQ               A. YES SO HANDLE AS SEQ DS      BFG
         TM    OLDDSORG,DS1DSGPS    Q. IS THIS SEQ DS           ABL/BFG
         BO    NEWSEQ2              A. YES SO MUST BE AN ERROR  ABL/BFG
         MVC   NJFCB+44(8),BLANK   SET MEMBER NAME TO BLANKS
         MVC   OJFCB+44(8),BLANK   SET MEMBER NAME TO BLANKS
         OPEN  (NEWDIR,INPUT,OLDDIR,INPUT),TYPE=J
         SPACE 2
         L     R2,PARMSIZE         ESTIMATED MEMBER COUNT
         L     R3,NMEM             POINT TO START OF LIST
NDIR2    EQU   *                   READ A DIRECTORY BLOCK
         READ  NDIR2ECB,SF,NEWDIR,DIRWORK
         CHECK NDIR2ECB            WAIT TIL READ COMPLETES
         LA    R4,DIRWORK+10       POINT PAST KEY TO FIRST DATA
NDIR2B   EQU   *                   PROCESS DIRECTORY LBOCK
         CLC   0(8,R4),=8X'FF'     LOGICAL END OF DATA?
         BE    NEWDEOD             YES -- TREAT AS PHYSICAL EOD
         MVC   0(08,R3),0(R4)      MEMBER NAME
         MVC   8(4,R3),=4X'0000FFFF' PAGE NUM. AND FLAGS
NDIR2D   EQU   *
         CLC   DIRWORK(8),0(R4)    AT END OF BLOCK?
         BNE   NDIR2F              NO  -- UPDATE POINTERS AND CONT.
         LA    R3,12(,R3)          YES -- POINT TO NEXT NEW MEMBER ENT
         BCT   R2,NDIR2                   READ NEXT BLOCK
         B     NDIR2H                     LIST EXCEEDED
         SPACE
NDIR2F   EQU   *
         SR    R1,R1               CLEAR WORK REG
         IC    R1,11(R4)           GET TYPE BYTE FROM DIRECTRY
         N     R1,=X'0000001F'     COUNT OF USER HALF WORDS
         MH    R1,=H'2'            NOW COUNT OF USER BYTES
         LA    R4,12(R1,R4)        POINT TO LNEXT ENTRY IN BLOCK
         LA    R3,12(,R3)          NEXT NEW MEMBER ENTRY
         BCT   R2,NDIR2B           PROCESS NEXT ENTRY IN BLOCK
NDIR2H   EQU   *                   TOO MANY MEMBERS
         WTO   'TOO MANY MEMBERS IN PDS -- PARM=''SIZE=XXX'' NEEDED',  X
               ROUTCDE=11                                           GP
         MVC   RETCODE,=F'16'      SET RETURN CODE
         B     RETURN              RETURN TO SCP
         SPACE 3
NEWDEOD  EQU   *
         MVC   0(8,R3),=X'FF'      SET LOGICAL END OF LIST
         CLOSE (NEWDIR)            CLOSE THE DIRECTORY DCB
         B     ODIR                PROCESS OLD DIRECTORY
         EJECT                                                      BFG
*                                                                   BFG
**       HANDLE PURELY SEQUENTIAL DATASETS AS INPUT                 BFG
*                                                                   BFG
NEWSEQ   CLC   OJFCB+44(8),BLANK    Q. ANY MEMBER SPECIFIED         BFG
         BNE   OLDSEQ               A. YES SO MUST BE SEQ DS        BFG
         TM    OLDDSORG,DS1DSGPS    Q. IS THIS SEQ DS           ABL/BFG
         BO    OLDSEQ               A. YES SO HANDLE AS SEQ DS      BFG
NEWSEQ2  MVC   RETCODE,=F'16'                                   ABL BFG
         WTO   'BOTH FILES ARE NEITHER BOTH DSORG=PO OR DSORG=PS',  BFGX
               ROUTCDE=(11)                                         BFG
         B     CLOSE2               GO AND CLOSE SYSPRINT       ABL BFG
         SPACE 2                                                    BFG
*                                                                   BFG
**       BOTH DATASETS ARE SEQUENTIAL, SO CALL COMPARE AND EXIT     BFG
*                                                                   BFG
OLDSEQ   DS    0H                                                   BFG
         OPEN  (OLDDCB,,NEWDCB)                                     BFG
         MVC   OLDMEM,OJFCB+44      SET MEMBER NAME IF ANY          BFG
         MVC   NEWMEM,NJFCB+44      SET MEMBER NAME IF ANY          BFG
         SR    R3,R3                SHOW NO NEED TO SAVE PAGE NUM.  BFG
         BAL   R12,PAGE             OUTPUT PAGE                     BFG
         BAL   R12,YALECOMP         DO COMPARE                      BFG
         B     CLOSE2                                           ABL BFG
         EJECT
ODIR     EQU   *                   PROCESS OLD DIRECTORY
*
* ODIR
*        R1 - WORK REG
*        R2 - LOOP CONTROL (MAX NUMBER OF MEMS)
*        R3 - POINTER TO OLD DIRECTORYL IST
*        R4 - DIRECTORY RECORD POINTER IN WORK AREA
*
*        B     OPEN1
***********************************************************************
         SPACE 2
         L     R2,PARMSIZE         NUMBER OF ESTIMATED MEMBERS
         L     R3,OMEM             POINT TO OLD MEMER LIST
ODIR2    EQU   *                   READ A DIRECTORY BLOCK
         READ ODIR2ECB,SF,OLDDIR,DIRWORK
         CHECK ODIR2ECB            WAIT TILL READ COMPLETES
         LA    R4,DIRWORK+10       POINT PAST KEY TO FIRST DATA
ODIR2B   EQU   *
         CLC   0(8,R4),=8X'FF'     LOGOCAL END OF DATA?
         BE    OLDDEOD             YES -- SAME AS PYSICAL EOD
         MVC   0(08,R3),0(R4)      MEMBER NAME
         MVC   8(4,R3),=4X'0000FFFF' PAGE NUMBER AND FLAGS
ODIR2D   EQU   *
         CLC   DIRWORK(8),0(R4)    AT END OF BLOCK?
         BNE   ODIR2F              NO
         LA    R3,12(,R3)          YES -- POINT TO NEXT OLD ENTRY
         BCT   R2,ODIR2                   READ NEXT BLOCK
         B     ODIR2H                     ESTIMATED MEMBERS EXCEEDED
         SPACE 3
ODIR2F   EQU   *
         SR    R1,R1               CLEAR WORK REG
         IC    R1,11(,R4)          GET TYPE BYTE
         N     R1,=X'0000001F'     ISOLATE USER HALF WORDS
         MH    R1,=H'2'            NOW USER BYTES
         LA    R4,12(R1,R4)        POINT TO NEXT DIRECTRY ENTRY
         LA    R3,12(,R3)          POINT TO NEXT OLD MEMBER ENTRY
         BCT   R2,ODIR2B           PROCESS NEXT ENTRY
ODIR2H   EQU   *
         B     NDIR2H
         SPACE 3
OLDDEOD  EQU   *                   END OF DATA FOR DIRECTORY
         MVC   0(8,R3),=X'FF'      LOGICAL END OF DATA
         CLOSE (OLDDIR)            CLOSE DIRECTORY
         B     LOOP
         EJECT
LOOP     EQU   *                   LOOP THRU DIRECTORIES
         L     R2,NMEM             R2 POINTS TO NEXT MEMBER IN NEW PDS
         L     R3,OMEM             R3 POINTS TO NEXT MEMBER IN OLD PDS
LOOP1    EQU   *                   COMPARE NEW TO OLD
         LH    R1,RC               RETURN CODE                      ABL
         O     R1,RETCODE          BUILD FOR FINAL RETURN CODE      ABL
         ST    R1,RETCODE          SAVE FOR FINAL RETURN CODE       ABL
         CH    R1,=H'12'           ATTENTION TO TERMINATE?          ABL
         BE    CLOSE2              YES, QUIT                        ABL
         CLC   0(8,R2),0(R3)
         BE    COMPARE             SAME MEMBER NAME IN OLD AND NEW
         BL    NEWONLY             MEMBER IS ONLY IN NEW PDS
         BH    OLDONLY             MEMBER IS ONLY IN OLD PDS
         EJECT
COMPARE  EQU   *                   COMPARE OLD AND NEW MEMBERS
         CLI   0(R2),X'FF'         EQUAL AND X'FF'?
         BE    DIR                 YES -- TIME TO PRINT DIRECTORY
         MVC   OLDJFCB+44(8),0(R3) MOVE IN OLD MEMBER NAME
         MVC   NEWJFCB+44(8),0(R2) MOVE IN NEW MEMBER NAME
         MVC   OLDMEM,0(R3)
         MVC   NEWMEM,0(R3)
         OI    OLDJFCB+52,X'08'    DONT REWRITE JFCB
         OI    NEWJFCB+52,X'08'    DONT REWRITE JFCB
         OI    OLDJFCB+86,X'01'    DATA SET IS MEMBER OF PDS
         OI    NEWJFCB+86,X'01'    DATA SET IS MEMBER OF PDS
         CLC   PARMPRNT(3),=C'DIR' DIRECTORY ONLY?
         BE    COMPARE2
         OPEN  (OLDDCB,,NEWDCB),TYPE=J   ADD MEMBER NAMES TO JFCB
         MVI   DELAY,C'D'          DELAY THE HEADER INFORMATION     ABL
         BAL   R12,PAGE            TOP OF FORM
         BAL   R12,YALECOMP        GO DO THE COMPARISON
         MVC   10(2,R2),RC         SAVE RETURN CODE
         MVC   10(2,R3),RC         SAVE RETURN CODE
         CLI   DELAY,C'D'          HEADER OUTPUT?                   ABL
         BNE   COMPARE2            YES, BRANCH                      ABL
         MVI   DELAY,C'1'          RESET THE HEADER FLAG            ABL
         XC    8(2,R2),8(R2)       CLEAR PAGE NUMBER                ABL
         XC    8(2,R3),8(R3)       CLEAR PAGE NUMBER                ABL
         LH    R1,PAGECNT          PAGE NUMBER                      ABL
         SH    R1,=H'1'            PAGE NUMBER                      ABL
         STH   R1,PAGECNT          PAGE NUMBER                      ABL
COMPARE2 EQU   *
*        CLOSE (OLDDCB,,NEWDCB)    CLOSE IS DONE BY YALE COMP
         LA    R2,12(,R2)          POINT TO NEXT NEW MEMBER NAME
         LA    R3,12(,R3)          POINT TO NEXT OLD MEMBER NAME
         B     LOOP1               NOW GO CHECK CURRENT STATUS
         SPACE 3
NEWONLY  EQU   *                   COMPARE OLD AND NEW MEMBERS
         MVC   NEWJFCB+44(8),0(R2) MOVE IN NEW MEMBER NAME
         MVC   NEWMEM,0(R2)
         OI    NEWJFCB+52,X'08'    DONT REWRITE JFCB
         OI    NEWJFCB+86,X'01'    DATA SET IS A MEMBER OF PDS
         MVC   OLDMEM,=8C'*'       INDICATE NO MEMBER IN OLD PDS
         CLC   PARMPRNT(3),=C'MEM' DOES USER WANT MEMBERS?
         BNE   NEWONLY2            NO  -- SKIP YALECOMP
         OPEN  (NEWDCB),TYPE=J     ADD MEMBER NAMES TO JFCB
         BAL   R12,PAGE            TOP OF FORM
         BAL   R12,YALECOMP        YES -- COMPARE WILL LIST NEW
         MVC   10(2,R2),=X'0005'          NO MATCHING MEMBER
NEWONLY2 EQU   *
*        CLOSE (OLDDCB,,NEWDCB)    CLOSE IS DONE BY YALE COMP
         LA    R2,12(,R2)          POINT TO NEXT NEW MEMBER NAME
         B     LOOP1               NOW GO CHECK CURRENT STATUS
         SPACE 3
OLDONLY  EQU   *                   COMPARE OLD AND NEW MEMBERS
         MVC   OLDJFCB+44(8),0(R3) MOVE IN OLD MEMBER NAME
         MVC   OLDMEM,0(R3)
         OI    OLDJFCB+52,X'08'    DONT REWRITE JFCB
         OI    OLDJFCB+86,X'01'    DATA SET IS MEMBER OF PDS
         MVC   NEWMEM,=8C'*'       INDICATE NO MEMBER IN NEW PDS
         CLC   PARMPRNT(3),=C'MEM' DOES USER WANT MEMBERS?
         BNE   OLDONLY2            NO  -- SKIP YALECOMP
         OPEN  (OLDDCB),TYPE=J     ADD MEMBER NAMES TO JFCB
         BAL   R12,PAGE            TOP OF FORM
         BAL   R12,YALECOMP        YES -- COMPARE WILL LIST OLD
         MVC   10(2,R3),=X'0005'
OLDONLY2 EQU   *
*        CLOSE (OLDDCB,,NEWDCB)    CLOSE IS DONE BY YALE COMP
         LA    R3,12(,R3)          POINT TO NEXT OLD MEMBER NAME
         B     LOOP1               NOW GO CHECK CURRENT STATUS
         EJECT
PAGE     EQU   *                   TOP OF FORM ROUTINE
         LH    R1,PAGECNT          GET OLD PAGE COUNT
         LA    R1,1(,R1)           ADD ONE
         STH   R1,PAGECNT          SAVE FOR NEXT TIME
         LTR   R3,R3                Q. ARE WE PLAYING WITH MEM LIST BFG
         BZ    PAGE4                A. NO                           BFG
         CLC   OLDMEM,=8C'*'       IS THERE AN OLD MEMBER NAME
         BE    PAGE2               NO  -- DON'T TRY TO SAVE PAGE NO.
         STH   R1,8(,R3)           YES -- SAVE PAGE NUMBER
PAGE2    EQU   *
         CLC   NEWMEM,=8C'*'       IS THERE A NEW MEMBER NAME
         BE    PAGE4               NO  -- DON'T TRY TO SAVE PAGE NO.
         STH   R1,8(,R2)           YES -- SAVE PAGE NUMBER
PAGE4    EQU   *
         CVD   R1,DOUBLE           CONVERT PAGE NUMBER TO PACKED
         UNPK  PAGENO,DOUBLE       NOW CHARACTER
         OI    PAGENO+3,C'0'       NOW FIX SIGN
         CLI   DELAY,C'D'          DELAYED HEADER?                  ABL
         BER   R12                 YES, DO IT LATER (IF AT ALL)     ABL
         MVI   DELAY,C'1'          ENSURE VALID PAGE EJECT          ABL
         LA    R1,EJECT                                             GLA
         BAL   R14,PUTOUT          GO TO TOP OF FORM AND PRINT  ABL GLA
         LA    R1,OLDHDG           PRINT OLD PDS DSN AND MEMBER NAMEGLA
         BAL   R14,PUTOUT          PRINT OLD PDS DSN AND MEMBER ABL GLA
         LA    R1,NEWHDG           PRINT NEW PDS DSN AND MEMBER NAMEGLA
         BAL   R14,PUTOUT          PRINT NEW PDS DSN AND MEMBER ABL GLA
         BR    R12                 RETURN TO CALLER
         EJECT
DIR      EQU   *                   PRINT DIRECTORY
         MVC   OLDMEM,=CL8'* OLD *'
         MVC   NEWMEM,=CL8'* NEW *'
         BAL   R12,PAGE
         SPACE 3
         L     R2,NMEM             LIST OF NEW MEMBERS
         L     R3,OMEM             LIST OF OLD MEMBERS
DIR2     EQU   *
         CLC   0(8,R2),0(R3)       OLD AND NEW MATCH?
         BE    DIRE                MEMBER IN EACH
         BL    DIRN                ONLY NEW MEMBER
         BH    DIRO                ONLY OLD MEMBER
         SPACE  2
DIRE     EQU   *                   MEMBER IN EACH
         CLI   0(R2),X'FF'         BOTH EQUAL AND X'FF'
         BE    CLOSE               YES -- DIRECTORY IS DONE
         MVC   DIRLOLD,0(R3)       OLD MEMBER NAME
         MVC   DIRLNEW,0(R2)       NEW MEMBER NAME
         LH    R4,8(,R2)           PAGE NUMBER
         CVD   R4,DOUBLE           CONVERT TO PACKED
         UNPK  DIRLPGE,DOUBLE      NOW CHARACTER
         OI    DIRLPGE+3,C'0'      NOW FIX SIGN
         MVC   DIRLEQ,BLANK
         MVC   DIRLNEQ,BLANK
         MVC   DIRLMTCH,BLANK
         CLI   11(R2),X'00'        EQUAL MATCH
         BNE   DIRE2               NO
         MVC   DIRLEQ,=CL8'EQUAL'
         B     DIRE12              IGNORE LINES WITH EQUALS         ABL
***      B     DIRE10
DIRE2    EQU   *
         CLI   11(R2),X'04'        NOT EQUAL
         BNE   DIRE4               NO
         MVC   DIRLNEQ,=CL9'NOT EQUAL'
         B     DIRE10
DIRE4    EQU   *
         CLI   11(R2),X'05'        NO MATCH
         BNE   DIRE10
         MVC   DIRLMTCH,=CL8'NO MATCH'
DIRE10   EQU   *
         LA    R1,DIRLINE                                           GLA
         BAL   R14,PUTOUT          PRINT THE LINE               ABL GLA
DIRE12   DS    0H                                                   ABL
         MVI   DIRLCC,C' '
         LA    R2,12(,R2)          NEXT NEW MEMBER
         LA    R3,12(,R3)          NEXT OLD MEMBER
         B     DIR2                LOOP TILL DONE
         EJECT
DIRN     EQU   *                   MEMBER IN EACH
         MVC   DIRLOLD,BLANK       OLD MEMBER NAME
         MVC   DIRLNEW,0(R2)       NEW MEMBER NAME
         LH    R4,8(,R2)           PAGE NUMBER
         CVD   R4,DOUBLE           CONVERT TO PACKED
         UNPK  DIRLPGE,DOUBLE      NOW CHARACTER
         OI    DIRLPGE+3,C'0'      NOW FIX SIGN
         MVC   DIRLEQ,BLANK
         MVC   DIRLNEQ,BLANK
         MVC   DIRLMTCH,=CL8'NO MATCH'
DIRN10   EQU   *
         LA    R1,DIRLINE                                           GLA
         BAL   R14,PUTOUT          PRINT THE LINE               ABL GLA
         MVI   DIRLCC,C' '
         LA    R2,12(,R2)          NEXT NEW MEMBER
         B     DIR2                LOOP TILL DONE
         SPACE 3
DIRO     EQU   *                   MEMBER IN EACH
         MVC   DIRLOLD,0(R3)       OLD MEMBER NAME
         MVC   DIRLNEW,BLANK       NEW MEMBER NAME
         LH    R4,8(,R3)           PAGE NUMBER
         CVD   R4,DOUBLE           CONVERT TO PACKED
         UNPK  DIRLPGE,DOUBLE      NOW CHARACTER
         OI    DIRLPGE+3,C'0'      NOW FIX SIGN
         MVC   DIRLEQ,BLANK
         MVC   DIRLNEQ,BLANK
         MVC   DIRLMTCH,=CL8'NO MATCH'
DIRO10   EQU   *
         LA    R1,DIRLINE                                           GLA
         BAL   R14,PUTOUT          PRINT THE LINE               ABL GLA
         MVI   DIRLCC,C' '
         LA    R3,12(,R3)          NEXT NEW MEMBER
         B     DIR2                LOOP TILL DONE
         SPACE 3
PUTOUT   ST    R14,R14SAVE                                      ABL GLA
         CLI   PVECTOR,C'*'               PDS REENTRY?          ABL GLA
         BE    PUTOUT2                    YES, BRANCH           ABL GLA
         LR    R0,R1               PUT ADDRESS IN RIGHT REGISTERABL GLA
         PUT   SYSPRINT,(0)                                     ABL GLA
         L     R14,R14SAVE                                      ABL GLA
         BR    R14                                              ABL GLA
PUTOUT2  DS    0H                         R1 IS ALREADY SETUP   ABL GLA
         L     R15,PVECTOR                REENTRY VECTOR ADDRESSABL GLA
         MVI   0(R1),132                  SET THE RETURN LENGTH ABL GLA
         BALR  R14,R15                    RETURN TO PDS         ABL GLA
         LTR   R15,R15                    SUCCESSFUL OUTPUT?    ABL GLA
         BNZ   CLOSE2                     NO - ATTENTION, BRANCHABL GLA
         L     R14,R14SAVE                                      ABL GLA
         BR    R14                                              ABL GLA
         SPACE 3
CLOSE    EQU   *
         ICM   R1,B'1111',RETCODE         RC=0?                     ABL
         BNE   CLOSE2                     YES, BRANCH               ABL
         LA    R1,ALLMEMBS                                          ABL
         BAL   R14,PUTOUT          PRINT THE LINE                   ABL
CLOSE2   DS    0H                                                   ABL
         CLOSE (SYSPRINT)
         L     R0,SIZE             SIZE OF AREA TO FREE             ABL
         L     R1,STARTADD         START OF AREA TO FREE            ABL
         FREEMAIN R,LV=(0),A=(1)   FREE THE DYNAMIC AREA            ABL
*
         L     R0,PARMSIZE         NUMBER OF MEMBERS                ABL
         MH    R0,=H'24'           12 BYTES OLD AND 12 BYTES NEW    ABL
         L     R1,NMEM             START OF AREA TO FREE            ABL
         FREEMAIN R,LV=(0),A=(1)   FREE THE MEMBER STORAGE          ABL
         B     RETURN
         EJECT
         LTORG
         SPACE 3
BLANK    DC    80C' '
FULL     DC    F'0'
DOUBLE   DC    D'0'
PAGECNT  DC    H'0'
ORIGPARM DC    F'0'                                                 BFG
         SPACE 3
         EJECT
PARMVALS DS    0F                  PARAM REALTED VALUES
PARMADDR DC    F'0'                ADDR OF USER PARM
PARMLEN  DC    F'0'                LEN OF USER PARM
PARMPRNT DC    F'0'                PRINT NAME ONLY OR ENTIRE MEMBER
*ARMSIZE DC    F'1000'             ESTIMATED NUMBER MEMBERS IN PDS
PARMSIZE DC    F'9999'             ESTIMATED NUMBER MEMBERS IN PDS
PARMTYPE DC    F'0000'             LIBRARY TYPE                   PAN
PARMDLM  DC    C','                PARM VALUE DELIMITOR
         SPACE 3
OLDDSORG DC    XL1'00'             OLD FILE DSORG                   ABL
NEWDSORG DC    XL1'00'             NEW FILE DSORG                   ABL
PARMLIST DC    4F'0'                                                ABL
OBTAIN   CAMLST SEARCH,0,0,0                                        ABL
         ORG   OBTAIN+4                                             ABL
         SPACE 3                                                    ABL
         DS    0F             ***   FORMAT 1 DSCB  ***              ABL
         ORG   *-44                                                 ABL
         IECSDSL1 (1)         FORMAT 1 DSCB                         ABL
         ORG   ,                                                    ABL
         DC    11F'0'                                               ABL
         EJECT
NMEM     DC    F'0'                ADDR OF NEW MEMBER LIST
NMEMS    EQU   NMEM
OMEM     DC    F'0'                ADDR OF OLD EMMBER LIST
OMEMS    EQU   OMEM
         PRINT NOGEN
OLDDAD1  EQU   *
OLDDIR   DCB   BLKSIZE=256,DEVD=DA,DSORG=PS,DDNAME=OLD,EXLST=OXLST,    X
               KEYLEN=8,LRECL=256,MACRF=(R),RECFM=F,EODAD=OLDDEOD
         SPACE 3
NEWDAD1  EQU   *
NEWDIR   DCB   BLKSIZE=256,DEVD=DA,DSORG=PS,DDNAME=NEW,EXLST=NXLST,    X
               KEYLEN=8,LRECL=256,MACRF=(R),RECFM=F,EODAD=NEWDEOD
         SPACE 3
OXLST    DS    0F
         DC    X'87'
         DC    AL3(OJFCB)
         SPACE
OJFCB    DC    CL176' '
         SPACE 3
NXLST    DS    0F
         DC    X'87'
         DC    AL3(NJFCB)
         SPACE
NJFCB    DC    CL176' '
         SPACE 3
OLDXLIST DS    0F
         DC    X'05'
         DC    AL3(DCBEXIT)
OLDXLST2 EQU   *
         DC    X'87'
         DC    AL3(OLDJFCB)
         SPACE
OLDJFCB  DC    CL176' '
         SPACE 3
NEWXLIST DS    0F
         DC    X'05'
         DC    AL3(DCBEXIT)
NEWXLST2 EQU   *
         DC    X'87'
         DC    AL3(NEWJFCB)
         SPACE
NEWJFCB  DC    CL176' '
         EJECT
DIRWORK  DS    CL264               WORK AREA FOR DIRECOTRY BLOCK READS
         SPACE
MEMBR    DC    CL8' ',C'  '        SAVE AREA FOR MEMBER NAMES
MEMBR1   DC    CL8' '              SAVE AREA FOR MEMBER NAMES
MEMBR2   DC    CL8' '              SAVE AREA FOR MEMBER NAMES
OLDBLKSZ DC    F'0'                BLOCKSIZE FOR OLD PDS
NEWBLKSZ DC    F'0'                BLOCKSIZE FOR NEW PDS
OLDBLKA  DC    F'0'                ADDR OF OLD PDS BUFFER FOR READS
NEWBLKA  DC    F'0'                ADDR OF NEW BUFFER FOR READS
NEWBLKE  DC    F'0'                END ADDR FOR NEW BUFFER
OLDBLKE  DC    F'0'                END OF BUFFER ADDR FOR OLD
         EJECT
EJECT    DC    CL133' '
         ORG   EJECT
DELAY    DC    C'D'               "D" IF DELAY FOR MISMATCH         ABL
         ORG   EJECT
         DC    C'1',C'PAGE  '
PAGENO   DC    CL4' '
         ORG   ,
         SPACE 2
NEWHDG   DC    CL133' '
         ORG   NEWHDG
         DC    C'-',C'VOL=SER='
NEWVOL   DC    CL6' ',C'  MEMBER='
NEWMEM   DC    CL8' ',C'  NEW DSN='
NEWDSN   DC    CL44' '
         ORG   ,
         SPACE 3
OLDHDG   DC    CL133' '
         ORG   OLDHDG
         DC    C'-',C'VOL=SER='
OLDVOL   DC    CL6' ',C'  MEMBER='
OLDMEM   DC    CL8' ',C'  OLD DSN='
OLDDSN   DC    CL44' '
         ORG   ,
         SPACE 3
ALLMEMBS DC    CL133'- ALL MEMBERS WERE IDENTICAL IN THESE DATA SETS'
DIRLINE  DC    CL133' '
         ORG   DIRLINE
DIRLCC   DC    C'-',C'OLD MEM='
DIRLOLD  DC    CL8' ',C' PAGE '
DIRLPGE  DC    CL4' ',C' NEW MEM='
DIRLNEW  DC    CL8' ',C' '
DIRLEQ   DC    CL8' ',C' '
DIRLNEQ  DC    CL9' ',C' '
DIRLMTCH DC    CL8' ',C' '
         ORG   ,
 TITLE 'YALE COMPARE     ---  BRUCE LELAND   ---  VERSION 2.0    '
*     CMPRSEQ  CSECT
*
*   THIS COMPARE PROGRAM ORIGINATED AT YALE UNIVERSITY AND WAS OBTAINED
*     FROM THE CONNECTICUT BANK AND TRUST COMPANY MODS TAPE (FILE 226)
*
*   THIS COMPARE PROGRAM USES ONLY COLUMNS ONE THROUGH 72; THUS, ANY
*     TWO VERSIONS OF A PROGRAM MAY BE EASILY COMPARED EVEN IF ONE
*     (OR BOTH) OF THE FILES HAS BEEN RESEQUENCED.  IF NEITHER FILE
*     HAS BEEN RESEQUENCED, A PARM OF "FULL" MAY BE CODED TO REQUEST
*     THAT ALL EIGHTY COLUMNS BE USED IN THE COMPARISON.  A FACILITY
*     IS ALSO PROVIDED TO IGNORE TRIVIAL CARD IMAGES (SUCH AS " EJECT "
*     OR " SPACE 3 " IN AN ASSEMBLER SOURCE PROGRAM).
*
*   THIS PROGRAM USES ALL AVAILABLE CORE IN ITS REGION AFTER OPENING
*     ITS INPUT/OUTPUT FILES (EXCEPT FOR 4K WHICH IS RELEASED).  THE
*     OBTAINED CORE AREA IS USED AS A COMPARE BUFFER WHICH IS ONLY
*     DUMPED (WRITTEN TO SYSPRINT) WHEN IDENTICAL RECORDS (BASED ON
*     THE FIRST 72 BYTES) ARE FOUND IN THE OLD AND NEW DATA SETS.  IF
*     THE COMPARE BUFFER OVERFLOWS, THE PROGRAM TERMINATES.  THEREFORE,
*     IF IT IS SUSPECTED THAT THE TWO DATA SETS MAY BE VERY FAR OUT OF
*     SYNC, A LARGE REGION SHOULD BE USED.  THE NUMBER OF UNMATCHED
*     RECORDS THAT CAN BE BUFFERED AT ONE TIME CAN BE CALCULATED FROM
*     THE EXPRESSION:  (REGION SIZE - 8K - BUFFERS) / 160
*     AS A GENERAL RULE, 30K IS SUFFICIENT FOR ABOUT 100 UNMATCHED
*     RECORDS AT A TIME, AND 100K IS SUFFICIENT FOR ABOUT 500 UNMATCHED
*     RECORDS AT A TIME.
*
*   CARD IMAGES OF THE TRIVAL DATA IS INPUT FROM THE IGNORE DDNAME;
*     IF THE DDCARD IS MISSING, A TABLE OF TRIVIAL DATA FOR ASSEMBLER
*     SOURCE CODE WILL BE ASSUMED (THIS INCLUDES " EJECT ", " SPACE   "
*     " SPACE 1 ", " SPACE 2 ", " SPACE 3 " AND BLANK COMMENT CARDS).
*
*
*
*   THE PROGRAM FORMAT ON THE CBT MODS TAPE WAS DISASSEMBLED SOURCE; IT
*     WAS RECOMMENTED, RESYMBOLIZED, REDOCUMENTED AND SLIGHTLY MODIFIED
*     BY  A. BRUCE LELAND (ABL)  OCTOBER, 1978
*
*
*   JCL:
*
*   //STEPNAME   EXEC  PGM=COMPARE,REGION=100K
*   //OLD        DD    DSN=OLD.SEQ.DSN ....
*   //NEW        DD    DSN=NEW.SEQ.DSN ....
*   //SYSPRINT   DD    SYSOUT=A
*   //IGNORE     DD    *      (OR DUMMY  --  OR OMITTED)
*     TRIVIAL CARD IMAGES THAT ARE TO BE IGNORED IN THE COMPARISON
*   /*
*
         EJECT
*        USING CMPRSEQ,R15
         DS    0D
YALECOMP EQU   *
         CLC   PARMPRNT(3),=C'DIR'
         BE    0(,R12)            USER ONLY WANT DIRECTORY LIST
         PRINT GEN
*        SAVE  (14,12),,*
         STM   R0,R15,SAVE
*        LR    R11,R13
*        LA    R13,SAVE
*        USING SAVE,R13
*        ST    R13,8(,R11)
*        ST    R11,4(,R13)
         B     INIT
SAVE     DC    18F'0'
*PARM     L     R1,0(,R1)
*         CLC   2(4,R1),FULL
*         BNE   OPEN
*         MVI   MLENGTH,X'4F'
*OPEN     OPEN  (NEW,,OLD,,SYSPRINT,OUTPUT,IGNORE)
*         SPACE
*         GETMAIN VU,LA=MIN,A=STARTADD      GET ALL AVAILABLE CORE
*         LM    R0,R2,FOURK                 LOAD 4K, START, SIZE
*         SR    R2,R0                       SUBTRACT OFF 4K
*         ST    R2,SIZE                     UPDATE REGION SIZE
*         AR    R1,R2                       LAST USEABLE BYTE
*         ST    R1,HIGHCORE                 SAVE FOR LATER
*         SPACE
*         FREEMAIN R,LV=(0),A=(1)           FREE THE 4K DYNAMIC AREA
*         L     R2,STARTADD
*         ST    R2,FIRSTIG
*         TM    IGNORE+48,X'10'             IGNORE OPEN?
*         BO    GETIG                       YES, BRANCH             ABL
*         MVC   FIRSTIG(8),IGASMS           FIRST AND LAST IGNORES  ABL
*         B     NOIG                          FOR ASSEMBLER SOURCE  ABL
*         SPACE
*GETIG    GET   IGNORE,(2)
*         LA    R2,80(,R2)
*         B     GETIG
*         SPACE
*ENDIG    CLOSE (IGNORE)
*         ST    R2,LASTIG                                          ABL
INIT     EQU   *
*                                                                   BFG
**       SETUP REG 10 TO HAVE LENGTH OF RECORDS                     BFG
*                                                                   BFG
         LA    R2,OLDDCB
         LH    R10,LRECL(,R2)      GET LRECL
         CH    R10,MLENGTH         IS IT LARGER THAN MLENGTH      GP@P6
         BH    *+8                 YES                            GP@P6
         MVI   MLENGTH+1,0         NO, FORCE 'FULL'               GP@P6
         TM    RECFM(R2),X'10'     IS IT BLOCKED
         BO    *+8                 YES, BRANCH
         LH    R10,BLKSI(,R2)      NO, BLKSIZE IS RECORD LENGTH
         SPACE
         LA    R2,NEWDCB
         LH    R1,LRECL(,R2)       GET LRECL
         TM    RECFM(R2),X'10'     IS IT BLOCKED
         BO    *+8                 YES, BRANCH
         LH    R1,BLKSI(,R2)       NO, BLKSIZE IS RECORD LENGTH
         SPACE
         CR    R10,R1              IS OLD LONGER THAN NEW
         BNH   *+6                 NO, BRANCH
         LR    R10,R1              YES, USE THE SHORTER OF THE TWO
*        LA    R1,256              MAX RECORD SIZE  (NOW NO MAX SIZE)
*        CR    R10,R1              IS LRECL TOO LONG
*        BNH   *+6                 NO, BRANCH
*        LR    R10,R1              YES, USE 256
*                                                                   BFG
**       INIT OTHER FIELDS                                          BFG
*                                                                   BFG
         L     R2,BSTRTA           ADDRESS OF GOTTEN BUFFER+IGNORES BFG
         L     R3,SIZE             SIZE OF GOTTEN BUFFER
         S     R3,BSTRTA                                            BFG
         A     R3,STARTADD         SIZE OF BUFFER TO BE CLEARED
         SR    R8,R8               SET FROM AREA TO BE ALL PADS     BFG
         SR    R9,R9               WITH LENGTH AND ADDRESS OF ZERO  BFG
         MVCL  R2,R8
         L     R2,BSTRTA           ADDRESS OF GOTTEN BUFFER+IGNORES BFG
         XC    COUNT,COUNT
         XC    RC,RC
         ST    R2,LOWOLD                                           ABL
         ST    R2,HIGHOLD
         ST    R2,CURROLD
         AR    R2,R10
         ST    R2,LOWNEW
         ST    R2,HIGHNEW
         ST    R2,CURRNEW
         LA    R8,OLDDCB
         LA    R9,NEWDCB
*
*    THIS COMPLETES THE PROGRAM INITIALIZATION
*
         EJECT
SWAP     XR    R9,R8
         XR    R8,R9
         XR    R9,R8
         L     R3,CURR(,R9)
         C     R3,HIGH(,R9)
         BL    NOINPUT
         TM    OFLGS(R9),X'10'         CURRENT DCB OPEN?
         BZ    SWAP                    NO, BRANCH (AND SWAP)
OMITGET  DS    0H                                                   GP
         LA    R1,0(,R9)
         GET   (1)
         SPACE
         TM    RECFM(R9),X'C0'      FIXED LENGTH RECORDS?        GP@FT*
         BNM   USEGET               NO, BYPASS IGNORE TEST            *
         TM    RECFM(R9),X'80'      FIXED LENGTH RECORDS?             *
         BNO   USEGET               NO, BYPASS IGNORE TEST       GP@FT*
         LR    R14,R10              GET LENGTH TO COMPARE           GP*
         BCTR  R14,0                MINUS 1 FOR EX                    *
         SH    R14,MLENGTH          MINUS 8 FOR SEQUENCE NUMBERS      *
         L     R15,FIRSTIG                FIRST IGNORE                *
         LA    R0,79                                                  *
         CR    R14,R0                     IS LENGTH GREATER THAN 80   *
         BNH   *+6                        NO                          *
         LR    R14,R0                     YES, REDUCE TO 80           *
LOOPIG   C     R15,LASTIG                 LAST IGNORE?                *
         BNL   USEGET                     YES, BRANCH                 *
         EX    R14,CLCIG                  AN IGNORE RECORD?           *
         BE    OMITGET                    YES, GET ANOTHER RECORD     *
         LA    R15,80(,R15)                                           *
         B     LOOPIG                     CHECK ALL IGNORES           *
CLCIG    CLC   0(0,R1),0(R15)                                         *
USEGET   DS    0H                   DO NOT IGNORE THIS RECORD       GP*
         SPACE
         LA    R0,0(R10,R3)
         SPACE
         C     R0,HIGHCORE             FIT IN CORE?
         BH    NOTCORE                 NO, BRANCH
         SPACE
         LR    R15,R10                 GET LENGTH
         TM    RECFM(R9),DS1RECFV      FIXED LENGTH RECORDS?        GP*
         BZ    MVCSTART                YES, OVERLAY ALL RESIDUAL DATA *
         LR    R14,R3                  NO, COPY TARGET POINTER        *
         LA    R0,256                  LOAD 256 FOR FAST ACCESS       *
XCLOOP   CR    R15,R0                  LESS THAN 256 BYTES?           *
         BL    XCTRAIL                 YES, CLEAR THAT LENGTH         *
         XC    0(256,R14),0(R14)       NO, CLEAR 256 BYTES            *
         AR    R14,R0                  ADVANCE TARGET POINTER         *
         SR    R15,R0                  DECREASE BYTES-TO-DO           *
         BZ    XCDONE                  RECORD WAS 256 MULTIPLE        *
         B     XCLOOP                  CONTINUE ERASING RESIDUAL DATA *
XCTRAIL  BCTR  R15,0                   LENGTH MINUS 1 FOR EX          *
         B     *+10                    SKIP XC                        *
         XC    0(0,R14),0(R14)         EXECUTED                       *
         EX    R15,*-6                 CLEAR THE REST OF THE RECORD   *
XCDONE   DS    0H                      RESIDUAL DATA NOW ERASED       *
         LH    R15,LRECL(,R9)          LOAD PHYSICAL LENGTH JUST READ *
         TM    RECFM(R9),DS1RECFU      UNDEFINED RECORD LENGTH?       *
         BO    MVCSTART                YES, GOOD GUESS                *
         ICM   R15,3,0(R1)             NO, VARIABLE SO GET IT FROM RDW*
MVCSTART LR    R14,R3                  COPY TARGET POINTER            *
         LA    R0,256                  LOAD 256 FOR FAST ACCESS       *
MVCLOOP  CR    R15,R0                  LESS THAN 256 BYTES?           *
         BL    MVCTRAIL                YES, LOAD THAT LENGTH          *
         MVC   0(256,R14),0(R1)        NO, MOVE 256 BYTES             *
         AR    R14,R0                  ADVANCE TARGET POINTER         *
         AR    R1,R0                   ADVANCE SOURCE POINTER         *
         SR    R15,R0                  DECREASE BYTES-TO-DO           *
         BZ    MVCDONE                 RECORD WAS 256 MULTIPLE        *
         B     MVCLOOP                 CONTINUE WITH THE MOVE         *
MVCTRAIL DS    0H                      JUST THE LAST BIT LEFT       GP*
         BCTR  R15,0                   LENGTH MINUS 1 FOR EX
         B     *+10                    SKIP MVC
         MVC   0(0,R14),0(R1)          EXECUTED
         EX    R15,*-6                 MOVE THE RECORD
MVCDONE  DS    0H                      RECORD NOW COPIED TO BUFFER  GP*
         SPACE
         LR    R0,R10                  GET LENGTH
         AR    R0,R0                   DOUBLE IT
         AR    R0,R3                   ADD R3
         SPACE
         ST    R0,HIGH(,R9)
         SPACE 2
*  SEE IF THIS RECORD (R3) IS ANYWHERE IN THE OTHER BUFFER
*
NOINPUT  L     R2,LOW(,R8)
NEXT8    C     R2,CURR(,R8)
         BNL   NO8
         LR    R1,R10              GET LENGTH TO COMPARE
         SH    R1,MLENGTH          MINUS 8 FOR SEQUENCE NUMBERS (MAYBE)
         STM   R2,R3,DOUBLE        SAVE POINTER REGISTERS           GP*
         LA    R0,256              LOAD 256 FOR FAST ACCESS           *
CLCLOOP  CR    R1,R0               LESS THAN 256 BYTES?               *
         BL    CLCTRAIL            YES, COMPARE THAT LENGTH           *
         CLC   0(256,R3),0(R2)     NO, COMPARE 256 BYTES              *
         BNE   CLCRESTR            MISMATCH FOUND SO LEAVE LOOP       *
         AR    R3,R0               ADVANCE TARGET POINTER             *
         AR    R2,R0               ADVANCE SOURCE POINTER             *
         SR    R1,R0               DECREASE BYTES-TO-DO               *
         BZ    CLCRESTR            RECORD WAS 256 MULTIPLE            *
         B     CLCLOOP             CONTINUE WITH THE COMPARE          *
CLCTRAIL DS    0H                  JUST THE LAST BIT LEFT           GP*
         BCTR  R1,0                MINUS 1 FOR EX
         B     *+10                SKIP CLC
         CLC   0(1,R3),0(R2)
         EX    R1,*-6              EXECUTE CLC
CLCRESTR LM    R2,R3,DOUBLE        RESTORE POINTER REGISTERS        GP
         BE    FOUND8
         AR    R2,R10
         AR    R2,R10
         B     NEXT8
NO8      EQU   *                   NOT IN THE BUFFER
         AR    R3,R10
         AR    R3,R10
         ST    R3,CURR(,R9)        UPDATE THE CURRENT POINTER
         B     SWAP
         SPACE 2
*    DOES NOT FIT IN THE ALLOCATED CORE
*
NOTCORE  BAL   R14,NOTEQUAL               OUTPUT NOT EQUAL MESSAGE
         CLOSE (NEWDCB,,OLDDCB)
         FREEPOOL OLDDCB                                            ABL
         FREEPOOL NEWDCB                                            ABL
         MVC   RETCODE,=F'8'       RETURN CODE 8                    ABL
         MVC   BUFFER(35),CORE            CORE OVERFLOW MESSAGE
         MVC   BUFFER+35(86),BUFFER+34    CLEAR THE REMAINDER
         LA    R1,BUFFER                                            GLA
         BAL   R14,PUTLINE         PRINT THE LINE                   GLA
         MVI   BUFFER,X'40'
         B     CORETERM
         SPACE 2
PUTLINE  ST    R14,R14SAVE                                      ABL GLA
         CLI   PVECTOR,C'*'               PDS REENTRY?          ABL GLA
         BE    PUTL10                     YES, BRANCH           ABL GLA
         LR    R0,R1               PUT ADDRESS IN RIGHT REGISTER    GLA
         PUT   SYSPRINT,(0)                                         GLA
         L     R14,R14SAVE                                      ABL GLA
         BR    R14                                              ABL GLA
PUTL10   DS    0H                         R1 IS ALREADY SETUP       GLA
         L     R15,PVECTOR                REENTRY VECTOR ADDRESSABL GLA
         MVC   WORKLINE,0(R1)             SAVE THE OUTPUT LINE      ABL
         LA    R1,WORKLINE                RESET THE OUTPUT ADDRESS  ABL
         MVI   0(R1),121                  SET THE RETURN LENGTH     ABL
         BALR  R14,R15                    RETURN TO PDS         ABL GLA
         LTR   R15,R15                    SUCCESSFUL OUTPUT?    ABL GLA
         BNZ   EXIT12                     NO - ATTENTION, BRANCHABL GLA
         L     R14,R14SAVE                                      ABL GLA
         BR    R14                                              ABL GLA
         EJECT
*   RECORD WAS FOUND -- SEE IF IT IS TO BE IGNORED
*
FOUND8   CLC   CURR(4,R9),LOW(R9)           RECORDS IN ACTIVE BUFFER?
         BNE   NOTIG                        YES                     GP
* LOGIC CHANGE: DO NOT CHECK IGNORE RECORDS AT THIS STAGE BUT       GP
*               IMMEDIATELY AFTER INPUT, AND DISCARD STRAIGHT AWAY. GP
*        BNE   CHKIG                        YES, CHECK IGNORES
         ST    R2,CURR(,R8)
         B     IGEQUAL
*CHKIG   L     R15,FIRSTIG                FIRST IGNORE
*        LA    R0,79
*        CR    R1,R0                      IS LENGTH GREATER THAN 80
*        BNH   *+6                        NO
*        LR    R1,R0                      YES, REDUCE TO 80
*LOOPIG  C     R15,LASTIG                 LAST IGNORE?
*        BNL   NOTIG                      YES, BRANCH
*        EX    R1,CLCIG                   AN IGNORE RECORD?
*        BE    NO8                        YES, BRANCH
*        LA    R15,80(,R15)
*        B     LOOPIG                     CHECK ALL IGNORES
*CLCIG   CLC   0(1,R3),0(R15)
*
NOTIG    ST    R2,CURR(,R8)               NOT AN IGNORE RECORD
         BAL   R14,NOTEQUAL               OUTPUT "NOT EQUAL"
IGEQUAL  BAL   R14,INBUFF                 ADD TO COMPARE BUFFER
         XR    R9,R8
         XR    R8,R9
         XR    R9,R8
         BAL   R14,INBUFF                 ADD TO OTHER BUFFER
         B     SWAP
         SPACE 2
*  END OF FILE (OLD OR NEW)
*
EOLDNEW  CLOSE ((9))                      CLOSE THE CURRENT FILE
         FREEPOOL (9)                                               ABL
         XR    R9,R8
         XR    R8,R9
         XR    R9,R8
         TM    OFLGS(R9),X'10'            OTHER FILE STILL OPEN?
         BNZ   SWAP                       YES, BRANCH
         CLC   LOWOLD(4),HIGHOLD          BUFFER EMPTY?
         BNE   *+14                       NO, BRANCH
         CLC   LOWNEW(4),HIGHNEW          OTHER BUFFER EMPTY TOO?
         BE    TRIPLE                     YES, QUIT
         BAL   R14,NOTEQUAL               FLUSH THE CURRENT BUFFERS
         B     TRIPLE
         EJECT
*  TERMINATE -- LIST NUMBER OF UNEQUAL COMPARES
*
TRIPLE   MVI   BUFFER,C' '                                          BFG
         CLI   DELAY,C'D'                  DELAYED OUTPUT?          ABL
         BE    EXIT                        YES, BRANCH              ABL
         LA    R1,BLANKS                SPACE  LINES W/O            GLA
         BAL   R14,PUTLINE                                          GLA
         LA    R1,BLANKS                   CARRIAGE CONTROL         GLA
         BAL   R14,PUTLINE                                          GLA
CORETERM MVC   BUFFER+1(6),EDCOUNT          EDIT MASK
         MVC   BUFFER+7(35),BLOCKS          UNEQUAL BLOCKS MESSAGE
         MVC   BUFFER+42(79),BUFFER+41      BLANK REMAINDER
         LH    R1,COUNT
         CVD   R1,DOUBLE
         ED    BUFFER+1(6),DOUBLE+5
         LA    R1,BUFFER                   CARRIAGE CONTROL         GLA
         BAL   R14,PUTLINE                                          GLA
         MVC   BUFFER+7(35),BLANK   CLEAR OUT BUFFER                BFG
         B     EXIT
EXIT12   MVI   RC+1,12                                              ABL
EXIT     LA    R2,NEWDCB
         TM    OFLGS(R2),X'10'     IS DCB OPN
         BNO   EXITNEWC
         CLOSE (NEWDCB)
         FREEPOOL NEWDCB                                            ABL
EXITNEWC EQU   *
         LA    R2,OLDDCB
         TM    OFLGS(R2),X'10'     IS DCB OPN
         BNO   EXITOLDC
         CLOSE (OLDDCB)
         FREEPOOL OLDDCB                                            ABL
EXITOLDC EQU   *
         LH    R15,RC                                               BFG
         LM    R0,R14,SAVE          RESTORE REGS                    BFG
         BR    R12                  RETURN                          BFG
         SPACE
*  RE-INITIALIZE THE ACTIVE BUFFER -- SLIDE UNUSED RECORDS DOWN
*
INBUFF   L     R1,LOW(,R9)
         L     R2,CURR(,R9)
         ST    R1,CURR(,R9)
NXTREC   EQU   *
         AR    R2,R10
         AR    R2,R10
         C     R2,HIGH(,R9)        FINISHED REINITIALIZING?
         BNL   REINIT              YES, BRANCH
         SPACE
         LR    R15,R10             GET LENGTH                       GP*
         STM   R1,R2,DOUBLE        SAVE POINTER REGISTERS             *
         LA    R0,256              LOAD 256 FOR FAST ACCESS           *
SLIDELP  CR    R15,R0              LESS THAN 256 BYTES?               *
         BL    SLIDETRL            YES, LOAD THAT LENGTH              *
         MVC   0(256,R1),0(R2)     NO, MOVE 256 BYTES                 *
         AR    R1,R0               ADVANCE TARGET POINTER             *
         AR    R2,R0               ADVANCE SOURCE POINTER             *
         SR    R15,R0              DECREASE BYTES-TO-DO               *
         BZ    SLIDEDON            RECORD WAS 256 MULTIPLE            *
         B     SLIDELP             CONTINUE WITH THE MOVE             *
SLIDETRL BCTR  R15,0               JUST THE LAST BIT LEFT             *
         EX    R15,SLIDEMVC        MOVE THE REST OF THE RECORD
SLIDEDON LM    R1,R2,DOUBLE        RESTORE THE POINTER REGISTERS    GP*
         SPACE
         AR    R1,R10
         AR    R1,R10
         B     NXTREC
SLIDEMVC MVC   0(0,R1),0(R2)       EXECUTED
REINIT   ST    R1,HIGH(,R9)        RESET MAXIMUM POINTER
         BR    R14
         EJECT
*     FLUSH OUT THE NON-EQUAL RECORDS
*
NOTEQUAL ST    R14,NOTEQR14
         MVI   RC+1,4             RETURN CODE 4
         LH    R1,COUNT
         LA    R1,1(,R1)
         STH   R1,COUNT
         MVI   BUFFER,C' '
         LA    R3,OLDDCB
*
         CLI   DELAY,C'D'          DELAYED HEADER?                  ABL
         BNE   NOTEQU2             NO, BRANCH                       ABL
         MVI   DELAY,C'1'          YES, RESET TO EJECT              ABL
         LA    R1,EJECT                                             ABL
         BAL   R14,PUTLINE         GO TO TOP OF FORM AND PRINT      ABL
         LA    R1,OLDHDG           PRINT OLD PDS DSN AND MEMBER     ABL
         BAL   R14,PUTLINE         PRINT OLD PDS DSN AND MEMBER     ABL
         LA    R1,NEWHDG           PRINT NEW PDS DSN AND MEMBER     ABL
         BAL   R14,PUTLINE         PRINT NEW PDS DSN AND MEMBER     ABL
NOTEQU2  DS    0H                                                   ABL
*    OUTPUT TWO BLANK LINES (TRIPLE SPACE) FOR BROWSE
         LA    R1,BLANKS                SPACE  LINES W/O            GLA
         BAL   R14,PUTLINE                                          GLA
         LA    R1,BLANKS                   CARRIAGE CONTROL         GLA
         BAL   R14,PUTLINE                                          GLA
MOVES    MVC   BUFFER+9(3),OLDNEW(R3)
         MVC   BUFFER+98(3),OLDNEW(R3)
         MVI   BUFFER+7,C'-'
         MVI   BUFFER+102,C'-'
         ZAP   NUMBER(3),=P'0'
         L     R5,LOW(,R3)
FLUSHED  C     R5,CURR(,R3)               IS THIS BUFFER FLUSHED?
         BNL   GETNEW                     YES, BRANCH
         LR    R15,R10                 GET LENGTH                 GP@P6
         CH    R15,=H'80'              CHECK FOR LARGE LRECL      GP@P6
         BNH   *+8                     LRECL IS OKAY              GP@P6
         LA    R15,80                  NEVER SHOW MORE THAN 80    GP@P6
         BCTR  R15,0                   LENGTH MINUS 1 FOR EX      GP@P6
         EX    R15,RECPRTBF            COPY RECORD TO PRINT BUFR  GP@P6
         AP    NUMBER(3),=P'1'
         MVC   DOUBLE(6),EDMKPAT
         EDMK  DOUBLE(6),NUMBER           POINT R1 TO FIRST NONBLANK
         LA    R14,DOUBLE+5               POINT TO LAST DIGIT
         SR    R14,R1                     GET LENGTH MINUS 1
         STC   R14,MOVEA+1                ALTER MVC LENGTH CODE
MOVEA    MVC   BUFFER+103(1),0(R1)        MOVE NUMBER
         LA    R15,BUFFER+104(R14)
         MVI   0(R15),C'-'
         LA    R14,1(,R14)
         STC   R14,MOVEB+1
         LA    R1,BUFFER+6
         SR    R1,R14
MOVEB    MVC   0(1,R1),BUFFER+102
         CLI   PVECTOR,C'*'               PDS REENTRY?              ABL
         BE    MOVEB2                     YES, BRANCH               ABL
         TM    SYSPRINT+17,X'4F'        TSO OUTPUT "DA(*)"?         ABL
         BNO   MOVEB2                   NO, BRANCH                  ABL
         MVC   BUFFER+79(42),BLANKS     BLANK PAST SCREEN WIDTH     ABL
         TR    BUFFER(79),TSOXLATE      REMOVE UNDISPLAYABLES       -GP
MOVEB2   LA    R1,BUFFER                                            GLA
         BAL   R14,PUTLINE                                          GLA
         MVI   BUFFER,X'40'
         AR    R5,R10
         AR    R5,R10
         B     FLUSHED
RECPRTBF MVC   BUFFER+15(0),0(R5)         EXECUTED                GP@P6
*
GETNEW   LA    R1,NEWDCB
         CR    R3,R1                      NEW DONE?
         BE    NOTEQRET                   YES, RETURN
         LR    R3,R1                      NOW SETUP THE NEW BUFFER
         MVC   BUFFER+1(7),BLANKS
         MVI   BUFFER+9,C'-'
         MVC   BUFFER+10(91),BUFFER+9
         MVC   BUFFER+102(19),BLANKS
         CLI   PVECTOR,C'*'               PDS REENTRY?              ABL
         BE    MOVEB22                    YES, BRANCH               ABL
         TM    SYSPRINT+17,X'4F'          TSO OUTPUT "DA(*)"?       ABL
         BNO   *+10                       NO, BRANCH                ABL
         MVC   BUFFER+78(43),BLANKS       BLANK PAST SCREEN WIDTH   ABL
MOVEB22  LA    R1,BUFFER                                            GLA
         BAL   R14,PUTLINE                                          GLA
         MVI   BUFFER,X'40'
         B     MOVES
         SPACE
NOTEQRET L     R14,NOTEQR14
         BR    R14
         EJECT
*
*        DCB EXIT ROUTINE (USED BY ALL FILES)
*
DCBEXIT  LH    R3,BLKSI(,R1)              BLKSIZE
         LR    R4,R3                      BLKSIZE        FIX-0C9
         TM    RECFM(R1),X'10'            IS IT BLOCKED  FIX-0C9
         BZ    *+8                        NO             FIX-0C9
         LH    R4,LRECL(,R1)              BLOCKED, GET LRECL
         SR    R2,R2
         DR    R2,R4                      BLOCKSIZE/LRECL
         MR    R2,R4                      BLOCKING*LRECL
         CR    R3,R4                      BLOCKSIZE >  LRECL?
         BH    *+10                       YES, BRANCH
         LR    R3,R4                      MAKE BLKSIZE=LRECL
         NI    RECFM(R1),255-X'10'        TURN OFF BLOCKING
         STH   R3,BLKSI(,R1)              NEW BLOCKSIZE
         STH   R3,24(,R1)                 BUFLEN PARAMETER
         CLI   20(R1),X'00'               BUFNO=0?
         BNER  R14                        NO, QUIT
         MVI   20(R1),X'03'               DEFAULT TO 3 BUFFERS
         BR    R14                        EXIT
         SPACE 1
SYSPRINT DCB   LRECL=121,RECFM=FBA,EXLST=EXITDCB,DDNAME=SYSPRINT,      X
               MACRF=(PM),DSORG=PS
         SPACE 1
IGNORE   DCB   LRECL=80,RECFM=FB,EXLST=EXITDCB,DDNAME=IGNORE,          X
               EODAD=ENDIG,MACRF=(GM),DSORG=PS
FIRSTIG  DC    F'0'                     POINTER TO FIRST IGNORE RECORD
LASTIG   DC    F'0'                     POINTER TO LAST IGNORE RECORD
         SPACE 1
OLDDCB   DCB   DDNAME=OLD,EXLST=OLDXLST2,                              X
               EODAD=EOLDNEW,MACRF=(GL),DSORG=PS,OPTCD=C
RECFM    EQU   36
DDNAM    EQU   40
OFLGS    EQU   48
LRECL    EQU   82
BLKSI    EQU   62
LOWOLD   DC    F'0'                     FIRST OLD RECORD
HIGHOLD  DC    F'0'                     HIGHEST USED OLD RECORD
CURROLD  DC    F'0'                     CURRENT OLD RECORD
SAVER07  DC    F'0'                     SAVE REGISTER 7 (3RD BASE)
OLDLIT   DC    C'OLD'
         SPACE 1
NEWDCB   DCB   DDNAME=NEW,EXLST=NEWXLST2,                              X
               EODAD=EOLDNEW,MACRF=(GL),DSORG=PS,OPTCD=C
LOWNEW   DC    F'0'                     FIRST NEW RECORD
HIGHNEW  DC    F'0'                     HIGHEST USED NEW RECORD
CURRNEW  DC    F'0'                     CURRENT NEW RECORD
NEWLIT   DC    C'NEW'
LOW      EQU   LOWNEW-NEWDCB      DISPLACEMENT TO LOWOLD AND LOWNEW
HIGH     EQU   HIGHNEW-NEWDCB     DISPLACEMENT TO HIGHOLD AND HIGHNEW
CURR     EQU   CURRNEW-NEWDCB     DISPLACEMENT TO CURROLD AND CURRNEW
OLDNEW   EQU   NEWLIT-NEWDCB      DISPLACEMENT TO OLD OR NEW LITERAL
DS1RECFV EQU   X'40'           RECFM V
DS1RECFU EQU   X'C0'           RECFM U
         EJECT
         DS    0F
EXITDCB  DC    X'85',AL3(DCBEXIT)
RC       DC    H'0'
COUNT    DC    H'0'
NUMBER   DC    XL3'0'
*MLENGTH DC    AL1(71)             COMPARE LENGTH FOR EACH RECORD
MLENGTH  DC    H'8'                ADJUSTMENT TO COMPARE LENGTH
MIN      DC    0F'0',A(100*1024)    MINIMUM STORAGE TO GETMAIN   100K
MAX      DC    A(2000*1024)         MAXIMUM STORAGE TO GETMAIN   2000K
SIXTEENK DC    A(16*1024)           AMOUNT OF STORAGE TO RELEASE 16K
*MIN     DC    0F'0',X'00014000'    MINIMUM CORE TO GETMAIN    80K
*MAX     DC    X'000C8000'          MAXIMUM CORE TO GETMAIN   800K
*FOURK   DC    X'00001000' F'4096'  AMOUNT OF CORE TO RELEASE
STARTADD DC    F'0'                 BUFFER START ADDRESS
SIZE     DC    F'0'                 SIZE OF THE BUFFER AREA
HIGHCORE DC    F'0'                 MAXIMUM BUFFER ADDRESS
BSTRTA   DC    F'0'                 ADDRESS AFTER LAST OF IGNORES   BFG
BUFFER   DC    X'004040404040406040000000606060'
         DC    80X'00',X'606060000000',X'4060404040404040'
         DC    12C' '
BLANKS   DC    CL121' '
WORKLINE DC    CL121' '
EDCOUNT  DC    X'402020202120'
EDMKPAT  DC    X'402020202020'
CORE     DC    C'-CORE OVERFLOW - COMPARE ABANDONED '
BLOCKS   DC    C' BLOCKS OF COMPARE ERRORS DETECTED '
DEVAREA  DC    2F'0'
NOTEQR14 DC    F'0'
R14SAVE  DC    F'0'                                             ABL GLA
PVECTOR  DC    F'0'                                             ABL GLA
IGASMS   DC    A(DFTIG,DFTIG)           DEFAULT IGNORE TABLE        ABL
DFTIG    DC    CL80'         EJECT   '                              ABL
         DC    CL80'         SPACE   '                              ABL
         DC    CL80'         SPACE 1 '                              ABL
         DC    CL80'         SPACE 2 '                              ABL
         DC    CL80'         SPACE 3 '                              ABL
         DC    CL80'*                '                              ABL
ENDDFTIG EQU   *                                                    ABL
         LTORG
TSOXLATE DS    0D            STOP PROG753 WITH TERMINAL EMULATOR    -GP
         DC    XL16'004B4B4B4B4B4B4B4B4B4B4B4B4B4B4B'
         DC    XL16'4B4B4B4B4B4B4B4B4B4B4B4B1C4B1E4B'   3270 DATA
         DC    XL16'4B4B4B4B4B4B4B4B4B4B4B4B4B4B4B4B'   STREAMS ALLOW
         DC    XL16'4B4B4B4B4B4B4B4B4B4B4B4B4B4B4B4B'   X'40' TO X'FE'
         DC    XL16'404142434445464748494A4B4C4D4E4F'   AS DISPLAYABLE
         DC    XL16'505152535455565758595A5B5C5D5E5F'   CHARACTERS IN
         DC    XL16'606162636465666768696A6B6C6D6E6F'   ALL CHARACTER
         DC    XL16'707172737475767778797A7B7C7D7E7F'   SETS.  THAT
         DC    XL16'808182838485868788898A8B8C8D8E8F'   DOESN'T MEAN
         DC    XL16'909192939495969798999A9B9C9D9E9F'   THAT THERE IS
         DC    XL16'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'   A GOOD SYMBOL
         DC    XL16'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'   FOR EACH OF
         DC    XL16'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'   THESE CODE
         DC    XL16'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'   POINTS,
         DC    XL16'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'   THOUGH!
         DC    XL16'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFE4B'
         DC    0D'0'
         SPACE
         END   COMPAREB
//*
//LNK2   EXEC  PGM=IEWL,PARM='MAP',COND=(5,LT)
//SYSPRINT DD  SYSOUT=*
//SYSLIN   DD  DSN=&&X,DISP=(OLD,DELETE)
//SYSLMOD  DD  DISP=SHR,DSN=SYS2.CMDLIB(COMPAREB)
//SYSUT1   DD  UNIT=SYSDA,SPACE=(TRK,(5,5))
//*
//COPH   EXEC  PGM=IEBGENER,COND=(5,LT)
//SYSPRINT DD  SYSOUT=*
//SYSUT2   DD  DSN=SYS2.HELP(COMPARE),DISP=SHR
//SYSIN    DD  *
//SYSUT1   DD  *
)F FUNCTION -
  THE COMPARE COMMAND COMPARES TWO DATA SETS.  IT IS A FRONT-END TO
  A BATCH UTILITY TO ENABLE THE COMPARE PROCESS TO BE CARRIED OUT
  IN A TSO SESSION.

  COMPARE INVOKES EITHER THE YALE COMPARE PROGRAM (COMPAREB)
           -OR-   THE IBM COMPARE UTILITY PROGRAM (IEBCOMPR).

  COMPAREB CAN COMPARE TWO SEQUENTIAL INPUTS (WHICH MAY BE A
  SEQUENTIAL FILE OR A SINGLE MEMBER FROM A PARTITIONED DATA SET).

  COMPAREB CAN COMPARE TWO PARTITIONED LIBRARIES SO THAT LIKE-NAMED
  MEMBERS ARE COMPARED WHENEVER A MEMBER NAME MATCH OCCURS, AND A
  LISTING OF MEMBER NAME MATCHING DETAILS IS ALSO PRODUCED.

  COMPAREB CAN COMPARE RECORDS OF FIXED, VARIABLE OR UNDEFINED RECORD
  LENGTH.  THE SHORTER OF THE TWO INPUT MAXIMUM RECORD LENGTHS IS
  COMPARED.  FOR VARIABLE LENGTH RECORDS, THE RDW (RECORD DESCRIPTOR
  WORD) IS ALSO COMPARED.  FOR UNDEFINED LENGTH RECORDS, A DIFFERENCE
  OF ONLY EXTRA TRAILING NULLS WILL NOT BE DETECTED.  BECAUSE COMPAREB
  COMPARES PHYSICAL BIT PATTERNS, LOAD MODULES AND SPANNED RECORD FILES
  THAT HAVE BEEN REBLOCKED WILL PROBABLY COMPARE AS HAVING SUBSTANTIAL
  DIFFERENCES EVEN THOUGH THEY CONTAIN LOGICALLY EQUIVALENT DATA.

  COMPAREB WILL NOT COMPARE THE LAST EIGHT BYTES OF THE MAXIMUM RECORD
  LENGTH (OFTEN RESERVED FOR SEQUENCE NUMBERS) UNLESS 'FULL' IS
  SPECIFIED.

  (FOR INFORMATION ABOUT INVOKING 'COMPAREB' DIRECTLY WITHOUT THE
  TSO 'COMPARE' COMMAND FRONT END, ENTER
                                         HELP COMPARE O(YALE)
  UNDER TSO.)

)X SYNTAX  -
         COMPARE  'OLD-DSNAME'  'NEW-DSNAME'  IEBCOMPR
             FULL  ASM/NOASM
             OVOL('VOLUME')  OUNIT('UNIT')
             NVOL('VOLUME')  NUNIT('UNIT')
             SYSOUT / PRINT / NOPRINT / OUTFILE('DDNAME')

  REQUIRED - 'OLD DSNAME'   'NEW DSNAME'
  DEFAULTS - THE YALE COMPARE PROGRAM (COMPAREB) IS USED.
             PRINT - DISPLAY DIFFERENCES ON TSO TERMINAL.
             ASM   - IGNORE ASSEMBLER SOURCE 'SPACE', 'EJECT'
                     AND BLANK COMMENT CARD IMAGES.
  ALIAS    - NONE
)O OPERANDS -
  'OLD-DSNAME' -  THE NAME OF THE SYSUT1 OR OLD DATA SET.
             A MEMBER NAME MAY BE SPECIFIED IF IT IS PARTITIONED.
  'NEW-DSNAME' -  THE NAME OF THE SYSUT2 OR NEW DATA SET.
             A MEMBER NAME MAY BE SPECIFIED IF IT IS PARTITIONED.
             IF THE DATA SET IS PARTITIONED AND A MEMBER IS NOT
             SPECIFIED, THE MEMBER DEFAULTS TO THE OLD MEMBER NAME.
))FULL     - INCLUDE THE SEQUENCE NUMBERS IN THE COMPARISON.
             IT SHOULD ALMOST CERTAINLY BE SPECIFIED FOR ANY
             UNDEFINED OR VARIABLE LENGTH RECORD INPUT.
             (COMPAREB ONLY.)
))ASM      - SPECIFIES THAT THE COMPARISON DATA IS ASSEMBLER SOURCE.
             SEQUENCE NUMBERS, 'SPACE', 'EJECT' AND BLANK COMMENT
             CARD IMAGES WILL NOT BE COMPARED.  (COMPAREB ONLY.)
))NOASM    - SPECIFIES THAT THE COMPARISON DATA IS NOT ASSEMBLER
             SOURCE.  (COMPAREB ONLY.)
))IEBCOMPR - THE IBM UTILITY PROGRAM 'IEBCOMPR' IS TO BE USED.
))OVOL     - VOLUME CONTAINING OLD DATA SET.  NOT NEEDED IF CATALOGED.
             IF YOU USE OVOL, YOU SHOULD ALSO USE NVOL EVEN IF THE
             NEW DATA SET IS CATALOGED.
))OUNIT    - UNIT NAME FOR ALLOCATING OLD DATA SET.
             NOT NEEDED IF CATALOGED.
))NVOL     - VOLUME CONTAINING NEW DATA SET.  NOT NEEDED IF CATALOGED.
             IF YOU USE NVOL, YOU SHOULD ALSO USE OVOL EVEN IF THE
             OLD DATA SET IS CATALOGED.
))NUNIT    - UNIT NAME FOR ALLOCATING NEW DATA SET.
             NOT NEEDED IF CATALOGED.
))PRINT    - DIRECTS MESSAGES TO THE TERMINAL.  THIS IS THE DEFAULT.
))NOPRINT  - DIRECTS MESSAGES TO A DUMMY FILE.
))SYSOUT   - DIRECTS MESSAGES TO A SYSOUT DATA SET.
))OUTFILE  - DIRECTS MESSAGES TO THE SPECIFIED DDNAME.

))YALE     - 'YALE' IS NOT AN OPERAND, BUT JUST A HELP ENTRY TO
             DOCUMENT THE 'COMPAREB' BATCH UTILITY.

             'COMPAREB' REQUIRES JCL SIMILAR TO THE FOLLOWING:

             //        EXEC PGM=COMPAREB,REGION=2M,
             //             PARM='SIZE=NNNN,TYPE=OPT1,PRINT=OPT2'
             //SYSPRINT DD  SYSOUT=*
             //OLD      DD  DSN=YOUR.INPUT1,DISP=SHR
             //NEW      DD  DSN=YOUR.INPUT2,DISP=SHR
             //IGNORE   DD  *            <=== OMIT IF NOT REQUIRED
             IGNORE CARD-IMAGE 1
             ...
             IGNORE CARD-IMAGE N
             /*

    WHERE    NNNN IS 3 OR 4 NUMERICS INDICATING AN ESTIMATE OF HOW
                  MANY MEMBERS EXIST IN THE PDS WITH THE MOST MEMBERS.
                  THE DEFAULT VALUE IS 9999.  IF A VALUE OF LESS THAN
                  100 IS SUPPLIED, THE PROGRAM WILL CHANGE THE VALUE
                  TO 100.  IF THERE ARE MORE MEMBERS THAN INDICATED
                  BY THE SIZE PARAMETER, THE PROGRAM MAY ABEND.

             OPT1 IS EITHER 'FULL', 'ASM', OR NOT SPECIFIED (THE
                  DEFAULT).  ACTUALLY, IF THE USER PROVIDES ANY VALUE
                  OTHER THAN 'FULL', OR 'ASM' THEN THE DEFAULT WILL BE
                  ASSUMED.
                  -TYPE=FULL INDICATES THAT ALL BYTES OF THE INPUT
                   RECORD WILL BE USED IN THE COMPARISON.
                  -TYPE=ASM INDICATES THAT THE DEFAULT IGNORE
                   ASSEMBLER DATA WILL BE USED.
                  -IF NOT SPECIFIED THEN THE LAST EIGHT BYTES OF THE
                   RECORD WILL NOT BE COMPARED, AND NO DEFAULT
                   IGNORE DATA WILL BE USED.
                  -PARM='TYPE=FULL,TYPE=ASM' IS A VALID PARAMETER.

             OPT2 IS 'MEM', 'DIR', OR 'NAME'; 'NAME' IS THE DEFAULT
                  VALUE.  PRINT=MEM INDICATES THAT IF ONE PDS CONTAINS
                  A MEMBER, BUT THE OTHER PDS DOES NOT CONTAIN A MEMBER
                  WITH THE SAME NAME, THE  ENTIRE MEM WILL BE LISTED.
                  PRINT=DIR INDICATES THAT THE COMPARISON OF MEMBERS
                  WON'T TAKE PLACE, BUT THE RECAP RPT WILL BE PRODUCED
                  TO SHOW WHICH MEMBERS EXISTS IN EACH PDS.  PRINT=NAME
                  INDICATES THAT UNMATCHED MEMBERS WILL NOT BE PRINTED
                  IN THEIR ENTIRITY, HOWEVER, THEY WILL BE FLAGGED AS
                  UNMATCHED ON THE RECAP REPORT.

      THE 'NEW' AND 'OLD' DD STATEMENTS SHOULD BOTH POINT TO EITHER
      PDS DATASETS OR SEQUENTIAL DATASETS (OR A MEMBER OF A PDS). IF
      THE DATASET TYPES ARE MISMATCHED THEN THE COMPARISON TERMINATES
      WITH A RETURN CODE OF 16.

 **   NOTE: 'COMPAREB' WILL ONLY SHOW THE FIRST PART OF LONG
 **   RECORDS THAT CAUSE MISMATCHES.

      OBVIOUSLY, THIS INFORMATION CAN BE ADAPTED TO THE TSO ENVIRONMENT
      WHERE 'COMPAREB' CAN BE INVOKED WITH THE TSO 'CALL' COMMAND,
      OR AN INSTALLATION-DEPENDENT LINKLIST-CALL COMMAND SUCH AS
      'INVOKE' OR '$'.
//*
//COPP   EXEC  PGM=IEBGENER,COND=(5,LT)
//SYSPRINT DD  SYSOUT=*
//SYSUT2   DD  DSN=SYSGEN.ISPF.PLIB(COMPR#P),DISP=SHR
//SYSIN    DD  *
//SYSUT1   DD  *
)BODY
%---------------------------  File Compare Utility  --------------------
%COMMAND ===>_ZCMD
+
+    Compare two files using %COMPARE+(either PDS or sequential)
+
+    ENTER file1%===>_DSN1
+         VOLSER%===>_VOL1  +  (If not cataloged)
+
+    ENTER file2%===>_DSN2
+         VOLSER%===>_VOL2  +  (If not cataloged)
+
+    Options:
+
+       ALC code%===>_ALC+      %YES+- is Assembler Language Code
+                                      (sequence numbers 73-80)
+                               %NO+ - is not Assembler Language Code
+
+   Print after browsing the report %===>_CMSPRT+     (%Y+or%N+)
+
+   Charge number for print         %===>_CMSCHG  +
)INIT
 .CURSOR = DSN1
 &DSN1   = TRANS (&DSN1 ' ',' ',*,*)
 &DSN2   = TRANS (&DSN2 ' ',' ',*,*)
 &ALC    = TRANS (&ALC ' ',NO,*,*)
 &VOL1   = TRANS (&VOL1 ' ',' ',*,*)
 &VOL2   = TRANS (&VOL2 ' ',' ',*,*)
 &CMSPRT = 'N'
)PROC
 VER (&DSN1,NONBLANK,DSNAME)
 VER (&DSN2,NONBLANK,DSNAME)
 &ALC = TRUNC (&ALC,1)
 VER (&ALC,LIST,N,Y)
 &ALC = TRANS (&ALC Y,YES,N,NO)
 &CMSPRT = TRUNC (&CMSPRT,1)
 VER (&CMSPRT,NB,LIST,Y,N)
 IF (&CMSPRT = 'Y')
    VER (&CMSCHG,NB,NAME)
 &ZSEL = 'CMD(%COMPR#C)'
 VPUT (ALC,CMSPRT,DSN1,DSN2,VOL1,VOL2) SHARED
 VPUT (CMSCHG) PROFILE
)END
//*
//COPC   EXEC  PGM=IEBGENER,COND=(5,LT)
//SYSPRINT DD  SYSOUT=*
//SYSUT2   DD  DSN=SYSGEN.ISPF.CLIB(COMPR#C),DISP=SHR
//SYSIN    DD  *
//SYSUT1   DD  *
PROC 0
 /*--------------------------------------------------------*/
 /*      ISPF/PDF CLIST FOR TSO COMMAND  'COMPARE'         */
 /*--------------------------------------------------------*/
CONTROL NOMSG PROMPT
SET &CMPRPT = CMPLIST1
SET &EFLAG = 0
SET &RTC = 0
ERROR +
   DO
       DO WHILE &EFLAG = 0
           RETURN
       END
       DO WHILE &EFLAG = 2
           SET &EFLAG = 1
           SET &CMPRPT = CMPLIST2
           ALLOC DA('&SYSUID..&CMPRPT') FI(CMPRPT) +
               SP(5,5) CYLINDERS RELEASE USI(T)
           RETURN
       END
       DO WHILE &EFLAG = 5
           SET &RTC = &LASTCC
           IF &RTC < 9 THEN RETURN
           WRITE &EMSG
           RETURN
       END
       DO WHILE &EFLAG ¬= 0
           WRITE &EMSG
           EXIT
       END
   END
ISPEXEC VGET (CMSPRT DSN1 DSN2 ALC VOL1 VOL2)
FREE FI(CMPRPT,OLD,NEW) ATTR(T)
ATTR T RECFM(F B A) BLKSI(19019) LRE(133) BUFN(2)
DELETE ('&SYSUID..CMPLIST1')
DELETE ('&SYSUID..CMPLIST2')
SET &EFLAG = 1
SET &EMSG=&STR(ERROR IN ALLOCATION OF CMPRPT FILE)
CONTROL NOFLUSH
SET &EFLAG = 2
SET &LASTCC = 0
ALLOC FI(CMPRPT) DA('&SYSUID..&CMPRPT') +
     SP(5,5) CYLINDERS RELEASE USI(T)
CONTROL MSG
SET &EFLAG = 5
SET &EMSG=&STR(COMPARE PROGRAM RETURN CODE NON ZERO)
IF &ALC = YES THEN SET &TX = ASM
IF &ALC = NO  THEN SET &TX = NOASM
IF &VOL1 =   THEN SET &V1 =
   ELSE SET &V1 = &STR(OVOLUME(&VOL1))
IF &VOL2 =   THEN SET &V2 =
   ELSE SET &V2 = &STR(NVOLUME(&VOL2))

COMPARE &DSN1 &DSN2 &V1 &V2 &TX OUTFILE(CMPRPT)

CONTROL NOMSG
SET &EFLAG = 0
FREE FI(CMPRPT,NEW,OLD) ATTR(T)
IF &RTC > 4 THEN GOTO DONE
ISPEXEC BROWSE DATASET('&SYSUID..&CMPRPT')
IF &CMSPRT = N THEN GOTO DONE
ISPEXEC VPUT (CMPRPT) SHARED
ISPEXEC FTOPEN TEMP
ISPEXEC FTINCL COMPR#S
ISPEXEC FTCLOSE
ISPEXEC VGET (ZTEMPF)
CONTROL MSG
SUBMIT '&ZTEMPF'
EXIT
DONE:  DELETE ('&SYSUID..&CMPRPT')
EXIT
//*
//COPS   EXEC  PGM=IEBGENER,COND=(5,LT)
//SYSPRINT DD  SYSOUT=*
//SYSUT2   DD  DSN=SYSGEN.ISPF.SLIB(COMPR#S),DISP=SHR
//SYSIN    DD  *
//SYSUT1   DD  DATA
//&ZUSER.C     JOB  (&CMSCHG),&ZUSER,CLASS=A,MSGCLASS=Z
//TMSRPT       EXEC PGM=IEBGENER
//SYSIN        DD   DUMMY
//SYSPRINT     DD   SYSOUT=Z
//SYSUT1       DD   DSN=&ZUSER..&CMPRPT,DISP=(OLD,DELETE)
//SYSUT2       DD   SYSOUT=A
/*
