COMPREC Compare 2 keyed files

Some years ago, there was a discussion about comparing changed files.
The first thing to consider is whether those files have any sequence.
Without sequence, it's a very different problem.
This program assumes sequence, and also drops header and footer records, maybe if the data came from WORD or other "make it pretty" application.
(Yeah, I'm old, and like plane old flat files.)
I came across that, and, to see if anything in the old noggin still worked, wrote it.

Anyone that's interested is more than welcome to try it.
To run this in a real MVS system (it works on Z390) you'll need to fix all the DCBs.
And you probably want to use the openexit for the output files.


AGO .START


C:\USERS\LIN\DOCUMENTS\Z390CODE\COMPREC


SET PA="000,000,000"

SET IN1=C:\USERS\LIN\DOCUMENTS\Z390CODE\COMPREC.IN1.TXT

SET IN2=C:\USERS\LIN\DOCUMENTS\Z390CODE\COMPREC.IN2.TXT

SET ONLY1=C:\USERS\LIN\DOCUMENTS\Z390CODE\COMPREC.ONLY1.TXT

SET ONLY2=C:\USERS\LIN\DOCUMENTS\Z390CODE\COMPREC.ONLY2.TXT

SET SKIP1=C:\USERS\LIN\DOCUMENTS\Z390CODE\COMPREC.SKIP1.TXT

SET SLIP2=C:\USERS\LIN\DOCUMENTS\Z390CODE\COMPREC.SKIP2.TXT

SET PRT=C:\USERS\LIN\DOCUMENTS\Z390CODE\COMPREC.PRT.TXT

BAT\ASMLG C:\USERS\LIN\DOCUMENTS\Z390CODE\COMPREC PARM(%PA%)


.START ANOP

* -----------------------------------------------------------

* MACRO

* &LBL $$LA &R,&F

* AIF ('&F'(1,1) EQ '(').ADD0

* &LBL LA &R,&F

* MEXIT

* .ADD0 ANOP

* &LBL LA &R,0&F

* MEND

* -----------------------------------------------------------

MACRO

D &TXT

LCLA &N

&N SETA (K'&TXT)

&N SETA &N-3

DC AL1(&N),C&TXT

MEND

* -----------------------------------------------------------

MACRO

&LBL ERR &BC,&MSG

AIF ('&BC' NE 'B').REVB

&LBL BAL R14,ERROR

D &MSG

MEXIT

.REVB ANOP

LCLC &L

&L SETC 'SYS&SYSNDX'

&LBL REVB &BC,&L.Z

BAL R14,ERROR

D &MSG

&L.Z DS 0H

MEND

* -----------------------------------------------------------

MACRO

&LABEL REVB &COND,&TO

LCLC &C,&B

LCLA &LEN

AIF ('&COND' NE 'B').ADDREM

&LABEL NOP &TO

MEXIT

.ADDREM ANOP

&LEN SETA K'&COND

AIF ('&COND'(2,1) NE 'N').ADD

&B SETC '&COND'(3,&LEN-2)

AGO .DOIT

.ADD ANOP

&B SETC '&COND'(2,&LEN-1)

&B SETC 'N&B'

.DOIT ANOP

&LABEL B&B &TO

MEND

* -----------------------------------------------------------

COMPREC START 0

YREGS

USING *,13

STM 14,12,12(13)

ST 13,4(15)

ST 15,8(13)

LR 13,15

L R7,0(R1)

LA R2,PRT

BAL R9,OPENOUT

LH R2,0(R7)

SH R2,=H'1'

BM NOPARM

MVC PARM(0),2(R7)

EX R2,*-6

CLC =C'DOC',PARM

BNE BEG

BAL R9,PRINTDOC

MVC PARM,PARM+4

MVI FLAGDOC,C'D'

*

* THIS SECTION PROCESS THE PARM FIELD. EG:

* SKIP=(3,C'HEADER',11,C'FOOTER'),COMPARE=(LOC,LEN,11,2,15,12)

* GETCOMP SAVES THE LOC,LEN PAIRS IN A TABLE.

* GETSKIP SAVES THE LOC + STRING IN A TABLE.

* SKIP= MUST PRECEED COMPARE= IF SKIP IS USED.

* COMPARE=(5,9999) IMPLIES THE LENGTH OF THE SHORTER OF

* THE 2 RECORDS BEING COMPARED.

* THE END OF THE LONGER RECORD IS IGNORED.

* ONLY ACTIVE LENGTH OF BOTH RECORDS ARE USED.

*

BEG LA R6,PARM POINT TO PARM

PUT PRT,PARM-6

SR R2,R2

BEG2 TRT 0(8,R6),FINDEQ FIND = (SKIP= COMP=

ERR BZ,'= MISSING' NOPE, ERR

CLI 1(R1),C'(' SKIP=(

ERR BNE,'( MISSING' NOPE,ERR

CLI 0(R6),C'S' SKIP=

BE GETSKIP YEP

CLI 0(R6),C'C' COMP=

BE GETCOMP YEP

ERR B,'SKIP= COMP= MISSING' NEITHER, ERROR

*

GETCOMP LA R6,2(R1) PASS COPMP=(C'

L R7,ASKIPTBL+4

LTR R7,R7

BP *+8

L R7,=A(DOC)

MVI 0(R7),X'FF'

LA R7,1(R7)

CLI ALOCLEN,0

ERR BE,'ONLY ONE COMP= ALLOWED'

ST R7,ALOCLEN

*

GETCOMPA BAL R14,GETNUM

ST R0,0(R7)

CLI 0(R6),C','

ERR BNE,'LOC,LEN COMMA MISSING'

LA R6,1(R6)

BAL R14,GETNUM

ST R0,4(R7)

LM R14,R15,0(R7)

LA R0,1(R14,R15)

ST R0,8(R7)

CLI FLAGDOC,C' '

BE NTEST2

UNPK LINE+3(9),0(5,R7)

TR LINE+3(8),HEX-240

MVI LINE+11,C' '

UNPK LINE+12(9),4(5,R7)

TR LINE+12(8),HEX-240

MVI LINE+20,C' '

UNPK LINE+21(9),8(5,R7)

TR LINE+21(8),HEX-240

MVI LINE+29,C' '

PUT PRT,LINE

MVC LINE,LINE-1

NTEST2 EQU *

LA R7,12(R7)

MVI 0(R7),X'FF'

ST R7,ALOCLEN+4

CLI 0(R6),C')'

BE OPEN

CLI 0(R6),C','

ERR BNE,'INVALID LOC,LEN ENTRY'

LA R6,1(R6)

B GETCOMPA

*

GETSKIP CLI ALOCLEN,X'FF' Q. COMP= ALREADY DONE?

ERR BNE,'SKIP= MUST PRECEED COMP=' YES,ERR

L R7,=A(DOC)

ST R7,ASKIPTBL

LA R6,2(R1) POINT TO SKIP=(???

GETSKIPL BAL R14,GETNUM

ST R0,0(R7)

CLI 0(R6),C','

ERR BNE,'"," MISSING LOC,"STRING"'


CLI 1(R6),C'C'

ERR BNE,'BAD STRING TYPE'

CLI 2(R6),C''''

ERR BNE,'MISSING QUOTE'

TRT 3(55,R6),FINDQUOT 03,C'ABC',14,C'DEF')

ERR BZ,'STRING LONG OR ERROR'

LA R2,1(R1)

SR R1,R6 C'ABC'

SH R1,=H'4'

ST R1,4(R7)

ERR BM,'STRING LENGTH=0'

GETSKIPM MVC 8(0,R7),3(R6)

EX R1,GETSKIPM

CLI FLAGDOC,C' '

BE NTEST4

UNPK LINE+3(9),0(5,R7)

TR LINE+3(8),HEX-240

MVI LINE+11,C' '

UNPK LINE+12(9),4(5,R7)

TR LINE+12(8),HEX-240

MVI LINE+20,C' '

MVC LINE+21(0),8(R7)

EX R1,*-6

NTEST4 EQU *

LA R7,9(R1,R7)

MVI 0(R7),X'FF'

ST R7,ASKIPTBL+4

LA R6,5(R6,R1)

CLI FLAGDOC,C' '

BE NTEST6

PUT PRT,LINE

MVC LINE,LINE-1

NTEST6 EQU *

CLI 0(R6),C')' ),C=(

BE GETSKIPZ

CLI 0(R6),C','

ERR BNE,') OR , MISSING AFTER SKIP STRING'

LA R6,1(R6)

B GETSKIPL

*

GETSKIPZ CLI 1(R6),C','

ERR BNE,'ERR, "," MISSING'

LA R6,2(R6)

B BEG2

*

GETNUMC TRT 0(7,R6),FINDCOMA

B GETNUM+6

GETNUMP PACK DW,0(0,R6)

GETNUM TRT 0(7,R6),FINDEND

ERR BZ,'PAREN OR COMMA MISSING'

CLI 0(R6),C'0'

ERR BL,'NUMERIC MISSING'

LR R15,R1 123,C'ABC

SR R1,R6

SH R1,=H'1'

EX R1,GETNUMP

TRT 0(0,R6),ISITNUM

EX R1,*-6

ERR BNZ,'NUMERIC ERROR OR MISSING'

CVB R0,DW

SH R0,=H'1'

ERR BM,'00 NOT VALID'

LR R6,R15

BR R14

*

OPEN LA R2,IN1

BAL R9,OPENIN

LA R2,ONLY1FIL

BAL R9,OPENOUT

LA R2,SKIP1

BAL R9,OPENOUT

*

LA R2,IN2

BAL R9,OPENIN

LA R2,ONLY2FIL

BAL R9,OPENOUT

LA R2,SKIP2

BAL R9,OPENOUT

MVC LINE,LINE-1

B MATCH+6

*

MATCH AP #MATCH,P1

BAL R9,GET1

BAL R9,GET2

B COMPARE

*

CLC CLC 0(0,R7),0(R8)

COMPARE L R1,ALOCLEN

*

COMPAREA LM R14,R15,0(R1)

LR R6,R3 LENGTH OF IN1

CR R6,R5 Q. IN2 SHORTER THAN IN1

BNH *+6 NO

LR R6,R5 YES, USE IN2 LENG

*

C R6,8(R1) Q. COMPARE PAST END OF REC?

BNH *+8 NO.

L R6,8(R1) YES, JUST USE LENGTH OF SHORTER REC

*

SR R6,R14 CALC MAX LENG TO CLC=TOT LEN-OFFSER

BCTR R6,0 CALC LENG-1 FOR EXECUTE INST

CR R15,R6 Q. PAST END OF REC?

BNH *+6 NO

LR R15,R6 YES, ONLY USE REC

*

LOADADDF LA R7,0(R2,R14) FIELD TO COMPARE

LA R8,0(R4,R14) IN BOTH RECORDS

*

DOCLC EX R15,CLC

BL ONLY1WRI

BH ONLY2WRI

LA R1,12(R1)

CLI 0(R1),0

BE COMPAREA

B MATCH

*

ONLY2WRI AP #ONLY2,P1

PUT ONLY2FIL,(4)

BAL R9,GET2

B COMPARE

ONLY1WRI AP #ONLY1,P1

PUT ONLY1FIL,(2)

BAL R9,GET1

B COMPARE

*

DROP1 PUT SKIP1,(R2)

AP #SKIP1,P1

GET1 GET IN1

AP #IN1,P1

LA R2,0(R1)

LH R3,DCBLRECL-IHADCB+IN1

LA R6,DROP1

*

TESTSKIP CLI ASKIPTBL,0

BNER R9

L R7,ASKIPTBL

SKIPLOOP LM R14,R15,0(R7) 14=LOC 15=LEN +8=DATA

LA R14,0(R14,R1)

EX R15,SKIPCLC

BER R6 DROP1 (OR 2)

LA R7,9(R7,R15)

CLI 0(R7),0

BE SKIPLOOP

BR R9

SKIPCLC CLC 0(0,R14),8(R7)

*

DROP2 PUT SKIP2,(R4)

AP #SKIP2,P1

GET2 GET IN2

AP #IN2,P1

LA R4,0(R1)

LH R5,DCBLRECL-IHADCB+IN2

LA R6,DROP2

B TESTSKIP

*

DCBLIST DC A(IN1,IN2,ONLY1FIL,ONLY2FIL,SKIP1,SKIP2,0)

*

Z1 TM DCBOFLGS-IHADCB+IN2,DCBOFOPN

BZ TOTALS

LA R2,IN1

BAL R9,CLOSE

EOD1GET GET IN2

LR R2,R1

PUT ONLY2FIL,(2)

AP #ONLY2,P1

B EOD1GET

*

Z2 TM DCBOFLGS-IHADCB+IN1,DCBOFOPN

BZ TOTALS

LA R2,IN2

BAL R9,CLOSE

EOD2GET GET IN1

LR R2,R1

PUT ONLY1FIL,(2)

AP #ONLY1,P1

B EOD2GET

*

DW DC D'0'

FIRST DC H'0'

DATA DC H'0'

LAST DC H'0'

*

#MATCH DC PL5'0',C'MATCHED RECORDS '

#IN1 DC PL5'0',C'IN1 RECS READ '

#IN2 DC PL5'0',C'IN2 RECS READ '

#ONLY1 DC PL5'0',C'IN1 RECS NOT IN IN2'

#ONLY2 DC PL5'0',C'IN2 RECS NOT IN IN1'

#SKIP1 DC PL5'0',C'IN1 RECS SKIPPED '

#SKIP2 DC PL5'0',C'IN2 RECS SKIPPED ',X'FF'

*

EDIT9 DC X'402020206B2020206B212020'

TOTALS LA R7,#MATCH

MVC LINE+1(L'EDIT9),EDIT9

ED LINE+1(L'EDIT9),0(R7)

MVC LINE+2+L'EDIT9(#ONLY2-#ONLY1-5),5(R7)

PUT PRT,LINE

LA R7,#ONLY2-#ONLY1(R7)

CLI 0(R7),X'99'

BNH TOTALS+4

MVC LINE,LINE-1

B Z

**

* OPEN THE FILE IN REG-2 FOR IN/OUT.

* PRINT THE DDNAME AND DCB STUFF.

**

PUSH PRINT

PRINT NOGEN

USING IHADCB,2

OPENIN TM DCBOFLGS,DCBOFOPN

BOR R9

MVC OPENMSG+5(8),DCBDDNAM

MVC OPENMSG+14(3),=C' IN'

OPEN ((2),INPUT)

B OPENMSGL

OPENOUT TM DCBOFLGS,DCBOFOPN

BOR R9

MVC OPENMSG+5(8),DCBDDNAM

MVC OPENMSG+14(3),=C'OUT'

OPEN ((2),OUTPUT)

C R2,=A(PRT)

BNE OPENMSGL

PUT PRT,LINE

MVC LINE,LINE-1

BR R9

OPENMSGL UNPK OPENMSGD+00(3),DCBRECFM(2)

TR OPENMSGD+00(2),OPENMSG-256

MVI OPENMSGD+02,C' '

LH R0,DCBLRECL

CVD R0,16(R13)

OI 23(R13),X'0F'

UNPK OPENMSGD+09(5),21(3,R13)

LH R0,DCBBLKSI

CVD R0,16(R13)

OI 23(R13),X'0F'

UNPK OPENMSGD+23(5),21(3,R13)

**

MVC LINE+1(L'OPENMSG+L'OPENMSGD),OPENMSG

PUT PRT,LINE

MVC LINE,LINE-1

BR R9

CLOSE TM DCBOFLGS-IHADCB(R2),DCBOFOPN

BZR R9

CLOSE ((2))

TM DCBOFLGS-IHADCB+PRT,DCBOFOPN

BZR R9

MVC LINE+1(8),DCBDDNAM

MVC LINE+10(6),=C'CLOSED'

PUT PRT,LINE-1

MVC LINE+1(16),LINE

BR R9

DROP 2

POP PRINT

**

DC C'0123456789ABCDEF' HEX CHARS FOR RECFM

**

OPENMSG DC C'OPEN ........ OUTPUT, RECFM='

OPENMSGD DC C'XX LRECL=..... BLKSIZE=.... '

**

MVC LINE+1(0),1(R7)

MVC LINE+1(0),LINE

PRINTDOC L R7,=A(DOC)

SR R3,R3

IC R3,0(R7)

EX R3,PRINTDOC-12

PUT PRT,LINE

EX R3,PRINTDOC-6

LA R7,2(R7,R3)

CLI 0(R7),C'9'

BNH PRINTDOC+6

BR R9

*

NOPARM OI RC,4

LA R6,PARM+44

ERR B,'PARM MISSING'

ERROR OI RC,8

LA R3,0(R14)

LR R0,R3

SR R0,R13

MVC LINE+1(11),=C'ERR (....) '

ST R0,DW

UNPK LINE+6(5),DW+2(3)

TR LINE+6(4),HEX-240

MVI LINE+10,C')'

SR R1,R1

IC R1,0(R3)

MVC LINE+12(0),1(R3)

EX R1,*-6

LA R1,LINE+16(R1)

MVC 0(8,R1),0(R6)

PUT PRT,LINE

MVC LINE,LINE-1

*

Z LA R3,DCBLIST

L R2,0(R3)

ZCLOSE BAL R9,CLOSE

LA R3,4(R3)

L R2,0(R3)

LTR R2,R2

BNZ ZCLOSE

*

MVC LINE,LINE-1

TIME DEC

STM R0,R1,DW

MVC LINE(L'EDITIME),EDITIME

ED LINE(6),DW

ED LINE+7(7),DW+5

MVC LINE+16(16),=C'COMPREC FINISHED, '

*

* UNPK LINE+2(9),DW(5)

* UNPK LINE+12(9),DW+4(5)

* TR LINE+2(9),HEX-240

* TR LINE+12(9),HEX-240

* MVI LINE+10,C' '

* PUT PRT,LINE

* MVC LINE,LINE-1

* MVC LINE,LINE-1

* MVC LINE+(20),=C'COMPREC FINISHED, '

* MVC LINE+20(L'EDITIME),EDITIME

* ED LINE+20(7),DW+1

* ED LINE+28(6),DW+4

PUT PRT,LINE-1

LA R2,PRT

BAL R9,CLOSE

SR 15,15

IC 15,RC

L 13,4(13)

L 14,12(13)

LM 0,12,20(13)

BR 14

LTORG

EDITIME DC X'4021207A2020404021204B202020'

*DITIME DC X'402120202020202020'

RC DC X'00'

P1 DC X'1F'

FLAGDOC DC C' '

HEX DC C'0123456789ABCDCEF'

DC C' PARM='

PARM DC CL133' '

LINE DC CL133' COMPREC, V01.01, ASM &SYSDATE AT &SYSTIME, COMPARE

E TWO SEQUENCED FILES, PARM=DOC FOR DESCRIPTION'

*

* ORG *-240

* ISIT### EQU *

* ORG

*

ISITNUM EQU *-240

DC 10X'00',6C' '

*

OPENX DC 0F'0',X'85',AL3(OPENX+4)

CLI DCBRECFM-IHADCB(1),0 Q. BLANK DCB?

BNE 0(14) NO, JUST RETURN.

MVC DCBRECFM-IHADCB(1,1),DCBRECFM-IHADCB+IN1

MVC DCBLRECL-IHADCB(2,1),DCBLRECL-IHADCB+IN1

BR 14

PUSH PRINT

PRINT NOGEN

IN1 DCB DDNAME=IN1,DSORG=PS,LRECL=133,EODAD=Z1,MACRF=GL,RECFM=FT

IN2 DCB DDNAME=IN2,DSORG=PS,LRECL=133,EODAD=Z2,MACRF=GL,RECFM=FT

ONLY1FIL DCB DDNAME=ONLY1,DSORG=PS,LRECL=133,RECFM=FT,MACRF=PM

* EXLST=OPENX

ONLY2FIL DCB DDNAME=ONLY2,DSORG=PS,LRECL=133,RECFM=FT,MACRF=PM

* EXLST=OPENX

SKIP1 DCB DDNAME=SKIP1,DSORG=PS,LRECL=133,RECFM=FT,MACRF=PM

* EXLST=OPENX

SKIP2 DCB DDNAME=SKIP2,DSORG=PS,LRECL=133,RECFM=FT,MACRF=PM

* EXLST=OPENX

PRT DCB DDNAME=PRT,DSORG=PS,LRECL=133,RECFM=FT,MACRF=PM

*

POP PRINT

*

* DCB DDNAME=IN,DSORG=PS,DEVD=DA,MACRF=GL,BLKSIZE=32767,RECFM=U,EODAD=Z

*UT DCB DDNAME=OUT,DSORG=PS,DEVD=DA,LRECL=110,RECFM=FB,MACRF=PM

*

ASKIPTBL DC 3F'-1'

ALOCLEN DC 3F'-1'

DC XL64'00'

FINDSPAC DC XL64'00'

TRTTABLE DC C' ',XL191'00'

FINDEQ EQU TRTTABLE-C'='

FINDCOMA EQU TRTTABLE-C','

FINDQUOT EQU TRTTABLE-C''''

FINDSEMI EQU TRTTABLE-C';'

FINDRPAR EQU TRTTABLE-C')'

*

FINDEND EQU *-C')'

DC C')',XL160'00'

* ORG FINDEND+C')'

* DC C')'

ORG FINDEND+C','

DC C','

ORG

*

* FIND DC XL64'00',AL1(4),XL191'00'

* ORG FIND+C','

* DC AL1(8)

* ORG FIND+C'='

* DC AL1(12)

* ORG FIND+C''''

* DC AL1(16)

* ORG FIND+C')'

* DC AL1(20)

* ORG

*

DOC EQU *

D 'COMPARE 2 SEQUENCED FILES, SKIPPING HEADER AND FOOTER RECORDS.'

D 'PARM TELLS WHICH RECORDS TO SKIP, AND WHERE SEQUENCE FIELDS ARE.'

D 'EG, PARM="SKIP=(5,C"HEADER",56,"PAGE"),COMPARE=(12,5,5,6)"'

D 'SKIP THE RECORDS WITH THE CHAR STRINGS SPECIFIED, AND COMPARE KEYS'

D 'AT THE LOCATIONS, FOR THE LENGTHS, SPECIFIED. THE RDW/LLBB FOR'

D 'RECFM=VB IS COUNTED, SO FIRST DATA BYTE IS "5" COMPARE IS ONLY'

D 'DONE FOR THE LENGTH OF THE SHORTER RECORD, IF ONE IS SHORTER.'

D ' '

D 'JCL TO COMPARE ALL BYTES (EXCLUDING THE RDW/LLBB) MIGHT BE:'

D ' '

D '//COMPARE EXEC PGM=COMPREC,PARM="S=(77,C"PAGE"),C=(5,6,11,9999)"'

D '//STEPLIB DD DISP=SHE,DSN='

D '//PRT DD SYSOUT=*'

D '//IN1 DD DISP=SHR,DSN='

D '//IN2 DD DISP=SHR,DSN='

D '//ONLY1 DD SYSOUT=* RECORDS NOT IN //IN2'

D '//ONLY2 DD SYSOUT=* RECORDS NOT IN //IN1'

D '//SKIP1 DD SYSOUT=* HEADER/FOOTER RECORDS FROM //IN1'

D '//SKIP2 DD SYSOUT=* HEADER/FOOTER RECORDS FROM //IN2'

D ' '

DC X'FF'

*

* DCBD DEVD=DA

*

@@PAD#1 EQU ((*-COMPREC)/4096+1)*4096

@@PAD#2 EQU @@PAD#1-(*-COMPREC)

ORG *+@@PAD#2

*

END COMPREC