|
|
1.1 root 1: -TITLE SPITBOL TEST PROGRAM #10 -- FILE COMPARATOR
2: -IN80
3: * THIS PROGRAM PERFORMS THE INVALUABLE SERVICE OF COMPARING TWO
4: * TEXT FILES FOR DIFFERENCES WHICH ARE PRINTED OUT IF FOUND. ITS
5: * SEMANTICS ARE THOSE OF THE DEC-10 PROGRAM FILCOM, BUT THIS VERSION
6: * BEING IN SPITBOL IS PORTABLE.
7: *
8: ** THE PROGRAM IS BASICALLY THE WORK OF
9: ** P.R. TALLETT
10: ** DATACALL LTD
11: ** KIRKSTALL RD
12: ** LEEDS, ENGLAND.
13: **
14: ** IT HAS BEEN ELABORATED SOMEWHAT BY A.P. MCCANN.
15: *
16: ************************************************************************
17: ** INSTRUCTIONS FOR USE *
18: ** THE PROGRAM STARTS BY ATTEMPTING TO READ A COMMAND LINE FROM THE *
19: ** STANDARD INPUT FILE. IF THIS FAILS, A "*" IS PRINTED ON THE *
20: ** TERMINAL AS A PROMPT FOR A REPLY. THE COMMAND LINE SUPPLIED *
21: ** EITHER IN A BATCH OR TERMINAL RUN SHOULD CONSIST OF A COMMAND *
22: ** LINE OF FORM *
23: ** OFILE=INFILE1,INFILE2 *
24: ** WHERE OFILE IS THE FILE TO RECEIVE LIST OF DIFFERENCES, INFILE1 *
25: ** AND INFILE2 ARE FILES TO BE COMPARED. *
26: ** *
27: ** IN ADDITION, THE COMMAND LINE MAY CONTAIN AT ANY POINT, *
28: ** SWITCHES TO CONTROL OPTIONS. THESE ARE LISTED BELOW, WHERE () *
29: ** ENCLOSES OPTIONAL ITEMS AND N STANDS FOR AN INTEGER. *
30: ** *
31: ** /B BLANK LINES MUST MATCH IN COMPARED FILES. DEFAULT *
32: ** IS THAT BLANK LINES ARE IGNORED IN MATCHING PROCESS. *
33: ** *
34: ** /L(N)(+) N LINES MUST BE FOUND IDENTICAL BEFORE A *
35: ** DIFFERENCE LIST IS TERMINATED. DEFAULT IS N=3. *
36: ** *
37: ** + SIGNIFIES THAT THESE N LINES ARE TO BE LISTED. DEFAULT *
38: ** IS THAT ONLY THE FIRST OF THE N LINES IS LISTED. *
39: ** *
40: ** /D(N)(-) A DOUBLE COLUMN LISTING FORMAT IS USED FOR THE *
41: ** DIFFERENCES, GIVING THE FIRST N CHARACTERS OF DIFFERING LINES (OR *
42: ** THE WHOLE LINE IF LESS THAN N IN LENGTH). THE TOTAL LINE LENGTH *
43: ** IS 2N+2 INCLUDING SEPARATING CHARACTERS. DEFAULT IS N=65. *
44: ** *
45: ** - SIGNIFIES THAT DIFFERENCES SHOULD BE SEPARATED BY A SHORT *
46: ** MARKER LINE. DEFAULT IS TO USE A SUFFICIENTLY LONG MARKER LINE *
47: ** TO SEPARATE DIFFERENCES TO GIVE A NEAT "BOXED" PRINTER LISTING. *
48: ** THE SHORTER FORMAT IS USEFUL ON SLOW TERMINALS. *
49: ** *
50: ** /RN ACCEPT INPUT LINES OR PRINT OUTPUT RECORDS OF *
51: ** MAXIMUM LENGTH N CHARACTERS. DEFAULT IS 133 CHARACTERS. *
52: ** *
53: ** AFTER TASK COMPLETION, AN ATTEMPT IS MADE TO READ A NEW *
54: ** COMMAND LINE FOR ANOTHER SET OF FILES. THE RUN IS TERMINATED BY *
55: ** SUPPLYING A NULL COMMAND LINE. *
56: ************************************************************************
57: *
58: * IF PROGRAM IS RUN FROM A TERMINAL, ERRORS IN COMMAND LINE
59: * CAN BE CORRECTED INTERACTIVELY. IT MAY ALSO BE RUN AS A BATCH JOB,
60: * BUT IN THIS CASE ERROR RECOVERY IS NOT POSSIBLE.
61: *
62: * NOTE IMPORTANT COMMENT PRECEDING START OF MAIN PROGRAM.
63: *
64: *
65: &ANCHOR = &TRIM = 1; &STLIMIT = 999999
66: DIGIT = "0123456789"; BLD = " " DIGIT
67: SWPAT = "" $ SL BREAK("/") $ N "/" $ SL
68: + ("L" (SPAN(BLD) $ NN | "") ("+" $ NNP | "")
69: + *?(NN = CONVERT(NN,"INTEGER")) |
70: + "D" (SPAN(BLD) $ LEN *?(LEN = CONVERT(LEN,"INTEGER")) |
71: + *?(LEN = 65)) ("-" $ LENM | "") |
72: + ("R" SPAN(DIGIT)) $ RECL |
73: + "B" $ BLANKS)
74: CMDPAT = BREAK("=") $ F1 LEN(1) BREAK(",") $ F2 LEN(1) REM $ F3
75: STARS = "****"
76: SETEXIT(.ERR); &ERRLIMIT = 5
77: *
78: * HERE ARE THE DATATYPES USED TO MAINTAIN LIST OF LINES WHICH ARE
79: * NOT YET COMPLETELY PROCESSED, TOGETHER WITH POINTERS INTO THEM.
80: * HEAD, CURRENT, TAIL ARE POINTERS TO INITIAL LINE, CURRENT LINE
81: * FOR MATCHING, AND LAST LINE IN THE LINKED LIST OF LINES BUILT
82: * FROM ELEMS.
83: * COUNT IS NO. OF LINES IN THE LIST.
84: * EOF IS SET NON-NULL WHEN END FILE IS MET.
85: * INP IS INPUT ASSOCD FOR READING LINES.
86: *
87: DATA("ELEM(OBJECT,LINK)")
88: DATA("LIST(HEAD,CURRENT,TAIL,COUNT,EOF,INP)")
89: *
90: * ROUTINE TO ADD AN OBJECT TO A LIST. RETURNS A POINTER TO OBJECT.
91: * IF BLANKS IS NULL, IT DOES NOT ADD BLANK LINES BUT FINDS
92: * AND ADDS NEXT NON-BLANK. FAILS IF INPUT EXHAUSTED IN THIS PROCESS.
93: *
94: DEFINE("ADD(LISTX,OBJ)") :(ADDEND)
95: ADD COUNT(LISTX) = (DIFFER(BLANKS),DIFFER(OBJ)) COUNT(LISTX) + 1:S(ADD0)
96: OBJ = $INP(LISTX) :S(ADD)F(FRETURN)
97: *
98: ADD0 ADD = TAIL(LISTX) = HEAD(LISTX) =
99: + IDENT(HEAD(LISTX)) ELEM(OBJ) :S(RETURN)
100: * ADD TO EXISTING LIST IF ARRIVE HERE
101: ADD = TAIL(LISTX) = LINK(TAIL(LISTX)) = ELEM(OBJ):(RETURN)
102: ADDEND
103: *
104: * ROUTINE TO FIND AN OBJECT IN THATL. FAILS IF NOT FOUND
105: * OTHERWISE RETURNS POINTER INTO THATL OF MATCHING ITEM.
106: *
107: DEFINE("MATCH(OBJ)") :(MATEND)
108: MATCH IDENT(THAP = HEAD(THATL)) :S(FRETURN)
109: CD = 1
110: *
111: * ATTEMPT TO MATCH OBJECT WITH THAT POINTED AT IN THATL. NOTE POINTER.
112: *
113: MATC1 MATCH = THAPT = IDENT(OBJ,OBJECT(THAP)) THAP :S(MATC3)
114: *
115: * ADVANCE DOWN THE LIST TO TRY AGAIN.
116: *
117: MATC2 CD = CD + 1
118: IDENT(THAP = LINK(THAP)) :F(MATC1)S(FRETURN)
119: *
120: * FIRST LINE MATCHED . CHECK REMAINING
121: * NN-1 LINES OR TO END OF THISL.
122: *
123: MATC3 THIPT = CURRENT(THISL)
124: CDEC = CD
125: *
126: * MATCHED IF RUN OFF END OF THISL BUT NOT OFF END OF THATL.
127: *
128: MATC4 IDENT(THIPT = LINK(THIPT)) :S(RETURN)
129: IDENT(THAPT = LINK(THAPT)) :S(FRETURN)
130: CDEC = CDEC + 1
131: IDENT(OBJECT(THIPT),OBJECT(THAPT)) :S(MATC4)F(MATC2)
132: MATEND
133: *
134: * ROUTINE TO PRINT DIFFERENCE WHEN FOUND. IT OUTPUTS BOTH LISTS
135: * UP TO FIELD "CURRENT(LISTX)". ON FIRST ENTRY ONLY, IT PLACES
136: * INPUT FILE NAMES ON THE LISTING.
137: *
138: DEFINE("OUTFIL(LISTX,MARK,STARS)X") :(OUTEND)
139: OUTFIL OUT = "FILE 1) " F2
140: OUT = "FILE 2) " F3
141: OUT = DEFINE("OUTFIL(LISTX,MARK,STARS)X",.OUTFIL2)
142: *
143: * THIS ENTRY IS USED ON ALL OCCASIONS AFTER FIRST
144: *
145: OUTFIL2 OUT = STARS
146: OUTFIL3 OUT = MARK OBJECT(DIFFER(X = HEAD(LISTX)) X):F(RETURN)
147: HEAD(LISTX) = LINK(X)
148: IDENT(CURRENT(LISTX),X) :S(RETURN)F(OUTFIL3)
149: OUTEND
150: *
151: * ROUTINE TO PUT LINES TO OUTPUT FILE.
152: *
153: DEFINE("PUT()X,Y,XO,YO") :(ERREND)
154: PUT DIFFER(LEN) :S(PUTDB)
155: DIFFS = DIFFS + 1
156: OUTFIL(FILE1,"1) ",STSTARS)
157: OUTFIL(FILE2,"2) ",STARS) :(RETURN)
158: *
159: * HERE TO OUTPUT DIFFERENCES IN DOUBLE COLUMN FORMAT
160: *
161: PUTDB OUT = RPAD("FILE 1) " F2,LEN) "| " "FILE 2) " F3
162: DEFINE("PUT()X,Y,XO,YO",.PUTD)
163: *
164: * ENTRY USED FOR DOUBLE COLUMN FORMAT AFTER INITIAL ENTRY
165: *
166: PUTD DIFFS = DIFFS + 1; OUT = STSTARS
167: XO = X = HEAD(FILE1); YO = Y = HEAD(FILE2)
168: *
169: * CHECK WHETHER BOTH LISTS FINISHED
170: *
171: PUTD1 HEAD(FILE1) = IDENT(X,IDENT(Y)) CURRENT(FILE1) :F(PUTD2)
172: HEAD(FILE2) = CURRENT(FILE2) :(RETURN)
173: *
174: * PRINT A LINE GIVING DIFFERENCES IN ADJACENT COLUMNS
175: *
176: PUTD2 OUT = (DIFFER(X) GT(SIZE(XO = OBJECT(X)),LEN)
177: + SUBSTR(XO,1,LEN),RPAD(XO,LEN))
178: + "| "
179: + (DIFFER(Y) GT(SIZE(YO = OBJECT(Y)),LEN) SUBSTR(YO,1,LEN),YO)
180: X = (IDENT(X),(DIFFER(CURRENT(FILE1),X) LINK(X),XO = ))
181: Y = (IDENT(Y),(DIFFER(CURRENT(FILE2),Y) LINK(Y),YO = )):(PUTD1)
182: *
183: * THIS ROUTINE IS ENTERED IF A SPITBOL ERROR OCCURS - USED FOR BUGS
184: *
185: ERR SETEXIT(EQ(&ERRTYPE,116) .ERR) :S(CMER)
186: TERMINAL = OUTPUT = "ERROR: " &ERRTEXT " IN STMT " &LASTNO
187: COLLECT()
188: DUMP(2) :(END)
189: ERREND
190: *
191: *
192: * MAIN PROGRAM
193: * ============
194: *
195: * NORMAL ENTRY POINT TO MAIN PROGRAM
196: *
197: INIT LEN = LENM = NNP = DIFFS = BLANKS =
198: NN = 3; RECL = "R133"
199: *
200: * READ COMMAND LINE EITHER FROM INPUT FILE OR TERMINAL.
201: * IF ERROR AND IF BATCH, PRINT ERROR MESSAGE AND STOP.
202: *
203: OUTPUT = DIFFER(BATCH) TERMINAL :S(END)
204: X = BATCH = INPUT :F(TERMI)
205: DETACH(.TERMINAL) :(DIFFX)
206: *
207: * READ COMMAND LINE FROM TERMINAL
208: *
209: TERMI TERMINAL = "*"; X = TERMINAL :F(END)
210: *
211: * CHECK FOR NULL COMMAND LINE
212: *
213: DIFFX DIFFER(X) :F(END)
214: *
215: * LOOP TO PROCESS SWITCHES. NO. OF LINES IN MATCH IS 3 BY DEFAULT.
216: *
217: SWPAT X SWPAT = N :S(SWPAT)
218: TERMINAL = DIFFER(SL) "? INVALID SWITCH" :S(INIT)
219: X CMDPAT :S(GO)
220: *
221: * MERGE FROM ERR IF BAD FILENAMES
222: *
223: CMER TERMINAL = "?COMMAND ERROR IN " X :(INIT)
224: GO OUTPUT(.OUT,3,F1) :S(GO1)
225: TERMINAL = "?CAN'T ENTER OUTPUT FILE " F1 :(INIT)
226: GO1 INPUT(.IN1,1,F2) :S(GO2)
227: TERMINAL = "?CAN'T READ INPUT FILE 1 " F2 :(INIT)
228: GO2 INPUT(.IN2,2,F3) :S(START)
229: TERMINAL = "?CAN'T READ INPUT FILE 2 " F3 :(INIT)
230: *
231: START TERMINAL =
232: STSTARS = DUPL("*",(DIFFER(LEN,IDENT(LENM)) 2 * LEN + 2,12))
233: THISL = FILE1 = LIST(,,,,,.IN1)
234: THATL = FILE2 = LIST(,,,,,.IN2)
235: *
236: * HUNT THROUGH FILES TILL DIFFERING LINES FOUND (IF ANY)
237: *
238: PHASE1 THIS = $INP(THISL) :F(THISEND)
239: *
240: THAT THAT = $INP(THATL) :F(THATEND)
241: *
242: IDENT IDENT(THIS,THAT) :S(PHASE1)
243: *
244: * MAKE SURE DIFFERENCE IS NOT MERELY BLANK LINES IF BLANKS NULL.
245: *
246: DIFFER(BLANKS) :S(DIFF)
247: IDENT(THAT) :S(THAT)
248: DIFFER(THIS) :S(DIFF)
249: THIS = $INP(THISL) :S(IDENT)F(THISEND)
250: *
251: * ARRIVE HERE WHEN A DIFFERENCE IS ENCOUNTERED. PHASE 2
252: * ASSESSES HOW MUCH DIFFERENCE THERE IS AND PRINTS DIFFERENCES.
253: * IT OPERATES BY READING A LINE ALTERNATELY FROM EACH OF THE
254: * TWO INPUT FILES, ADDING IT TO THE APPROPRIATE LIST AND ATTEMPTING
255: * TO MATCH A CURRENT LINE AGAINST LINES HELD FOR THE OTHER FILE.
256: * AT ALL TIMES SUFFICIENT LINES ARE KEPT FOLLOWING THE CURRENT LINE
257: * SO THAT A COMPLETE MATCH CHECK CAN BE MADE.
258: *
259: DIFF CURRENT(THATL) = ADD(THATL,THAT)
260: *
261: * MERGE AGAIN AFTER DEALING WITH ONE DIFFERENCE TO DO ANOTHER
262: *
263: ENTER CURRENT(THISL) = ADD(THISL,THIS)
264: *
265: * ENTER ANOTHER LINE INTO THISL LIST, ADVANCE CURRENT(THISL)
266: * TO CORRESPOND AND SEE IF NEW CURRENT LINE MATCHES
267: * ANY LINE IN OTHER LIST. THIS FILE IS EXHAUSTED EITHER IF
268: * CURRENT IS ALREADY NULL OR IF LINK OF CURRENT IS NULL.
269: *
270: PHASE2 ADD(THISL,THIS = $INP(THISL))
271: (IDENT(X = CURRENT(THISL)),IDENT(X = CURRENT(THISL)
272: + = LINK(X))) :S(THISEND)
273: *
274: * LOOP HERE TILL NN LINES AVAILABLE INCLUDING "CURRENT" LINE
275: * OF EACH LIST SO THAT MATCH TEST CAN BE DONE.
276: *
277: ADD1 LE(NN + 1,COUNT(THISL)) :S(ADD2)
278: ADD(THISL,$INP(THISL)) :S(ADD1)
279: ADD2 LE(NN,COUNT(THATL)) :S(TRYMAT)
280: ADD(THATL,$INP(THATL)) :S(ADD2)
281: *
282: * ATTEMPT A MATCH
283: *
284: TRYMAT X = MATCH(OBJECT(X)) :S(PHASE3)
285: *
286: * ARRIVE HERE WHILST STILL ATTEMPTING MATCH. IF END FILE NOT READ
287: * ON THAT LIST THEN SWAP LISTS AND TRY MATCHING USING IT INSTEAD.
288: *
289: DIFFER(EOF(THATL)) :S(PHASE2)
290: X = THISL; THISL = THATL; THATL = X :(PHASE2)
291: *
292: * MATCH ATTEMPT WAS SUCCESSFUL SO OUTPUT THIS LIST
293: * AND PORTION OF THAT LIST UP TO AND INCLUDING MATCHING LINE.
294: * THEN ADVANCE HEAD OF THATL PAST THE FURTHER NN-1 LINES MATCHED
295: * WHICH ARE NO LONGER OF INTEREST AND CLEAR THISL SINCE ALL ITS LINES
296: * ARE DEALT WITH.
297: *
298: PHASE3 Y = CURRENT(THATL)
299: CURRENT(THATL) = (IDENT(NNP) X,THAPT)
300: CURRENT(THISL) = DIFFER(NNP) TAIL(THISL)
301: PUT()
302: CURRENT(THATL) = Y
303: HEAD(THATL) = LINK(THAPT)
304: COUNT = COUNT(THATL) = COUNT(THATL) - CDEC
305: CURRENT(THATL) = LT(COUNT,NN) HEAD(THATL)
306: HEAD(THISL) = COUNT(THISL) =
307: *
308: * NOW POSITION FILES TO ANOTHER DIFFERENCE OR UNTIL THATL EMPTY.
309: * RIGHT NOW, THISL IS EMPTY.
310: *
311: POSIT IDENT(X = HEAD(THATL)) :S(PHASE1)
312: THIS = $INP(THISL) :F(THISEND)
313: IDENT(THIS,OBJECT(X)) :F(ENTER)
314: HEAD(THATL) = LINK(X)
315: CURRENT(THATL) = LT(COUNT(THATL) = COUNT(THATL) - 1,NN) HEAD(THATL)
316: + :(POSIT)
317: *
318: * HERE TO SET EOF FLAG FOR THISL. DONE BY SWAPPING LISTS
319: * AND JUMPING INTO CODE FOR THATL.
320: *
321: THISEND X = THISL; THISL = THATL; THATL = X :(EOF)
322: *
323: * MARK ENDFILE OF THATL BY SETTING EOF NON-NULL.
324: * ON ARRIVAL HERE FIRST STORE LINE JUST READ FROM THIS FILE
325: *
326: THATEND CURRENT(THISL) = ADD(THISL,THIS)
327: *
328: * TEST FOR END CONDITION WHICH IS THAT WE HAVE EOF ON BOTH LISTS.
329: * WE KNOW WE HAVE EOF ON THAT LIST SINCE WE ARE ABOUT TO SET FLAG.
330: *
331: *
332: EOF EOF(THATL) = "EOF"
333: IDENT(EOF(THISL)) :S(PHASE2)
334: *
335: * EOF REACHED ON BOTH FILES. OUTPUT BOTH LISTS AND PACK UP.
336: *
337: IDENT(HEAD(THISL),IDENT(HEAD(THATL))) :S(CLOSE)
338: CURRENT(THISL) = TAIL(THISL)
339: CURRENT(THATL) = TAIL(THATL)
340: PUT()
341: *
342: * FINISH BY TYPING OUT DIFFERENCE COUNT
343: *
344: CLOSE TERMINAL = IDENT(DIFFS) "NO DIFFERENCES FOUND" :F(DIFFS)
345: OUT = DIFFER(BATCH) TERMINAL :(STOP)
346: *
347: DIFFS OUT = STSTARS
348: TERMINAL = "% " DIFFS " DIFFERENCE" (NE(DIFFS,1) "S",) " FOUND"
349: OUT = DIFFER(BATCH) TERMINAL
350: *
351: STOP TERMINAL = DEFINE("OUTFIL(LISTX,MARK,STARS)X")
352: + DEFINE("PUT()X,Y,XO,YO") :(INIT)
353: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.