|
|
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.