There was a forum that I sometimes watch that had a 3 day exchange about
why 2 files that looked alike, wouldn't compare. In fact, when I was working,
compare programs were generally pretty terrible. There wasn't much flexibility
at all. Having more time on my hands than is reasonable, I wrote this.
It's been 15 years or so since I worked, and this is almost entirely from memory.
It does seem to work now.
If I had files that didn't compare, the first thing I'd do is run it with the "LISTBYTE"
option, that identifies which specific bytes don't match. It stops after 9 records
that don't match, but that is a control parameter option.
I expect that looking at the report would give me a pretty good idea what I need to do
to get a good compare run. There's internal documentation on how to use it.
MACRO
&L TRACE
.* &L DS 0H One could assemble the program using this
.* To make it shorter, and run faster.
.* MEXIT
.*
&L CLI FLAGTRAC,C' '
BE SYS&SYSNDX+12
STM R14,RETREG,TRACSAVE
BAL R14,TRACE
SYS&SYSNDX DC CL8'&L'
LM R14,RETREG,TRACSAVE
MEND
* --------------------------------------------------
MACRO
&L PUTOPEN &DCB,&REC
&L LA 1,&DCB
TM DCBOFLGS-IHADCB(1),DCBOFOPN
BZ SYS&SYSNDX
PUT (1),&REC
SYS&SYSNDX EQU *
MEND
* --------------------------------------------------
* THIS MSG NEEDS TO BE EXPANDED INLINE BECAUSE IT'S
* MODIFIED IN AT LEAST ONE USE.
*
* --------------------------------------------------
MACRO
&L ER3 &B,&N,&STR
&L REVB &B,SYS&SYSNDX
STM R14,R6,ERR01RGS
BAL R15,ERR01
DC H'&N',AL2(L'SYS&SYSNDX.C-1)
SYS&SYSNDX.C DC C&STR
AIF ('&B' EQ '').Z
SYS&SYSNDX DS 0H
.Z MEND
* --------------------------------------------------
MACRO
&L REVB &B,&TO
LCLC &C
AIF ('&B' EQ 'B').Y
AIF ('&B'(2,1) EQ 'N').N
&C SETC '&B'(2,3)
&L BN&C &TO
MEXIT
.N ANOP
&C SETC '&B'(3,3)
&L B&C &TO
MEXIT
.Y AIF ('&L' EQ '').Z
&L DS 0H
.Z MEND
* --------------------------------------------------
MACRO
&L PARMMSG2 &COND,&STR,&FIELD
LCLA &B
&B SETA K'&STR-3
&L REVB &COND,SYS&SYSNDX
LA R1,=C&STR
LA R15,&B
AIF ('&FIELD' EQ '').M
LA R0,&FIELD
AGO .BAL
.M SR R0,R0
.BAL BAL R14,PARMMSG
AIF ('&COND' EQ 'B').Z
SYS&SYSNDX DS 0H
.Z MEND
* --------------------------------------------------
* MACRO
* &L PARMMSG &COND,&STR,&FIELD
* LCLA &B
* &B SETA K'&STR-2
* &L REVB &COND,SYS&SYSNDX
* OI RC,16
* AIF ('&FIELD' EQ '').M
* MVC LINE(20),&FIELD
* MVC LINE+22(&B),=C&STR
* AGO .P
* .M MVC LINE(&B),=C&STR
* .P PUT SYSPRINT,LINE-1
* MVC LINE,LINE-1
* B GETSYSIN
* AIF ('&COND' EQ 'B' AND '&L' EQ '').Z
* SYS&SYSNDX DS 0H
* .Z MEND
* --------------------------------------------------
MACRO
&L MSG &STR
LCLA &B
&B SETA K'&STR-2
&L MVC LINE(&B),=C&STR
PUT SYSPRINT,LINE-1
MVC LINE(&B),LINE-1
MEND
* --------------------------------------------------
MACRO
&L QTIOT
&L L 1,16 16 -> THIS SHOULD BE THE CVT
L 1,0(1) PSATNEW LOC 536 (X218)
.* L 1,536 CURRENT TCB
L 1,0(1) CURRENT TCB
L 1,12(1) AND THE CURRENT TIOT
MEND
* --------------------------------------------------
*
BEVERLY START 0 PROGRAM TO COMPARE 2 FILES,
R0 EQU 0 EXCLUDING SPECIFIED RECORDS.
R1 EQU 1
R2 EQU 2
R3 EQU 3
R4 EQU 4
R5 EQU 5
R6 EQU 6
RETREG EQU 7 THIS CAN BE ANY UNUSED REG. I USED 9 AT FIRST.
* 7 MADE THE TRACE REG PRINT EASIER.
* BUT THAT'S EASILY CHANGE-ABLE.
*9 EQU 9 HAVEN'T USED 8+9 YET.
R13 EQU 13
R14 EQU 14
R15 EQU 15
*
USING *,13,12,11,10 YEAH, IT GOT STUPIDLY LONG.
B SAVE-BEVERLY(15)
DC 17F'0'
VER## DC C'BEVERLY, VER 01.16F ASSEMBLED &SYSDATE AT &SYSTIME, RUN'
RUN## DC X'4021204B20202040C1E34021207A202040' 7A2020'
DC C' PARM=DOC PRINTS DESCRIPTION'
VER##L EQU *-VER##
*
SAVE STM 14,12,12(13)
ST 13,4(15)
ST 15,8(13)
LA 13,0(15)
LA 9,4095
LA 12,1(9,13)
LA 11,1(9,12)
LA 10,1(9,11)
MVC SAVE(4),LINE
*
L R4,0(R1) SAVE PARM FIELD ADDR
LH R14,0(R4)
SH R14,=H'1'
BM *+14
MVC PARM(0),2(R4)
EX R14,*-6
*
TIME DEC THIS SECTION PUTS THE RUN
STM R0,R1,DW TIME + DATE INTO THE TITLE
ED RUN##(7),DW+5 LINE. I'LL PUT THE JOBNAME
ED RUN##+10(6),DW STEPNAME THERE TOO, WHEN I
MVI RUN##+L'RUN##-1,C' ' REMEMBER HOW TO DO THAT.
*
QTIOT
MVC LINE+46(8),0(R1) THIS SECTION PUTS THE JOBNAME,
MVC LINE+56(8),16(R1) STEPNAME, PROCSTEPNAME ON THE
MVC LINE+66(8),08(R1) REPORT. MAKES TESTING EASIER.
MVI LINE+75,C'='
MVC LINE+76(32),LINE+75 AND, OF COURSE, THE SEPARATOR LINE.
*
L R14,=A(TRTTBL-C' ') HERE WE TAKE THE SPACES OUT
LA R1,LINE+66 OF JOBNAME, STEPNAME, ETC.
TRT LINE+67(9),0(R14) (AND ADD SPACE IF THEY'RE 8 BYTES.)
MVC 1(09,R1),LINE+75 MAKES IT LOOK PRETTY.
LA R1,LINE+56 BUT EASIER TO READ AS WELL.
TRT LINE+56(9),0(R14)
MVC 1(19,R1),LINE+66 THIS GETS PRINTED AS PART OF THE
LA R1,LINE+47 SYSPRINT OPEN MESSAGE,
TRT LINE+46(9),0(R14) WHEN WE OPEN THE FILE.
MVC 1(29,R1),LINE+56
*
LA R2,SYSPRINT
MVI OPENFLAG,C'O'
BAL RETREG,OPEN
* OPEN (SYSPRINT,OUTPUT)
MVC LINE(VER##L),VER##
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
*
CLI PARM,C' '
BE NOPARM
PUT SYSPRINT,PARM-8
*
NOPARM MVC LINE(166),LINE-1
LA R2,SYSIN
MVI OPENFLAG,C'I'
BAL RETREG,OPEN
CLC =C'DOC',PARM
BNE SKIPDOC
*
MXE EQU (ENDDOC-DOC-80)/80 THIS SECTION CALCULATES THE
LA R0,MXE MAXIMUM NUMBER OF EXCLUDE=
L R1,=A(DOC#EXCL) RECORDS THAT WILL FIT INTO
CVD R0,DW THE DOCUMENTATION SECTION.
OI DW+7,X'0F' WE USE THAT AS OUR TABLES,
UNPK 0(3,R1),DW+6(2) FOR EXCLUDE, SKIPA= + SKIPB=
*
BAL RETREG,PRINTDO
MVC PARM,PARM+3
*
SKIPDOC CLC =C'TRACE',PARM+1
BNE *+8
MVI FLAGTRAC,C'T'
CLC =C'TRACE',PARM
BNE *+8
MVI FLAGTRAC,C'T'
*
NOPRT TRACE
MVI DOC,X'FF' INDICATE THERE ARE NO EXCLUDE= RECS
CLI PARM,C' '
BE NOMORPAR
CLI PARM,C';'
BE NORMDLM
CLI PARM,C'A'
BL NEWDLM
MVC LINE,LINE-1
MSG 'PARM='';KEY;.... ";" MISSING FROM BEGINNING OF PARM, NO
ORMAL ";" DELIMITER USED.'
B NORMDLM
* ---------------------------------------------------------------------
* HERE, WE REPLACE ALL THE CLI INSTRUCTIONS THAT SCAN FOR THE
* PARM DELIMITER.
*
* ---------------------------------------------------------------------
NEWDLM TRACE
MVC CLIDLM1+1(1),PARM
MVC CLIDLM2+1(1),PARM
MVC NDLMMSG+36(1),PARM
PUT SYSPRINT,NDLMMSG
*
NORMDLM TRACE
CLI PARM,C' '
BE NOMORPAR
CLIDLM1 CLI PARM,C';'
BE PARMQ08
MVC PARM,PARM-1
PARMQ08 LA R0,99
LA R1,PARM
PARMQ10 TRACE
LA R1,1(R1)
CLIDLM2 CLI 0(R1),C';'
BE PARMQ15
CLC 0(33,R1),LINE
BE PARMQ15
BCT R0,PARMQ10
PARMMSG2 B,'STRING ENDING DELIM NOT FOUND',PARM
PARMQ15 TRACE
LR R14,R1
S R14,=A(PARM+2)
MVC CARD,CARD-1
MVC CARD(0),PARM+1
EX R14,*-6
MVC PARM,0(R1)
LA R1,CARD
B GOTSYSIN
*
PRINTDO TRACE
L R2,=A(DOC)
MVC 0(19,R2),VER##
PRINTDOC MVC LINE(64),0(R2) FIRST PRINT PROGRAM DESCRIPTION
PUT SYSPRINT,LINE-1
LA R2,64(R2)
C R2,=A(ENDDOC-60)
BL PRINTDOC
MVC LINE,LINE-1
BR RETREG
*
PARAMTBL DC A(7,FLAGEXCL,0,0,0),CL8'LISTEXCL'
LPARAM EQU *-PARAMTBL
DC A(7,FLAGBYTE,0,0,0),CL8'LISTBYTE'
DC A(6,FLAGLIST,0,0,0),CL8'LISTERR'
DC A(6,FLAGHEX,0,0,0),CL8'LISTHEX'
DC A(7,FLAGNAME,0,0,0),CL8'LISTNAME'
DC A(4,FLAGTRAC,0,0,0),CL8'TRACE'
DC A(5,FLAGTABL,0,0,0),CL8'TABLES'
DC A(5,0,MAXIN,0,0),CL8'MAXIN='
DC A(6,0,MAXERR,0,0),CL8'MAXERR='
DC A(7,0,0,OFFSETAB,0),CL8'OFFSETA='
DC A(7,0,0,OFFSETAB+4,0),CL8'OFFSETB='
DC A(7,0,0,LISTLEN,0),CL8'LISTLEN='
DC A(3,0,0,0,KEY),CL8'KEY='
DC A(6,KEYSEQCK,0,0,0),CL8'KEYSEQCK'
DC A(7,0,0,0,COMPCC),CL8'COMPARE='
DC A(7,0,0,0,PARMEX),CL8'EXCLUDE='
DC A(2,0,0,0,PARMEX),CL8'EX='
DC A(3,0,0,0,PARMSKIP),CL8'SKIP'
DC X'FF'
*
PARAMCLC CLC CARD(0),20(R14)
GETPARAM TRACE
LA R14,PARAMTBL
CLC =C'PRINT',CARD
BNE PARAMLOP
MVC CARD,CARD+1
MVC CARD(4),=C'LIST'
*
PARAMLOP TRACE
L R15,0(R14)
EX R15,PARAMCLC
BE PARAMYES
LA R14,LPARAM(R14)
CLI 0(R14),0
BE PARAMLOP
PARMMSG2 B,'INVALID KEYWORD',CARD
*
PARAMYES TRACE
LM R1,R5,0(R14)
LTR R5,R5
BNZR R5
*
LTR R2,R2 DO WE HAVE TO SET FLAG
BZ PARAM# NO.
MVC 0(1,R2),CARD YES, SET IT
LA R14,CARD+1(R15)
CLI 0(R14),C'='
BNE PARAME
MVC 0(1,R2),1(R14)
CLI 2(R14),C' '
LA R14,2(R14)
PARAME CLI 0(R14),C' '
BE GETSYSIN
PARMMSG2 B,'INVALID SYNTAX ON SYSIN CARD',0(R14)
*
PARAM# LA R14,CARD
CLI 0(R14),C'='
LA R14,1(R14)
BH *-8
PARMMSG2 BNE,'INVALID NUMERIC SYNTAX FOR PARAM=123',0(R14)
BAL RETREG,GETNUM
LTR R3,R3
BNZ PARAMPAK
PARAMBIN LTR R4,R4
PARMMSG2 BZ,'LOGIC ERROR IN PARAM TABLE, TYPE NOT FOUND',0(R14)
CVB R0,DW
ST R0,0(R4)
B GETSYSIN
PARAMPAK ZAP 0(8,R3),DW
LTR R4,R4
BNZ PARAMBIN
B GETSYSIN
*
PACK DW,0(0,R14)
GETNUM TRACE
CLI 0(R14),C'0' R14 POINTS TO A #.
PARMMSG2 BL,'FIELD NOT NUMERIC',0(R14)
LR R15,R14
LA R15,1(R15) R14 TO THE NEXT NUMBER,
CLI 0(R15),C'0'
BNL *-8
CLI 0(R15),C' '
BE GETNUM4
CLI 0(R15),C','
PARMMSG2 BNE,'END OF # NOT FOLLOWED BY COMMA OR BLANK',0(R15)
GETNUM4 ST R15,12(13)
SR R15,R14
BCTR R15,0
EX R15,GETNUM-6
L R14,12(13)
LA R14,1(R14) POINT TO NEXT #
BR RETREG
*
KEY LA R14,CARD+4
LA R1,$$KEYLOC
B COMPCC1
*
COMPCC TRACE
LA R14,CARD+8 ,8(R1)
LA R1,$$COMPAR
*
COMPCC1 TRACE
BAL RETREG,GETNUM
CVB R0,DW
SH R0,=H'1'
PARMMSG2 BM,'NUMERIC FIELD LENGTH CANNOT BE 0',0(R14)
ST R0,0(R1)
BAL RETREG,GETNUM
CVB R0,DW
SH R0,=H'1'
PARMMSG2 BM,'KEY LENGTH CANNOT BE 0. CODE 99999 FOR REST OF RECORD'
ST R0,4(R1)
LA R1,8(R1)
MVI 0(R1),X'FF'
CLI 0(R14),C'0'
BNL COMPCC1
CLI 0(R14),C' '
BE GETSYSIN
PARMMSG2 B,'INVALID COMPARE= REQUEST.',0(R14)
*
GETSYSIN TRACE
CLI PARM,C' ' ARE WE GETTING STUFF FROM PARM=
BNE NORMDLM
NOMORPAR TRACE
TM DCBOFLGS-IHADCB+SYSIN,DCBOFOPN
BZ NOSYSIN
*
MVC CARD,CARD-1
GET SYSIN NEXT LOOK AT SYSIN CONTROL CARDS.
MVC CARD,0(R1)
GOTSYSIN TRACE
PUT SYSPRINT,CARD-1
CLI CARD,C'*'
BE GETSYSIN
CLC CARD(4),LINE
BE GETSYSIN
LA R1,CARD
*
BAL RETREG,GETPARAM
EX 0,*
*
PARMEX TRACE
CLI $$ASKIP,X'FF'
BNE PARMEX0
CLI $$BSKIP,X'FF'
PARMEX0 PARMMSG2 BNE,'ALL EX= RECORDS MUST PRECEED SKIP RECS'
*
LA R14,CARD+8
CLC =C'EXCLUDE=',CARD EXCLUDE REQUEST?
BE PARMEX2
LA R14,CARD+3
CLC =C'EX=',CARD
BE PARMEX2
EX 0,*
*
PARMEX2 TRACE
MVC CARD,0(R14)
LA R14,CARD
L R2,$$EXCLUD+4 EX=LOC,LEN,#,TEXT
CLI $$EXCLUD+4,0 Q. FIRST TIME?
BE PARMEX3 NO, OKAY
L R2,$$DOCADR YES, START AT BEG OF DOC
ST R2,$$EXCLUD
*
PARMEX3 TRACE
LA RETREG,80(R2)
C RETREG,=A(ENDDOC-160)
PARMMSG2 BNL,'TOO MANY EXCLUDE= REQUESTS'
MVI 0(RETREG),X'FF'
ST RETREG,$$EXCLUD+4
ST RETREG,$$DOCADR YES, START AT BEG OF DOC
XC 0(80,R2),0(R2)
SR R3,R3
BAL RETREG,GETNUM
CVB R0,DW GET # RECORDS TO SKIP
SH R0,=H'1' CALC LOCION OFFSET
PARMMSG2 BM,'EX= LOC= CANNOT BE 0',0(R14)
ST R0,0(R2)
PARMEX4 TRACE
*
CLC =C'C''',0(R14)
BE EXCLCHAR
CLC =C'X''',0(R14)
BE EXCLCHAR
CLC =C'C"',0(R14)
BE EXCLCHAR
CLC =C'X"',0(R14)
BE EXCLCHAR
*
PARMEXR TRACE
BAL RETREG,GETNUM GOT LOC, GET LENGTH
CVB R0,DW
SH R0,=H'1' CALC LOC-1
PARMMSG2 BM,'EX= LENGTH CANNOT BE 0',0(R14)
ST R0,4(R2)
*
BAL RETREG,GETNUM GET # RECORDS TO DROP
CVB R0,DW
SH R0,=H'1' CANNOT DROP 0 RECORDS.
PARMMSG2 BM,'EX= DROP# CANNOT BE 0',0(R14)
ST R0,8(R2)
*
MVC 12(70,R2),0(R14)
EXCDONE TRACE
* L R14,$$EXCLUD+4
* C R14,=A(ENDDOC-80)
* PARMMSG2 BNL,'TOO MANY EXCLUDE= REQUESTS'
* MVI 0(R14),X'FF'
* XC 0(12,R14),0(R14)
B GETSYSIN
*
EXCLCHAR TRACE
LA R15,1(R14)
LA R0,70
EXCLCH01 LA R15,1(R15)
CLC 0(1,R15),1(R14)
BE EXCLCH03
BCT R0,EXCLCH01
PARMMSG2 B,'EXCLUDE CHAR STRING TOO LONG',0(R14)
*
EXCLCH03 TRACE
LR R5,R15
LR R1,R15
SR R15,R14
SH R15,=H'3' C'ABC'
PARMMSG2 BM,'LOGIC ERR, STRING LENGTH 0',0(R14)
CLI 0(R14),C'X'
BE EXCLCH20
MVC 12(0,R2),2(R14)
EX R15,*-6
ST R15,4(R2)
*
EXCLCH05 TRACE
CLI 1(R5),C' '
BE EXCDONE
CLC =C',DROP=',1(R5)
PARMMSG2 BNE,'ONLY DROP= CAN FOLLOW EX=(#,C"???"),DROP=#',0(R1)
LA R14,7(R5)
BAL RETREG,GETNUM
CVB R0,DW
SH R0,=H'1'
PARMMSG2 BM,'DROP=## FIELD CANNOT BE 0',0(R1)
ST R0,8(R2)
B EXCDONE
* ---------------------------------------------------------------------
* THIS SECTION CONVERTS EX=#,X'C1C2C3' TO CHATACTER FORMAT.
* FIRST CHECK TO SEE THAT IT REALLY IS ALL HEX.
* THEN MAKE EACH CHAR A HEX DIGIT.
* FINALLY, PACK 1 PAIR OF HEX DIGITS AT A TIME.
*
* ---------------------------------------------------------------------
TRT 2(0,R14),TESTHEX
TR 2(0,R14),CONVHEX
*
EXCLCH20 TRACE
LR R0,R15
N R0,=F'1'
PARMMSG2 BZ,'HEX STRING MUST BE EVEN # OF CHARS',0(R14)
EX R15,EXCLCH20-12
PARMMSG2 BNZ,'HEX STRING CONTAINS NON HEX CHARS',0(R14)
EX R15,EXCLCH20-6
LA R15,1(R15)
SRL R15,1
LR R0,R15
BCTR R0,0
ST R0,4(R2)
LA R1,12(R2)
EXCLCH25 TRACE
PACK 0(2,R1),2(3,R14)
LA R1,1(R1)
LA R14,2(R14)
BCT R15,EXCLCH25
B EXCLCH05
* --------------------------------------------------------------------
* THIS SECTION SETS UP THE SKIP TABLE.
* YOU CAN SKIP SPECIFIC RECORDS, BY RECORD # IN THE FILE.
* YOU'D DO THIS IF YOU KNEW THAT A SPECIFIC RECORD CAUSED A PROBLEM
* WITH THE COMPARE.
*
* THE RECORDS TO SKIP ARE KEPT AS 8 BYTE PACKED DECIMAL NUMBERS.
* THERE ARE BEGINNING AND ENDING ADDRESSES FOR BOTH TABLES.
* THE TABLES ARE KEPT OVERLAYING THE DOCUMENTATION, AT THE END,
* WHICH HAS ALREADY BEEN PRINTED.
*
* THE DOC CONTAINS SKIPA=/SKIPB= ENTRIES.
* AND THE EXCLUDE= TABLE ENTRIES.
* CONTROL CARD ORDER MUST BE:
* SKIPA= THEN SKIPB= THEN EXCLUDE= IN THAT ORDER.
*
* --------------------------------------------------------------------
*
$$ASKIP DC 2F'-1'
$$BSKIP DC 2F'-1'
*
PARMSKIP LA R14,CARD+6
*
LA R3,$$ASKIP
CLC CARD+4(2),=C'A='
BE PARMSKIA
LA R3,$$BSKIP
CLC CARD+4(2),=C'B='
BE PARMSKIB
PARMMSG2 B,'SKIPA=/SKIPB= SYNTAX ERROR',CARD
*
PARMSKIA CLI $$BSKIP,X'FF'
PARMMSG2 BNE,'CANNOT CODE SKIPA= AFTER SKIPB='
PARMSKIB L R4,4(R3)
CLI 0(R3),0
BE PARMSKI#
L R4,$$DOCADR
LA R4,4(R4)
ST R4,0(R3)
PARMSKI# BAL RETREG,GETNUM
MVC 0(8,R4),DW
LR R1,R4
LA R4,8(R4)
ST R4,4(R3)
ST R4,$$DOCADR
C R1,0(R3)
BE PARMSKIE
SH R1,=H'8'
CLC 0(8,R1),DW
PARMMSG2 BNL,'SKIP@= REC #S MUST BE IN SEQUENCE'
PARMSKIE MVI 0(R4),X'FF'
C R4,=A(ENDDOC-9)
PARMMSG2 BNL,'TOO MANY EXCLUDE + SKIP RECORDS, TBL OVERFLOW'
CLI 0(R14),C' '
BE GETSYSIN
CLI 0(R14),C'0'
BNL PARMSKI#
PARMMSG2 B,'SYNTAX ERROR ON SKIPA/B= REQ, CAN ONLY HAVE RECORDX
NUMBERS',0(R14)
*
* --------------------------------------------------------------------
* THIS SECTION DOES ALL THE FILE OPENS, BOTH INPUT AND OUTPUT.
* IT LISTS DDNAMES THAT ARE NOT FOUND.
* AND IT STORES DCB ADDRESSES FOR THE OPEN-EXIT TO USE.
*
* --------------------------------------------------------------------
USING IHADCB,2
OPEN TRACE
MVC LINE(8),DCBDDNAM
DEVTYPE LINE,DW+8 CHECK FOR DDNAME
LTR R15,R15 Q. IS THE FILE THERE?
BZ OPENOPEN
MVC LINE+9(9),=C'NOT FOUND'
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
LA R15,12
BR RETREG NO, JUST RETURN.
OPENOPEN TRACE
CLI OPENFLAG,C'I' YES, OPEN AND LIST STUFF.
BE OPENIN
CLI OPENFLAG,C'O' YES, OPEN AND LIST STUFF.
BE OPENOUT
* MSG 'LOGIC ERR, OPENFLAG NOT I/O'
EX 0,*
*
OPENOUT TRACE
STM R2,R3,EXITSAVE YES, OPEN AND LIST STUFF.
OPEN ((2),OUTPUT) YES, OPEN AND LIST STUFF.
B OPENPRT
OPENIN TRACE
*
C R2,=A(SYSIN) SYSIN?
BE OPEN2 YES, SKIP IT.
ST R2,RDJFCB+4
OI RDJFCB+4,X'80'
RDJFCB RDJFCB (2)
*
OPEN2 OPEN ((2),INPUT) YES, OPEN AND LIST STUFF.
* --------------------------------------------------------------------
* THIS SECTION PRINTS LRECL, BLKSIZE AND RECFM OF FILES,
* AND THE DSNAME OF THE INPUT FILES.
* RDJFCB GETS THE JFCB THAT CONTAINS NAME AND MEMBER NAME.
*
* --------------------------------------------------------------------
OPENPRT TRACE
MVC LINE+9(34),=C'RECFM=. LRECL=##### BLKSIZE=#####'
LH R0,DCBLRECL
CVD R0,DW
OI DW+7,X'0F'
UNPK LINE+25(5),DW+5(3)
*
LH R0,DCBBLKSI
CVD R0,DW
OI DW+7,X'0F'
UNPK LINE+39(5),DW+5(3)
*
TM DCBRECFM,X'80'
BNO *+8
MVI LINE+15,C'F'
TM DCBRECFM,X'40'
BNO *+8
MVI LINE+15,C'V'
TM DCBRECFM,X'10'
BNO *+8
MVI LINE+16,C'B'
*
TM DCBRECFM,X'04'
BNO *+8
MVI LINE+17,C'A'
TM DCBRECFM,X'02'
BNO *+8
MVI LINE+17,C'M'
*
CLI OPENFLAG,C'I' INPUT FILE?
BNE OPEN9 NO, SKIP IT.
C R2,=A(SYSIN) SYSIN?
BE OPEN9 YES, SKIP IT.
* NO, SHOW FILEA/FILEB DSNAME.
MVC LINE+46(4),=C'DSN=' NO, SHOW FILEA/FILEB DSNAME.
MVC LINE+50(44),JFCB NO, SHOW FILEA/FILEB DSNAME.
CLI JFCB+44,C' ' IS THERE A MEMBER NAME?
BNH OPEN9 NO, GO PRINT.
LA R1,LINE+52 YES, SCAN TO FIND END OF DSN
LA R1,1(R1) AND ADD (MEMBER )
CLI 0(R1),C' '
BNE *-8
MVI 0(R1),C'('
MVC 1(8,R1),JFCB+44
LA R1,1(R1) AND ADD (MEMBER )
CLI 0(R1),C' '
BNE *-8
MVI 0(R1),C')'
*
OPEN9 PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
SR R15,R15
BR RETREG
DROP 2
* --------------------------------------------------------------------
* THE OPENEXIT COPIES LRECL, BLKSIZE + RECFM FROM INPUT TO OUTPUT
* FILES. (A -->A AND B-->B)
* THAT WAY THE USER DOESN'T HAVE TO SPECIFY THEM, AND THEY'RE RIGHT.
*
* IF RECFM=0, THEN WE COPY. IF NOT, WE DON'T.
* ON ENTRY TO THE EXIT ROUTINE, HALF WAY THROUGH OPEN, WE DO
* THE CHECK + COPY.
*
* --------------------------------------------------------------------
PUSH USING
DROP 13,12,11,10
EXLST DC 0F'0',X'85',AL3(OPENEXIT)
USING *,15 I'VE DONE THIS FROM ANCIENT MEMORY
OPENEXIT STM R1,R2,EXITSAVE+8 IT'S BEEN DECADES SINCE I THOUGHT
LM R1,R2,EXITSAVE ABOUT THIS CODE.
XC EXITSAVE(8),EXITSAVE
LTR R2,R2
BZ OPENXR
*
CLI DCBRECFM-IHADCB(R1),0
BNE OPENXR
MVC DCBRECFM-IHADCB(1,R1),DCBRECFM-IHADCB(R2)
MVC DCBLRECL-IHADCB(2,R1),DCBLRECL-IHADCB(R2)
MVC DCBBLKSI-IHADCB(2,R1),DCBBLKSI-IHADCB(R2)
OPENXR LM R1,R2,EXITSAVE+8
SR R15,R15
BR R14
DROP 15
EXITSAVE DC 4F'0'
POP USING
*
EODSYSIN CLOSE SYSIN
* --------------------------------------------------------------------
* DONE WITH CONTROL CARDS. OPEN //FILEA AND FILEB.
* THEN TRY TO OPEN THE VARIOUS ERROR OUTPUT FILES.
*
* BUT FIRST MAKE SURE THAT FLAGS ARE CONSISTENT.
* IF WE'RE GOING TO LISTHEX, THEN WE NEED TO LIST.
*
* MAX ERROR REPORT LIST LENGTH =120.
* IF THEY SPECIFIED MORE THAN THAT, CHANGE IT.
*
* --------------------------------------------------------------------
NOSYSIN TRACE
BAL RETREG,TRACE2
CLI RC,0 Q. ERRORS ON CONTROL CARDS?
BNE GOODEND YES, JUST EXIT.
LA R0,120
C R0,LISTLEN
BNL *+8
ST R0,LISTLEN
CLI LISTLEN+3,40
BH *+8
MVI LISTLEN+3,40
CLI FLAGHEX,C' '
BE *+8
MVI FLAGLIST,C'L'
*
CLI FLAGBYTE,C' '
BE *+8
MVI FLAGLIST,C'L'
* --------------------------------------------------------------------
* THE TRACE2 ROUTINE DUMPS THE VARIOUS TABLES THAT ARE USED.
* THIS IS HANDY IN TESTING, IN CASE THERE IS A PROBLEM.
* WAS IT SETTING UP THE TABLES, OR PROCESSING THE TABLES?
* THAT'S A GOOD THING TO KNOW.
*
* --------------------------------------------------------------------
MVI OPENFLAG,C'I'
*
LA R2,FILEA
BAL RETREG,OPEN
LA R2,FILEB
BAL RETREG,OPEN
*
SR R14,R14
SR R1,R1
TM DCBOFLGS-IHADCB+FILEA,DCBOFOPN
ER3 BNO,11,'//FILEA DDNAME MISSING'
TM DCBOFLGS-IHADCB+FILEB,DCBOFOPN
ER3 BNO,12,'//FILEB DDNAME MISSING'
*
MVI OPENFLAG,C'O'
LA R4,NOTA-8
OPENLOP LM R2,R3,0(R4)
STM R2,R3,EXITSAVE
MVC DW+16,DCBDDNAM-IHADCB(R2)
BAL RETREG,OPEN
* --------------------------------------------------------------------
* IN THIS SECTION, WE'LL PRINT DDNAME AS THE FIRST RECORD OF ERROR
* OUTPUT FILES. THIS IS USED IN TESTING TO SEE WHAT WE'RE LOOKING
* AT.
* --------------------------------------------------------------------
CLI FLAGNAME,C' ' PRINT HEADER?
BE OPENLOQ NO.
TM DCBOFLGS-IHADCB(R2),DCBOFOPN Q. FILE OPEN?
BZ OPENLOQ NO, SKIP
MVC LINE(8),DW+16 SAVE DDNAME
MVC LINE+9(6),=C'FILE -' AND SET UP SEPARATOR
MVC LINE+15(45),LINE+14
LA R14,LINE-1
TM DCBRECFM-IHADCB(R2),X'80' RECFM=F/B
BO PUTSEPAR YES, GO WRITE.
*
LA R14,LINE-8 POINT TO VB LLBB
MVI 1(R14),65 INDICATE LENG
LH R1,DCBLRECL-IHADCB(R2) LOAD LRECL
CH R1,0(R14) IS LRECL SHORT?
BNL *+8 NO, JUST WRITE.
STH R1,0(R14) YES, USE SHORTER LENGTH.
PUTSEPAR PUT (2),(14)
MVC LINE(66),LINE-1
*
OPENLOQ LA R4,NOTB-NOTA(R4)
CLI 0(R4),X'FF'
BNE OPENLOP
*
TM DCBOFLGS-IHADCB+NOTAB,DCBOFOPN
BZ BEGIN
*
CLC DCBRECFM-IHADCB+FILEA,DCBRECFM-IHADCB+FILEB
BE BEGIN
ER3 B,14,'//NOTAB CANNOT BE USED IF RECFM OF FILEA+FILEB DO NOT MATCH'
*
TESTCLC CLC 0(0,R14),12(R2) TEST FOR EXCLUDED RECORDS.
TEST TRACE
L R2,$$EXCLUD THIS RTN TESTS FOR EXCLUDED
TESTLOOP TRACE
CLI 0(R2),X'FF' RECORDS. LOAD OFFSET TO DATA
BE 4(RETREG) AND LENGTH OF DATA-1,
LM R14,R15,0(R2) AND COMPARE TO SAVED STRING.
CLI 0(R2),0
BE 4(RETREG)
CLI 4(R2),0
BE 4(RETREG)
LA R14,0(R1,R14) RETURN AT +4 IF NOT FOUND.
EX R15,TESTCLC RETURN AT +0 IF WE MATCH.
BER RETREG
LA R2,80(R2)
B TESTLOOP
*
CNTMAT TRACE
AP #MATCH,=P'1'
MVC COMPSAVE(32),COMPSAVE-4
B GETA
GETAEXCL TRACE
AP #DROPA,=P'1'
LM R14,R15,DROPA-8
PUTOPEN 0(R15),0(R14)
CLI FLAGEXCL,C' '
BE GETAEXC2
MVC LINE(08),=C'EXCL A ='
MVC LINE+8(0),0(R3)
EX R14,*-6
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
*
GETAEXC2 TRACE
CLI 11(R2),1
BNH GETA
L R3,8(R2)
BCTR R3,0 SUBT 1
GETAEXC3 TRACE
GET FILEA
AP #DROPA,=P'1'
AP #READA,=P'1'
LA R14,0(R1)
PUTOPEN DROPA,0(14)
BCT R3,GETAEXC3
B GETA
*
BEGIN TRACE
* ------------------------------------------------------------------
* THIS SECTION OF CODE SETS UP AN AREA TO SAVE RECORD KEYS.
* IT'S USED TO SEE IF THE KEYS IN FILEA AND FILEB ARE
* OUT OF SEQUENCE.
* ------------------------------------------------------------------
*
CLI $$KEYLOC,X'FF' Q. WAS KEY SPECIFIED?
BE BEGIN10 NO, DON'T BOTHER.
CLI KEYSEQCK,C'N' Q. WAS KEY SPECIFIED?
BE BEGIN10 NO, DON'T BOTHER.
LA R1,$$KEYLOC
LA R2,SAVE
ST R2,KEYSEQA
*
BEGIN05 LM R14,R15,0(R1)
STM R14,R15,0(R2)
XC 8(0,R2),8(R2)
EX R15,*-6
LA R1,8(R1)
LA R2,9(R2,R15)
CLI 0(R1),0
BE BEGIN05
*
ST R2,KEYSEQA+4
MVI 0(R2),X'FF'
LA R2,4(R2)
MVC 0(256,R2),SAVE
ST R2,KEYSEQB
A R2,KEYSEQA+4
S R2,KEYSEQA
ST R2,KEYSEQB+4
BEGIN10 DS 0H
*
* XC OLDABKEY,OLDABKEY
* MVC OLDABKEY+256,OLDABKEY
GETA TRACE
CLI NOTFILAB,C'N' Q. WAS THERE A KEY SEQ NO MATCH
MVI NOTFILAB,0
BE GETB YES, ONLY READ 'B' FILE.
GET FILEA
ST R1,AB
AP #READA,=P'1'
SP MAXIN,=P'1'
BZ GOODEND
*
CLI $$ASKIP,X'FF'
BE GETANSKP
MVC DW,#READA
LA R2,$$ASKIP
BAL RETREG,QSKIP
LTR R15,R15
BZ GETANSKP
LR R14,R1
PUTOPEN SKIPA,0(R14)
AP #SKIPA,=P'1'
B GETA
GETANSKP TRACE
*
ST R1,FILEA-8
ST R1,NOTA-8
ST R1,NOTAB-8
A R1,OFFSETAB
LA R3,0(R1) SAVE REC ADDR
BAL RETREG,TEST GO TEST FOR EXCLUDED HEADER/FOOTER/???
B GETAEXCL
B GETB
*
GETBEXCL TRACE
AP #DROPB,=P'1'
LM R14,R15,DROPB-8
PUTOPEN DROPB,0(R14)
CLI FLAGEXCL,C' '
BE GETBEXC2
MVC LINE(08),=C'EXCL B ='
MVC LINE+8(0),0(R4)
EX R14,*-6
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
*
GETBEXC2 TRACE
CLI 11(R2),1
BNH GETB
L R3,8(R2)
BCTR R3,0 SUBT 1
GETBEXC3 TRACE
GET FILEB
LA R4,0(R1)
AP #DROPB,=P'1'
AP #READB,=P'1'
LA R14,0(R1)
PUTOPEN DROPB,0(14)
BCT R3,GETBEXC3
*
GETB TRACE
CLI NOTFILAB+1,C'N' Q. WAS THERE A KEY SEQ NO MATCH
MVI NOTFILAB+1,0
BE GETBGOOD YES, DON'T READ 'B' FILE.
GET FILEB
ST R1,AB+4
AP #READB,=P'1'
SP MAXIN,=P'1'
BZ GOODEND
*
CLI $$BSKIP,X'FF'
BE GETBNSKP
MVC DW,#READB
LA R2,$$BSKIP
BAL RETREG,QSKIP
LTR R15,R15
BNZ GETBNSKP
LR R14,R1
PUTOPEN SKIPB,0(R14)
AP #SKIPB,=P'1'
B GETB
*
GETBNSKP TRACE
*
ST R1,FILEB-8
ST R1,NOTB-8
A R1,OFFSETAB+4
LA R4,0(R1)
* ST R4,AB+12
BAL RETREG,TEST
B GETBEXCL
B GETBGOOD
*
QSKIP TRACE
CLI 0(R2),X'FF'
BE QSKIP12
LM R14,R15,0(R2)
QSKIP10 CLI 0(R14),X'FF'
BE QSKIP12
CP DW,0(8,R14)
BNE QSKIP14
QSKIP12 SR R15,R15
BR RETREG
QSKIP14 BLR RETREG
LA R14,8(R14)
ST R14,0(R2)
CR R14,R15
BL QSKIP10
MVI 0(R2),X'FF'
B QSKIP12
*
GETBGOOD TRACE
STM R3,R4,DW+8
*
L R3,FILEA-8
L R4,FILEB-8
*
LH R1,DCBLRECL-IHADCB+FILEA GOT 2 RECORDS, LOAD LENGTH
LH R2,DCBLRECL-IHADCB+FILEB
*
TM DCBRECFM-IHADCB+FILEA,X'80'
BO ADDR12
LH R1,0(R3)
SH R1,=H'4'
LA R3,4(R3)
ADDR12 A R3,OFFSETAB
S R1,OFFSETAB
*
TM DCBRECFM-IHADCB+FILEB,X'80'
BO ADDR14
LH R2,0(R4)
SH R2,=H'4'
LA R4,4(R4)
ADDR14 TRACE
A R4,OFFSETAB+4
S R2,OFFSETAB+4
*
CR R2,R1 WE ONLY WANT TO COMPARE THE
BNH *+6 SHORTER OF THE 2 RECORDS.
LR R2,R1
STM R2,R4,AB+8
LTR R2,R2
BP *+8
EX 0,*
*
* ------------------------------------------------------------------
* THIS SECTION OF CODE COMPARES THE CURRENT RECORD KEYS TO
* THE PRIOR RECORD KEYS. AT THE SAME TIME, IT STORES THE
* CURRENT RECORD KEYS, TO USE NEXT TIME.
* IF THE KEYS ARE OUT OF SEQUENCE, THAT'S AN ERROR.
* ------------------------------------------------------------------
CLI $$KEYLOC,X'FF' Q. WAS KEY SPECIFIED?
BE QKEYSEQZ
*
QKEYSEQK TRACE
LR R5,R3
L R6,KEYSEQA
MVI QKEYSEQM+16,C'A'
BAL RETREG,QKEYSEQL
*
LR R5,R4
L R6,KEYSEQB
MVI QKEYSEQM+16,C'B'
BAL RETREG,QKEYSEQL
B QKEYSEQZ
*
QKEYSEQL TRACE
LM R14,R15,0(R6)
LA R1,0(R14,R5)
EX R15,QKEYSEQC
QKEYSEQM ER3 BNH,04,'* FILE RECORD KEY OUT OF SEQUENCE.'
EX R15,QKEYSEQC+6
LA R6,9(R6,R15)
CLI 0(R6),0
BE QKEYSEQL
BR RETREG
*
KEYSEQA DC 2F'-1'
KEYSEQB DC 2F'-1'
QKEYSEQC CLC 8(0,R6),0(R1)
MVC 8(0,R6),0(R1)
KEYSEQCK DC C' '
*
QKEYSEQZ TRACE
* ------------------------------------------------------------------
* CLI $$KEYLOC,X'FF' KEY= SPECIFIED?
* BE NOKEY NO
* CLI KEYSEQCK,C'N' SKIP SEQ CHECK SPECIFIED?
* BE NOKEY YES, NO IDEA WHY, BUT DON'T CHECK.
* *
* LM R0,R1,$$KEYLOC LOAD OFFSET/LENGTH -1
* LR R14,R3
* AR R14,R0
* EX R15,CLCAKEY IS OLD KEY HIGHER THAN NEW?
* ER3 BH,02,'FILEA KEYS OUT OF SEQUENCE'
* EX R15,MVCAKEY
* *
* * LM R0,R1,$$KEYLOC
* LR R14,R4
* AR R14,R0
* EX R15,CLCBKEY
* ER3 BH,03,'FILEB KEYS OUT OF SEQUENCE'
* EX R15,MVCBKEY
* *
* B NOKEY
* CLCAKEY CLC OLDABKEY(0),0(R14)
* MVCAKEY MVC OLDABKEY(0),0(R14)
* CLCBKEY CLC OLDABKEY+256(0),0(R14)
* MVCBKEY MVC OLDABKEY+256(0),0(R14)
*
* NOKEY DS 0H
*
*
ST R3,COMPCLCL
ST R2,COMPCLCL+4
ST R4,COMPCLCL+8
ST R2,COMPCLCL+12
*
SH R2,=H'1'
BP *+8
EX 0,*
*
CH R2,=H'255' AND NOT MORE THAN 255 BYTES.
BL *+8
LA R2,255
*
CLI $$COMPAR,0
BNE EXCOMP
XC COMPCLCL(16),COMPCLCL
LA R1,$$COMPAR
COMP10 TRACE
ST R1,$$COMPAR-4 SAVE LOC IN $$COMPAR LIST
*
LM R14,R15,0(R1) LOAD LOC/LEN
LA R15,R15
BM COMP15 IF LENGTH=0, COMPARE REST OF REC
*--
LA R0,1(R14,R15) CALC TOT LEN
CR R0,R2
BNH COMP30
* OH CRAP, REC SHORT, CALC LEN
COMP15 TRACE
LR R15,R2
SR R15,R14
*
COMP30 TRACE
LA R1,0(R14,R4)
LA R14,0(R14,R3)
EX R15,COMPCLC
BNE NOTAMAT
L R1,$$COMPAR-4
LA R1,8(R1)
CLI 0(R1),0
BE COMP10
B CNTMAT
*
COMPCLCL DC 4F'0',4F'0'
NOTMATMG DC C'RECORD 123,456,789,012,345 OF FILEA DOES NOT MATCH RECX
ORD 123,456,789,012,345 OF FILEB'
*
DC F'0'
COMPSAVE DC 8F'0'
*
COMPCLC CLC 0(0,R14),0(R1)
COMP CLC 0(0,R3),0(R4) TEST FOR RECORS THAT MATCH.
*
EXCOMP LM R14,R1,COMPCLCL
STM R14,R1,COMPCLCL+16
EXCOMPT TRACE
LTR R15,R15
BZ EXCOMPC
XC COMPCLCL(16),COMPCLCL
CLCL R14,R0
B EXCOMPCC
*
EXCOMPC TRACE
ST R3,COMPCLCL+16
ST R4,COMPCLCL+24
LA R0,1(R2)
ST R0,COMPCLCL+20
ST R0,COMPCLCL+28
*--
EX R2,COMP
*
EXCOMPCC BE CNTMAT MATCH, GO READ. NO, PRINT BOTH
STM R2,R4,COMPSAVE+16
*--
NOTAMAT TRACE
* ----------------------------------------------------------------
* WHEN THERE IS A MIS-MATCH, CHECK TO SEE IF KEYS MATCH,
* AND IF NOT, ONLY READ THE FILE WITH THE LOWER KEY.
* ----------------------------------------------------------------
CHKKEY CLI $$KEYLOC,0
BNE KEYOK
XC NOTFILAB,NOTFILAB INDICATE NOT TO SKIP A READ
LA R1,$$KEYLOC-8
CHKKEYL LA R1,8(R1)
CLI 0(R1),0 Q. END OF KEY TABLE?
BNE KEYOK YES, KEYS MATCH.
*
LM R14,R15,0(R1) LOAD OFFSET + LENG-1
LA R5,0(R3,R14) POINT TO KEY
LA R6,0(R4,R14)
EX R15,KEYCLC DO THE COMARE
BE CHKKEYL EQUAL, TRY NEXT KEY
BL FILEALOW
BH FILEBLOW
EX 0,*
KEYCLC CLC 0(0,R5),0(R6)
NOTFILAB DC XL2'0000'
*
FILEBLOW LR R5,R4
MVI NOTFILAB,C'N' IF FILEB LOW, SKIP "A" READ.
MVC LINE(L'ED15),ED15
EDMK LINE(L'ED15),#READA
MVC LINE(08),=C'B RECORD'
B FILEAL2
*
FILEALOW LR R5,R3
MVI NOTFILAB+1,C'N' IF FILEA LOW, SKIP "B" READ
MVC LINE(L'ED15),ED15
EDMK LINE(L'ED15),#READA
MVC LINE(08),=C'A RECORD'
*
FILEAL2 MVC LINE+2+L'ED15(23),=C'RECORD KEY LOW, SKIPPED'
MVC LINE+10(60),0(R1)
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
ZAP DW,=P'1'
*
FILEAL5 LR R6,R2
BAL RETREG,LLPR01
S R2,LISTLEN
BP FILEAL5
B GETA
KEYOK DS 0H
*
NOTAMAT1 AP #NOTMAT,=P'1'
*
STM R3,R4,AB+24
LM R3,R4,AB
PUTOPEN NOTA,0(R3)
PUTOPEN NOTB,0(R4)
*
TM DCBOFLGS-IHADCB+NOTAB,DCBOFOPN
BZ NOTAMAT9
LR R14,R3
LR R15,R4
LA R0,9
TM DCBRECFM-IHADCB+NOTAB,X'80'
BO NOTAMAT5
LA R14,4(R14)
LA R15,4(R15)
XC DW,DW
*
NOTAMAT5 CLC 0(1,R14),0(R15)
BE NOTAMAT6
BCT R0,NOTAMAT5
B NOTAMAT8
NOTAMAT6 STM R14,R15,DW
MVC DW+8(1),0(R14)
MVC DW+9(1),0(R15)
MVI 0(R14),C'A'
MVI 0(R15),C'B'
NOTAMAT8 PUT NOTAB,(R3)
PUT NOTAB,(R4)
LM R14,R15,DW
LTR R14,R14
BZ NOTAMAT9
MVC 0(1,R14),DW+8
MVC 0(1,R15),DW+9
*
NOTAMAT9 LM R3,R4,AB+24
OI RC,4
*
MVC LINE(L'NOTMATMG),NOTMATMG
MVC LINE+6(L'ED15),ED15
MVC LINE+57(L'ED15),ED15
LA R1,LINE+57+L'ED15-3
EDMK LINE+57(L'ED15),#READB
MVC LINE+59(40),0(R1)
LA R1,LINE+6+L'ED15-3
EDMK LINE+6(L'ED15),#READA
MVC LINE+8(80),0(R1)
*
* MVC NOTMATMG+4(L'ED15),ED15
* ED NOTMATMG+4(L'ED15),#READA
* MVC NOTMATMG+52(L'ED15),ED15
* ED NOTMATMG+52(L'ED15),#READB
*
* OI #READA+7,X'0F'
* UNPK NOTMATMG+05(15),#READA
* OI #READB+7,X'0F'
* UNPK NOTMATMG+49(15),#READB
*
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
CLI LISTLEN+3,0
BNE LONGLIST
CLI FLAGHEX,C' '
BNE PRINTHEX
CLI FLAGLIST,C' '
BE NLISTER
*
* GOT A MISS-MATCH, PRINT BOTH RECS.
MVC LINE,LINE-1 CLEAR
MVI LINE,C'A' INDICATE FILE
MVC LINE+2(0),0(R3) MOVE RECORD TO PRINT AREA
EX R2,*-6
BAL RETREG,PUTPRT GO PRINT IT
MVC LINE(256),LINE-1
MVI LINE,C'B'
MVC LINE+2(0),0(R4)
EX R2,*-6
BAL RETREG,PUTPRT
*
CLI FLAGBYTE,C' '
BE NLISTER
EX R2,NOMATXC
EX R2,NOMATTR
BAL RETREG,PUTPRT
B NLISTER
*
DC 3F'0'
PRINTHEX TRACE
STM R2,R4,PRINTHEX-12
ZAP LISTLOC,=P'1'
NOP PRTHEX05
OI *-3,X'F0'
L R1,LISTLEN
LA R0,120
CR R1,R0
BL *+10
LR R1,R0
ST R1,LISTLEN
CVD R1,DW
ZAP LISTLOC+3,DW
*
PRTHEX05 TRACE
MVC LINE(2),=C'A='
LR R14,R3
LR R15,R2
BAL RETREG,PRTHEX20
*
ZAP DW,LISTLOC
NC DW,=X'0000000000000FFF'
CVB R15,DW
LA R15,SEPLINE+132(R15)
L R14,LISTLEN
BCTR R14,0
MVC SEPLINE+9(0),0(R15)
EX R14,*-6
PUT SYSPRINT,SEPLINE
*
PUT SYSPRINT,SEPLINE
MVC LINE(2),=C'B='
LR R14,R4
LR R15,R2
BAL RETREG,PRTHEX20
CLI FLAGBYTE,C' '
BE NLISTER
*
EX R2,PRTHEXMV
EX R2,PRTHEXNC
EX R2,PRTHEXTR
LA R14,SAVE+4
LR R15,R2
BAL RETREG,PRTHEX20
B NLISTER
*
PRTHEXMV MVC SAVE(0),0(R3)
PRTHEXNC NC SAVE(0),0(R4)
PRTHEXTR TR SAVE(0),NOMATTBL
PRTHEXED DC X'402021202020'
*
DC 4F'0'
PRTHEX20 TRACE
ZAP LISTLOC,=P'1'
PRTHEX21 STM R14,R15,PRTHEX20-16
PRTHEX22 TRACE
MVC LINE+2(6),PRTHEXED
ED LINE+2(6),LISTLOC
AP LISTLOC,LISTLOC+3
L R15,PRINTHEX-12
C R15,LISTLEN
BL *+8
L R15,LISTLEN
BCTR R15,0
STM R14,R15,PRTHEX20-8
EX R15,PRTHEXM
PUT SYSPRINT,LINE-1
CLI FLAGHEX,C'N'
BE PRTHEX28
MVC LINE(2),LINE-1
LM R14,R15,PRTHEX20-8
EX R15,PRTHEXT1
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
LM R14,R15,PRTHEX20-8
EX R15,PRTHEXM
EX R15,PRTHEXT2
PUT SYSPRINT,LINE-1
PRTHEX28 MVC LINE,LINE-1
LM R14,R15,PRTHEX20-16
S R15,LISTLEN
BMR RETREG
A R14,LISTLEN
AP LISTLOC,LISTLOC+3
B PRTHEX21
SEPLINE DC CL133' '
ORG SEPLINE+8
SEPTEXT DC 2C'----+---10----+---20----+---30----+---40----+---50---X
-+---60----+---70----+---80----+---90----+----0'
ORG
*
PRTHEXM MVC LINE+9(0),0(R14)
PRTHEXT1 TR LINE+9(0),PRTHEXHI
PRTHEXT2 TR LINE+9(0),PRTHEXLO
PRTHEXHI DC 16C'0',16C'1',16C'2',16C'3',16C'4',16C'5',16C'6',16C'7'
DC 16C'8',16C'9',16C'A',16C'B',16C'C',16C'D',16C'E',16C'F'
PRTHEXLO DC 16C'0123456789ABCDEF'
*
GETRECAD TRACE
LM R2,R3,AB
LH R4,DCBLRECL-IHADCB+FILEA
LH R5,DCBLRECL-IHADCB+FILEB
*
TM DCBRECFM-IHADCB+FILEA,X'80'
BO *+12
LA R2,4(R2)
SH R4,=H'4'
*
TM DCBRECFM-IHADCB+FILEB,X'80'
BO *+12
LA R3,4(R3)
SH R5,=H'4'
*
A R2,OFFSETAB
A R3,OFFSETAB+4
S R4,OFFSETAB
S R5,OFFSETAB+4
*
LR R6,R4
CR R6,R5
BL *+6
LR R6,R5
C R6,LISTLEN
BL *+8
L R6,LISTLEN
*
BR RETREG
*
LLT1 TR LINE+9(0),TRUNPRT
LLM1 MVC LINE+9(0),0(R5)
LLPRINT TRACE
OI DW+7,X'0F'
UNPK LINE+2(5),DW+5(3)
LLPR01 C R6,LISTLEN
BL *+8
L R6,LISTLEN
*
SH R6,=H'1'
BM LLPR90
EX R6,LLM1
CLI FLAGHEX,C' '
BE LLPR90
*
LLPR05 MVC LINE+133,LINE
EX R6,LLT1
PUT SYSPRINT,LINE-1
MVC LINE,LINE+133
EX R6,PRTHEXT1
PUT SYSPRINT,LINE-1
MVC LINE,LINE+133
EX R6,PRTHEXT2
MVC LINE+133,LINE+132
LLPR90 PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
BR RETREG
*
LONGLIST TRACE
L R6,LISTLEN
CVD R6,DW+16
ZAP DW,=P'1'
* BAL RETREG,GETRECAD
LM R2,R4,AB+8
*
LL2 LR R5,R3
LR R6,R2
MVI LINE,C'A'
BAL RETREG,LLPRINT
*
MVC DW+8,DW
NC DW+8,=X'0000000000000FFF'
CVB R1,DW+8
LA R1,SEPTEXT-1(R1)
MVC LINE+9(0),0(R1)
EX R6,*-6
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
*
LR R5,R4
LR R6,R2
MVI LINE,C'B'
BAL RETREG,LLPR01
CLI FLAGBYTE,C' '
BE LL6
*
EX R6,LL12MV
EX R6,LL12NC
EX R6,LL12TR
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
*
LL6 AP DW,DW+16
A R3,LISTLEN
A R4,LISTLEN
S R2,LISTLEN
LTR R2,R2
BP LL2
B NLISTER
*
LL12MV MVC LINE+9(0),0(R3)
LL12NC XC LINE+9(0),0(R4)
LL12TR TR LINE+9(0),NOMATTBL
*
NLISTER TRACE
MVC LINE(256),LINE-1
PUT SYSPRINT,LINE-1 LEAVE A BLANK LINE
AP #NOTMAT,=P'1'
SP MAXERR,=P'1' Q. MAX ERRORS TO PRINT?
BZ GOODEND
B GETA NO, GO READ MORE.
* L R0,COMPSAVE
* LTR R0,R0
* BZ GETA
* --- COMPARE PRIOR RECORDS
*
* BNZ GETA NO, GO READ MORE.
* B GOODEND YES, EXIT.
*
NOMATXC XC LINE+2(0),0(R3)
NOMATTR TR LINE+2(0),NOMATTBL
* NOMATTBL DC C' ',255C'+'
LISTLEN DC F'100'
LISTLOC DC PL3'1',PL3'120'
FLAGEXCL DC C' '
FLAGTRAC DC C' '
FLAGTABL DC C' '
FLAGNAME DC C' '
OPENFLAG DC C'I'
OPENERR DC C' '
FLAGBYTE DC 2C' '
FLAGLIST DC C' '
FLAGHEX DC 2C' '
AB DC 8F'0'
$$EXCLUD DC 2F'-1'
*
PUTPRT TRACE
PUT SYSPRINT,LINE-1
CH R2,=H'130'
BLR RETREG
MVC FLAGBYTE+1,LINE+132
MVI LINE+132,C' '
PUT SYSPRINT,LINE+132
MVC LINE+132(1),FLAGBYTE+1
BR RETREG
*
MVC LINE+6(0),0(R1)
PARMMSG TRACE
OI RC,16
EX R15,PARMMSG-6
LTR R1,R0
BZ PARMMSG2
LA R15,LINE+9(R15)
MVC 0(20,R15),0(R1)
TR 0(20,R15),TRUNPRT
*
PARMMSG2 LA R14,0(R14)
SR R14,R13
ST R14,DW
UNPK LINE(5),DW+2(3)
TR LINE(4),HEXTBL-240
MVI LINE+4,C' '
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
B GETSYSIN
*
TRACE TM DCBOFLGS-IHADCB+SYSPRINT,DCBOFOPN IF SYSPRINT NOT OPEN
BZ 8(R14) THEN JUST RETURN.
CLI FLAGTRAC,C'N'
BE 8(R14) THEN JUST RETURN.
ST R14,TRACSAVE-4
CLI TRACLINE+1,C' '
BE TRACE10
PUT SYSPRINT,TRACLINE
MVI TRACLINE+1,C' '
L R14,TRACSAVE-4
TRACE10 MVC TRACLINE+2(8),0(R14)
LA R14,TRACLINE+12
LA R15,TRACSAVE
LA R0,10
BAL R2,TRACUNPK
PUT SYSPRINT,TRACLINE
L R14,TRACSAVE-4
B 8(R14)
*
TRACUNPK UNPK 0(9,R14),0(5,R15)
TR 0(8,R14),HEXTBL-240
MVI 8(R14),C' '
LA R14,9(R14)
LA R15,4(R15)
BCT R0,TRACUNPK
BR R2
*
DC F'0'
TRACSAVE DC 12F'0'
TRACLINE DC CL132' LABEL R14 R15 R0 R1 R2X
R3 R4 R5 R6 RETREG'
* R3 R4 R5 R6 R7 R8 X
* R9'
DC C' '
*
DC F'0'
TRACE2 TRACE
CLI FLAGTRAC,C' '
BNE TRACE2A
CLI FLAGTABL,C' '
BER RETREG
TRACE2A ST RETREG,TRACE2-4
MVC TRACE2Z+1(1),FLAGHEX
MVI FLAGHEX,C'T'
MVC TRACE2Z+5(1),LISTLEN+3
MVI LISTLEN+3,80
MVC LINE,LINE-1
LA R4,TRACE2LI
MSG 'PRINT COMPARE, SORT KEY, SKIPA/B, AND EXCLUDE, TABLES'
TRACE2L L R5,0(R4)
LA R6,80
MVC LINE(24),4(R4)
PUT SYSPRINT,LINE-1
MVC LINE(24),LINE-1
CLI 4(R4),C' ' Q. IS THIS THE EXCLUDE TABLE
BE TRACE2EX YES, PRINT INDIVIDUAL ENTRIES
CLI 5(R4),C' ' Q. IS THIS A SKIPA/B= TABLE
BE TRACE2SK YES, FOLLOW POINTER.
BAL RETREG,LLPR01 OTHER TABLES ARE INLINE.
B TRACE2N
*
TRACE2SK LA R6,8
BAL RETREG,LLPR01
L R5,0(R5)
LA R6,80
BAL RETREG,LLPR01
B TRACE2N
*
TRACE2EX LA R6,8
BAL RETREG,LLPR01
LM R5,R6,0(R5)
CLI 0(R5),0
BNE TRACE2N
LR R3,R6
TRACE2M LA R6,80
BAL RETREG,LLPR01
LA R5,80(R5)
CR R5,R3
BL TRACE2M
*
TRACE2N LA R4,28(R4)
CLI 0(R4),0
BE TRACE2L
*
TRACE2Z MVI FLAGHEX,C'H' DON'T CHANGE THESE 2 INSTRUCTIONS,
MVI LISTLEN+3,80 THEY ARE MODIFIED ABOVE !!!!!!!
L RETREG,TRACE2-4
BR RETREG
*
TRACE2LI DC A($$COMPAR),CL24'COMPARE TABLE ADDRESSES'
DC A($$KEYLOC),CL24'SORT KEY= ENTRIES'
DC A($$ASKIP),CL24'A SKIP RECORD NUMBERS'
DC A($$BSKIP),CL24'B SKIP RECORD NUMBERS'
DC A($$EXCLUD),CL24' EXCLUDE REQUESTS'
DC X'FF'
*
*
HEXTBL DC C'0123456789ABCDEF'
ERR01RGS DC 9F'0'
*
MVC LINE+15(0),4(R15)
ERR01 TRACE
MVC LINE,LINE-1
LH R0,0(R15)
CVD R0,DW
OI DW+7,X'0F'
UNPK LINE+5(3),DW+6(2)
MVC LINE(6),=C'ERROR '
*
LA RETREG,0(R15)
SR RETREG,R13
ST RETREG,12(R13)
UNPK LINE+10(5),14(3,R13)
TR LINE+10(4),HEXTBL-240
MVI LINE+14,C' '
*
LH RETREG,2(R15)
EX RETREG,ERR01-6
LA RETREG,LINE+18(RETREG)
*
* MVC LINE+15(0),0(R3)
* EX R2,ERR01-6
* LA R2,LINE+18(R2)
*
LTR R14,R14
BNP *+10
MVC 0(20,RETREG),0(R14)
LTR R1,R1
BNP *+10
MVC 23(20,RETREG),0(R1)
*
* OI RC,4
* B ERRPUTP
*
* ERRPUT TRACE
* MVC LINE+38(80),0(R1)
ERRPUTP TRACE
PUT SYSPRINT,LINE-1
MVC LINE(140),LINE-1
*
PUT SYSPRINT,TRACLINE-1
LA R14,LINE+12
LA R15,ERR01RGS
LA R0,10
BAL R2,TRACUNPK
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
*
B BADEND
*
FLGEOD1 DC C' ',CL20'EXTRA RECS IN FILEA'
FLGEOD2 DC C' ',CL20'EXTRA RECS IN FILEB'
EOD1 TRACE
MVI FLGEOD1,C'E'
GET FILEB
BAL RETREG,TEST
B EOD1
*
EOD2 TRACE
MVI FLGEOD2,C'E'
CLI FLGEOD1,C'E'
BE GOODEND
LA R2,2
LA R3,FLGEOD1
EOD2M CLI 0(R3),C' '
BNE EOD2N
MVC LINE(20),1(R3)
PUT SYSPRINT,LINE-1
EOD2N LA R3,21(R3)
BCT R2,EOD2M
MVC LINE,LINE-1
*
EXTRECS PUT SYSPRINT,EXTRECSM
BADEND TRACE
OI RC,8
*
GOODEND TRACE
MVC LINE,LINE-1
MVC LINE(L'VER##-5),VER##
LH R0,RC-1
CVD R0,DW
OI DW+7,X'0F'
UNPK LINE+L'VER##+11(3),DW+6(2)
MVC LINE+L'VER##-2(14),=C'FINISHED. RC='
PUT SYSPRINT,LINE-1
MVC LINE,LINE-1
*
LA R2,MAXERR
*
ENDPRT TRACE
MVC LINE(L'ED15),ED15
ED LINE(L'ED15),0(R2)
MVC LINE+L'ED15+2(32),8(R2)
*
PUT SYSPRINT,LINE-1
LA R2,40(R2)
C R2,=A(MAXIN)
BL ENDPRT
MVC LINE,LINE-1
*
LA R3,DCBLIST
L R2,0(R3)
EXCLOSE TRACE
TM DCBOFLGS-IHADCB(R2),DCBOFOPN
BZ NOTOPEN
C R2,=A(SYSPRINT)
BNE CLOSEIT
MVC LINE,LINE-1
LH R14,RC-1
CVD R14,DW
OI DW+7,X'0F'
MVC LINE(4),=C'RC ='
UNPK LINE+5(3),DW+6(2)
MVI LINE+10,C'='
MVC LINE+11(66),LINE+10
PUTOPEN SYSPRINT,LINE-1
CLOSEIT CLOSE ((2))
MVC LINE(8),DCBDDNAM-IHADCB(R2)
MVC LINE+9(6),=C'CLOSED'
PUTOPEN SYSPRINT,LINE-1
MVC LINE,LINE-1
*
NOTOPEN TRACE
LA R3,4(R3)
L R2,0(R3)
LTR R2,R2
BNZ EXCLOSE
*
LH R15,RC-1
L 13,4(13)
L 14,12(13)
LM 0,12,20(13)
BR 14
*
DCBLIST DC A(SYSIN,NOTA,NOTB,NOTAB,DROPA,DROPB)
DC A(SKIPA,SKIPB,FILEA,FILEB,SYSPRINT,0)
*
SYSIN DCB DDNAME=SYSIN,DSORG=PS,DEVD=DA,EODAD=EODSYSIN,MACRF=GL
DC 2A(SYSPRINT)
SYSPRINT DCB DDNAME=SYSPRINT,DSORG=PS,DEVD=DA,MACRF=PM, X
LRECL=133,BLKSIZE=3990,RECFM=FBA
PRINT NOGEN
DC 2A(FILEA)
FILEA DCB DDNAME=FILEA,DSORG=PS,DEVD=DA,EODAD=EOD1,MACRF=GL, X
EXLST=JFCBEXL
DC 2A(FILEB)
FILEB DCB DDNAME=FILEB,DSORG=PS,DEVD=DA,EODAD=EOD2,MACRF=GL, X
EXLST=JFCBEXL
DC A(NOTA,FILEA)
NOTA DCB DDNAME=NOTA,DSORG=PS,DEVD=DA,EXLST=EXLST,MACRF=PM
DC A(NOTB,FILEB)
NOTB DCB DDNAME=NOTB,DSORG=PS,DEVD=DA,EXLST=EXLST,MACRF=PM
DC A(NOTAB,FILEA)
NOTAB DCB DDNAME=NOTAB,DSORG=PS,DEVD=DA,EXLST=EXLST,MACRF=PM
DC A(DROPA,FILEA)
DROPA DCB DDNAME=DROPA,DSORG=PS,DEVD=DA,EXLST=EXLST,MACRF=PM
DC A(DROPB,FILEB)
DROPB DCB DDNAME=DROPB,DSORG=PS,DEVD=DA,EXLST=EXLST,MACRF=PM
DC A(SKIPA,FILEA)
SKIPA DCB DDNAME=SKIPA,DSORG=PS,DEVD=DA,EXLST=EXLST,MACRF=PM
DC A(SKIPB,FILEB)
SKIPB DCB DDNAME=SKIPB,DSORG=PS,DEVD=DA,EXLST=EXLST,MACRF=PM
DC F'-1'
*
*FCBEXL DC 0F'0',X'93',AL3(JFCB)
JFCBEXL DC 0F'0',X'87',AL3(JFCB)
*
*
$$DOCADR DC 2A(DOC)
DC F'0'
$$COMPAR DC 10F'-1'
$$KEYLOC DC 8F'-1',X'FF'
DC C' PARM = '
PARM DC CL100' ',CL2' '
CARD DC 2CL80' '
DC H'20,0',CL4' '
LINE DC 2CL132' '
*
ED15 DC X'402020206B2020206B2020206B2020206B212020'
*
DC H'0'
RC EQU *-1
DW DC 4D'0'
OFFSETAB DC 2A(0)
*
MAXERR DC PL8'9',CL32'MAXERR LIMIT REMAINING.'
#READA DC PL8'0',CL32'FILEA RECORDS READ.'
#READB DC PL8'0',CL32'FILEB RECORDS READ.'
#MATCH DC PL8'0',CL32' RECORD PAIRS MATCHED.'
#NOTMAT DC PL8'0',CL32' RECORDS NOT MATCHED.'
#DROPA DC PL8'0',CL32'FILEA RECORDS DROPPED/EXCLUDED.'
#DROPB DC PL8'0',CL32'FILEB RECORDS DROPPED/EXCLUDED.'
#SKIPA DC PL8'0',CL32'FILEA RECORDS SKIPPED'
#SKIPB DC PL8'0',CL32'FILEB RECORDS SKIPPED'
*
MAXIN DC PL8'0',CL32'REMAINING INPUT REC LIMIT'
DC X'FF'
LTORG
*
*
EXTRECSM DC CL133' THERE ARE EXTRA RECORDS IN ONE OF THE FILES.'
NDLMMSG DC CL133' ; IS THE INTENDED PARM DELIMITER. ";" BEING USED I
INSTEAD. THERE MUST BE NO OTHER OCCURRENCES OF IT.'
*
CONVHEX EQU *-193
DC AL1(10,11,12,13,14,15),CL58' '
ORG CONVHEX+C'0'
DC AL1(0,1,2,3,4,5,6,7,8,9)
ORG
*
TESTHEX EQU *-C'A'
DC XL6'00',CL58' '
ORG TESTHEX+C'0'
DC XL10'00'
ORG
DC CL4' '
JFCB DC 45C'JFCB'
TRUNPRT DC 64C' '
DC 192AL1(*-TRUNPRT)
NOMATTBL DC C' ',255C'+'
*
*
* WHEN YOU MODIFY DOC, THE LINES ALL CONTAIN 64 BYTES.
* WHEN YOU CODE ''DOC'' OR &&SYSNDX OR ANYTHING THAT MESSES
* WITH THE LENGTH, YOU HAVE TO CODE IT SPECIFICALY.
* IF YOU DON'T DO THAT, IT WON'T MESS UP THE PROGRAM,
* BUT THE DOC WILL READ REALLY FUNNY.
*
DOC DS 0F
DC CL64'BEVERLY, VER 01.00 ASSEMBLED &SYSDATE, AT &SYSTIME WAS '
DC C'WRITTEN TO COMPARE 2 FILES, EXCLUDING HEADERS, TRAILERS, ETC. '
DC C'AND POINTING OUT LOCATIONS WHERE RECORDS DID NOT MATCH. '
DC C' '
DC C'//COMPARE EXEC PGM=BEVERLY, '
DC CL64' PARM=''NODOC;LISTBYTE,EX=1,C"1",DROP=3;OFFSETB=1'' '
DC C' '
DC C' IE CONTROL CARDS IN PARM FIELD, SEPARATED BY ; '
DC C' WHICH MEANS THAT YOU CANNOT HAVE ";" IN ANY PARAM. '
DC C' OR, YOU CAN PROVIDE THE CONTROL CARDS IN //SYSIN '
DC C' '
DC CL64' PARM=''NODOC/LISTBYTE/EX=1,C"1",DROP=3/OFFSETB=1'' '
DC C' '
DC C' IF YOU SPECIFY NODOC, THEN WHATEVER COMES AFTER IT, IF IT IS '
DC C' NOT BLANK, AND IS NOT A VALID UPPERCASE CHAR, WILL BE USED TO '
DC C' DELIMIT PARAMETERS IN THE PARM FIELD. OF COURSE, THERE MUST '
DC C' BE NO OCCURRANCES OF IT OTHERWISE. '
DC C' '
DC C'//COMPARE EXEC PGM=BEVERLY '
DC C'//STEPLIB DD DISP=SHR,DSN= '
DC C'//SYSPRINT DD SYSOUT=* '
DC C'//FILEA DD DISP=SHR,DSN= '
DC C'//FILEB DD DISP=SHR,DSN= '
DC C'//* '
DC C'//NOTA DD DISP=(,CATLG),DSN= //FILEA RECORDS NOT MATCHED '
DC C'//NOTB DD DISP=(,CATLG),DSN= //FILEB RECORDS NOT MATCHED '
DC C'//NOTAB DD DISP=(,CATLG),DSN= RECORDS THAT DID NOT MATCH '
DC C'//DROPA DD DISP=(,CATLG),DSN= "A" RECORDS EXCLUDED '
DC C'//DROPB DD DISP=(,CATLG),DSN= "B" RECORDS EXCLUDED '
DC C'//SKIPA DD DISP=(,CATLG),DSN= "A" RECORDS SKIPA= '
DC C'//SKIPB DD DISP=(,CATLG),DSN= "B" RECORDS SKIPB= '
DC C'//SYSIN DD * '
DC C' '
DC C'//NOTA CONTAINS ALL OF THE FILEA RECORDS THAT DID NOT MATCH, '
DC C' INCLUDING THE EXCLUDED RECORDS. '
DC C'//NOTB CONTAINS ALL OF THE FILEB RECORDS THAT DID NOT MATCH, '
DC C' INCLUDING THE EXCLUDED RECORDS. '
DC C'//NOTAB CONTAINS THE RECORDS THAT FAILED THE COMPARE, FROM '
DC C' BOTH FILES, BUT NOT EXCLUDED RECORDS. THERE IS A "A" '
DC C' A "B" IN THE FIRST MATCHING BYTE OF THE APPROPRIATE '
DC C' RECORDS TO INDICATE WHAT ONE IS LOOKING AT. '
DC C' IF YOU BROWSE THE "AB" FILE, THEN YOU WILL SEE NON-MATCHING '
DC C' RECORDS, WITH THE "A" RECORD FOLLOWED BY THE "B" RECORD. '
DC C' IF THERE WERRE MATCHING BYTES EARLY IN THE RECORD, THERE '
DC C' BE AN INDICATION OF WHICH FILE THE RECORDS CAME FROM. '
DC C' IN ANY CASE, THE "A" RECORD WILL ALWAYS PRECEED THE "B" REC. '
DC C' '
DC C' THIS CONTAINS CONTROL CARD EXAMPLES. NOTE THAT CONTROL CARDS'
DC C' CAN BE CODED IN THE PARM FIELD. THE "NODOC" PARAMETER CAN '
DC C' ONLY BE CODED IN THE PARM FIELD, AND MUST BE FIRST. '
DC C' '
DC C' WHILE PROCESSING THE PARM FIELD, PARAMETERS ARE SEPARATED BY '
DC C' ";". TO INDICATE THAT, THE ";" MUST BE THE FIRST CHAR IN '
DC C' THE PARM FIELD, OTHER THAN NODOC. SO, A PARM MIGHT BE CODED '
DC C' '
DC CL64' PARM=''NODOC;EX=1,C''1'';LISTHEX;MAXERR=33'' '
DC C' THE FIRST SPECIAL CHAR AFTER NODOC, OR LEADING THE PARM WILL '
DC C' BE THE SEPARATER DELIMITER, SO THIS WOULD ALSO WORK. '
DC CL64' PARM=''NODOC/EX=1,C''1''/LISTHEX/MAXERR=33'' '
DC C' '
DC C' OKAY, NOW ON TO THE VARIOUS PARM/SYSIN OPTIONS..... '
DC C' '
DC C' EXCLUDE=LOC,LEN,#,DATA '
DC C' LOCATION OF STRING TO DROP/EXCLUDE '
DC C' LENGTH OF STRING TO DROP/EXCLUDE '
DC C' # OF RECORDS TO DROP (GENERALLY 1) '
DC C' DATA TO IDENTIFY RECORD TO DROP '
DC C' '
DC C' EXCLUDE= CAN BE ABBREVIATED TO EX= '
DC C' EX=1,12,24,CHARACTER STRING TO DROP '
DC C' '
DC C'EXCLUDE=1,1,5,1 EXCLUDE 5 LINES AT TOP OF PAGE '
DC C' EXCLUDE BLANK LINES THIS WAY ... '
DC C'EXCLUDE=1,88,1, '
DC C'EXCLUDE=8,27,2,THIS IS A SUBTITLE. '
DC C'EXCLUDE=07,06,02,FOOTER (LOCATION, LENGTH, TEXT ) '
DC C'EXCLUDE=121,6,2, PAGE '
DC C'EXCLUDE=121,6,2, PAGE DROP LINE WITH PAGE NUMBER AND '
DC C'EXCLUDE=121,6,2, PAGE ONE MORE. "PAGE" LOCATION VARIES '
DC C'EXCLUDE=121,6,2, PAGE DEPENDING ON LENGTH OF NUMBER. '
DC C' '
DC C'SKIPA=12,22,234,1023 SKIP THOSE RECORDS IN FILEA. '
DC C'SKIPB=4,22,3221 SKIP THOSE RECORDS IN FILEB. '
DC C' NOTE, EX= RECORDS MUST PRECEED '
DC C' SKIP RECORDS, AND SKIPA= MUST '
DC C' PRECEED SKIPB= RECORDS. '
DC C' '
DC C'EX=1,1,1,1 ABBREVIATED EXCLUDE= WORKS. '
DC C' '
DC C'EX=5,C"ABCD" ALTERNATE EXCLUDE= SYNTAX '
DC C'EX-11,X"C1C2C3C4" CAN SPECIFY HEX ALSO. '
DC C'EX=25,C"ABCD",DROP=4 DROPS THE NEXT 3 RECORDS TOO. '
DC C' YOU CAN USE EITHER SINGLE OR DOUBLE QUOTES'
DC C' '
DC C'COMPARE=3,50 COMPARES ONLY COLS 3 THRU 52 '
DC C'COMPARE=5,20,27,5 COMPARES COLS 5-24 AND 27-31 '
DC C'COMPARE=5,20,27,9999 COMPARES COLS 5-24 AND 27-END OF REC '
DC C'COMPARE=5,9999 WOULD WORK,NEVER COMPARES PAST END OF REC '
DC C' '
DC C'KEY=LOC,LEN IF THE FILE HAS ASCENDING KEYS, WE CAN '
DC C' USE THEM TO SEE IF THERE ARE MISSING '
DC C' RECORDS IN ONE OF THE FILES. '
DC C'KEYSEQCK=N BY DEFAULT, IF KEYS ARE SPECIFIED, THEN '
DC C' WE CHECK THAT THE KEYS IN EACH FILE ARE '
DC C' IN SEQUENCE. YOU CAN BYPASS THAT CHECK, '
DC C' BUT WHY WOULD YOU? '
DC C' '
DC C'KEY=1,6,14,8,8,4 YOU CAN HAVE UP TO 4 KEYS. '
DC C' '
DC C' NOTE THAT IT IS A NORMAL CHARACTER COMPARE'
DC C' WHICH WORKS WITH BINARY KEYS AND PACKED '
DC C' KEYS IF THEY ARE NOT NEGATIVE, AND PACKED '
DC C' KEYS HAVE SIMILAR SIGNS (EG: 123C OR 123F)'
DC C' '
DC C'MAXERR=123 (LIMIT ERROR LIST, DEFAULT MAXERR=9) '
DC C'MAXIN=333 (STOP AFTER READING 333 RECORDS FROM A+B)'
DC C'OFFSETA=1 (IF RECORDS IN FILEA OR FILEB) '
DC C'OFFSETB=1 (ARE SHIFTED RIGHT 1 BYTE) '
DC C'LISTERR PRINTS RECORDS THAT DO NOT MATCH '
DC C'LISTBYTE FLAGS WHICH BYTES DO NOT MATCH + '
DC C'LISTEXCL PRINTS RECORDS THAT WERE EXCLUDED. '
DC C'LISTHEX PRINTS HEX DATA FOR RECORDS. '
DC C'LISTHEX=N USES THE HEX ROUTINE,BUT DOES NOT PRT HEX'
DC C'LISTLEN NON-MATCH DATA LENGTH ON //SYSPRINT '
DC C'LISTNAME PUTS HEADER RECORDS IN EACH OF THE '
DC C' "REJECT" FILES, TO INDICATE WHICH FILE '
DC C' IT IS. THIS IS USED IN TESTING WHEN ALL '
DC C' THE FILES ARE WRITTEN TO SYSOUT=* '
DC C' '
DC C'TRACE IS USED IN TESTING TO SHOW WHERE THE '
DC C' PROGRAM IS EXECUTING, AND REGISTERS. '
DC C'TABLES IS USED IN TESTING TO SHOW THE CONTENTS '
DC C' OF 5 TABLES THAT ARE USED INTERNALLY. '
DC C' THIS TEST CODE IS PROBABLY REMOVED FROM '
DC C' THE PRODUCTION VERSION, BUT CAN EASILY BE '
DC C' BE PUT BACK IF DESIRED. '
DC C' '
DC C'/* '
DC C'IF THERE ARE MORE RECORDS (AFTER SKIP= AND EXCLUDE=) IN EITHER '
DC C'FILE, THAT IS REPORTED. '
DC C' '
DC C'IF THE RECORDS ARE OF UNEQUAL LENGTH, THE COMPARE ONLY TESTS '
DC C'THE SHORTER LENGTH. YOU CAN COMPARE EITHER FIXED OR VARIABLE '
DC C'LENGTH RECORDS, OR EVEN ONE OF EACH. '
DC C' '
DC C'IF THERE ARE HEADER, OR FOOTER RECORDS, YOU CAN EXCLUDE THEM, '
DC C'HOWEVER THE OFFSET TO THE IDENTIFIABLE STRING IS DONE RIGHT '
DC C'AFTER THE READ, SO THE OFFSET= DOES NOT APPLY YET, AND YOU HAVE '
DC C'TO ALLOW ROOM FOR THE LLBB OF VARIABLE LENGTH RECORDS. '
DC C' '
DC C'IF ONE FILE HAS CARRIAGE CONTROL RECORDS, AND THE OTHER DOES '
DC C'NOT, THEN YOU CAN OFFSETA= THE RECORDS IN THAT FILE. '
DC C'IF YOU HAVE ASA CARRIAGE CONTROL IN ONE FILE, AND MACHINE '
DC C'CARRIAGE CONTROL IN THE OTHER, THEN YOU CAN OFFSET BOTH FILES. '
DC C' '
DC C'THE DEFAULT IS MAXERR=9, AFTER WHICH THE PROGRAM WILL END. '
DC C'YOU CAN SPECIFY MAXERR=0 WHICH ELIMINATES THAT EFFECT. '
DC C' '
DC C'LISTEXCL LISTS RECORDS THAT ARE EXCLUDED, SO YOU CAN SEE IF THE'
DC C' REQUEST IS DOING WHAT YOU WOULD LIKE. '
DC C'LISTERR LISTS RECORDS THAT DO NOT MATCH, THE DEFAULT IS TO '
DC C' JUST PRINT RECORD NUMBERS FOR EACH FILE. '
DC C'LISTBYTE PUTS A + SIGN UNDER THE CHARACTERS THAT DID NOT '
DC C' COMPARE EQUAL, MAKING THE PROBLEM EASIER TO FIND. '
DC C'LISTHEX PRINTS THE HEX IN THE ERROR REPORT. '
DC C'LISTHEX=N USES THE LISTHEX ROUTINE, BUT DOES NOT PRINT THE HEX. '
DC C'LISTLEN WHEN REPORTING NON-MATCH RECORDS, THIS IS THE NUMBER '
DC C' OF BYTES TO PUT ON A REPORT LINE. IF YOU ARE GOING TO'
DC C' LOOK AT IT ON AN 80 BYTE WIDTH SCREEN, THEN YOU WANT '
DC C' THE //SYSPRINT FILE RECORD TO FIT IN THAT WIDTH. '
DC C' '
DC C'THE EXCLUDE= RECORDS ARE PROCESSED IN SEQUENCE. IN TESTING, '
DC C'THERE WERE MULTIPLE REPORTS IN A SINGLE FILE. IF YOU HAD ONE '
DC C'REPORT WITH 5 TITLE RECORDS, AND ALL THE OTHER REPORTS HAD 3 '
DC C'TITLE RECORDS, YOU COULD CODE THE 5-HEADER FILE FIRST, THEN '
DC C'THE OTHERS. NOTE, THIS IS NOT THE ORDER IN WHICH THEY APPEAR '
DC C'IN THE FILE, BUT THE ORDER OF UNIQUE-NESS. THE FILE WITH 5 '
DC C'HEADER RECORDS COULD BE LAST, BUT THE EXCLUDE= IS CODED FIRST '
DC C'SO THAT IT IS THE ONE THAT WE TEST FOR FIRST. '
DC C' '
DC C'EX=1,40,5,1 TITLE OF REPORT WITH 5 HEADER RECORDS '
DC C'EX=1,1,3,1 (THIS DOES ALL THE OTHER REPORTS) '
DC C' '
DC C' TYPICALLY, YOU ONLY EXCLUDE 1 RECORD, '
DC C' SO PRETTY MUCH ALL EXCLUDE CARDS WILL BE ... '
DC C'EX=LOC,LEN,#,DATA '
DC C' '
DC C'PARM=DOC IS USED TO PRINT THIS DOCUMENTATION. '
DC C' HOWEVER, DOC MUST BE FIRST IN THE PARM FIELD. '
DC C' '
DOC#EXCL EQU * SO I CAN FIX THE NEXT RECORD
DC C' IS THE MAXIMUM NUMBER OF EXCLUDE= RECORDS YOU CAN HAVE. '
DC C' '
DC C'ON TERMINATION, RC=0 MEANS A GOOD COMPARE. '
DC C'RC=4 MEANS THAT 1 OR MORE RECORDS DID NOT COMPARE EQUAL. '
DC C'RC=8 MEANS THAT THERE WAS A MORE SERIOUS PROBLEM, (MISSING RECS)'
DC C'RC=16 MEANS THAT THERE WAS AN ERROR PROCESSING CONTROL CARDS. '
DC C' '
DC C'WHEN RECORDS DO NOT MATCH, AND PARM=LISTBYTE IS SPECIFIED, '
DC C'THE REPORT LOOKS LIKE THIS, WITH A "+" SIGN UNDER THE BYTES '
DC C'THAT DO NOT MATCH. "A" AND "B" INDICATE THE FILE THAT THE '
DC C'RECORD WAS FOUND IN. 00001 IS THE BYTE NUMBER, IN THE RECORD. '
DC C'IF LISTHEX IS SPECIFIED, THEN THE HEX REPRESENTATION WILL BE '
DC C'PRINTED IN OVER/UNDER FORMAT. ONE MIGHT NOTE THAT IT IS EASIER '
DC C'TO USE WHEN YOU DO NOT HAVE A PROPORTIONAL FONT. '
DC C' '
DC C'RECORD 05 OF FILEA DOES NOT MATCH RECORD 05 OF FILEB '
DC C'A 00001 TEST DATA, TEST 4, RECORD 4 NO MATCH '
DC C' ----+---10----+---20----+---30----+---40----+---50 '
DC C'B TEST DATA, TEST 4, RECORD 4 '
DC C' ++ +++++ '
DC C' '
DC C'------------------ END OF DOCUMENTATION ------------------------'
ENDDOC DC X'FF'
DC 256X'00'
TRTTBL DC C' ',255X'00'
PRINT NOGEN
DCBD DEVD=DA,DSORG=PS
END BEVERLY