|
DataMuseum.dkPresents historical artifacts from the history of: DANOSI |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about DANOSI Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 18763 (0x494b)
Types: TextFile
Names: »COMPARE.PAS«
└─⟦e2123b2a1⟧ Bits:30010498 DVBS1.SW2103.src.1.8-1 Pascal TOOLS JTAS 1989-04-26 LEIF NIELSEN E.d.
└─⟦this⟧ »COMPARE.PAS«
{[A=20,I=2,L=4,E=3,W=1-100] PASCFORM direktiv }\r
PROGRAM Compare(FileA, FileB, Output);\r
\r
{ Original text occured in: Pascal News #12 p. 20-23.\r
Made arround 1978-03-01 by James F. Miner,\r
Social Science Research, Univ. of Minnesota.\r
\r
Corrections and additions made by Willett Kempton,\r
Univ. of California, Berkley\r
occured in: Pascal News #15 p. 28-30, September 1979,\r
and these additions are included.\r
\r
Retyped and modifyed to fit Borland Turbo Pascal\r
1988-04-09 by Hans JЏrgen Jakobsen JTAS, Јrhus, Denmark.\r
----------------------------------------------------------------------------\r
Date. Init. Vers. Explanation.\r
\r
1989-02-04 LEI 1.4 Improved call parameter processing.\r
1989-04-24 LEI 1.5 Check for Heap owerflow inserted.\r
---------------------------------------------------------------------------}\r
\r
{$M 16000, 0, 655000 }\r
{$R+,S+}\r
\r
USES\r
Dos,\r
Param,\r
Dosutil,\r
Help;\r
\r
\r
CONST\r
Version = '1.5';\r
Linelength = 140; { Maximum significant input line length }\r
\r
MaxParam = 2;\r
MaxOption = 4;\r
\r
ParamList : ARRAY[1..MaxParam] OF ParamRec =\r
((Kind:KnownFile; Defined:FALSE; KeyWord:'A'; NumVal:0; TextVal:''),\r
(Kind:KnownFile; Defined:FALSE; KeyWord:'B'; NumVal:0; TextVal:''));\r
\r
OptionList : ARRAY[1..MaxOption] OF ParamRec =\r
((Kind:Numeric; Defined:FALSE ;KeyWord:'LINES';NumVal:6;TextVal:''),\r
(Kind:OnOff; Defined:FALSE ;KeyWord:'MARK';NumVal:0;TextVal:'OFF'),\r
(Kind:OnOff; Defined:FALSE ;KeyWord:'TRAILING';NumVal:0;TextVal:'OFF'),\r
(Kind:OnOff; Defined:FALSE ;KeyWord:'XRAY';NumVal:0;TextVal:'OFF') );\r
\r
\r
TYPE\r
LinePointer = ^Line; { Single line buffer }\r
Line =\r
PACKED RECORD\r
NextLine : LinePointer;\r
Length : 0 .. LineLength;\r
Image : STRING[LineLength];\r
END;\r
Stream = { Bookkeeping for each input file }\r
RECORD\r
Name : Char;\r
Cursor, Head, Tail: LinePointer;\r
CursorLineNo, HeadLineNo, TailLineNo: Integer;\r
Endfile : Boolean;\r
END;\r
\r
VAR\r
FileA, FileB: text;\r
FileABuffer, FileBBuffer: ARRAY[1..4096] OF char;\r
A, B: Stream;\r
Match: Boolean;\r
Endfile: Boolean; { Set if end of stream A or B }\r
\r
Test_requested: boolean;\r
\r
InitialFree: longint; { Heap available for line storage }\r
\r
Templine:\r
RECORD { Used by readline }\r
Length: Integer;\r
Image: STRING[LineLength]\r
END;\r
\r
FreeLines: LinePointer; { Free list of line buffers }\r
\r
Same: Boolean; { FALSE if no mis-match occur }\r
\r
LinesTooLong: Boolean;\r
\r
Inname1, Inname2: STRING[255];\r
\r
MinLinesForMatch: integer; { Number of consecutive equivalent lines }\r
{ to end a mis-match }\r
MarkUnequalColumns: Boolean; { If unequal lines are to be paired, }\r
{ and unequal columns marked }\r
TrailingBlanksIgnored: Boolean; { If trailing blanks not matched }\r
\r
Date: DateTime;\r
CurrentDateText: STRING[20];\r
\r
FUNCTION FullFileName(part_name: STRING): STRING;\r
VAR\r
SR: SearchRec;\r
dt: DateTime;\r
\r
BEGIN\r
FindFirst(part_name, 0, SR);\r
UnpackTime( SR.time, dt);\r
\r
FullFileName := FExpand(part_name) + ' (' + DateTimeText(dt) + ')';\r
\r
END {FullFileName };\r
\r
\r
PROCEDURE CompareFiles;\r
\r
FUNCTION EndStream(VAR X: Stream): Boolean;\r
BEGIN { EndStream }\r
EndStream := (X.Cursor = NIL) AND X.EndFile\r
END; { EndStream }\r
\r
PROCEDURE Mark(VAR X: Stream);\r
{ Causes beginning of stream to be positioned before }\r
{ current stream cursor. Buffers get reclaimed, line }\r
{ counters reset, etc. }\r
VAR\r
P: LinePointer;\r
BEGIN { Mark }\r
WITH X DO\r
IF Head <> NIL THEN\r
BEGIN\r
WHILE Head <> Cursor DO { Reclaim Buffer }\r
BEGIN\r
WITH Head^ DO\r
BEGIN\r
P := NextLine;\r
NextLine := FreeLines;\r
FreeLines := Head;\r
END; { WITH }\r
Head := P;\r
END; { WHILE }\r
HeadLineNo := CursorLineNo;\r
IF Cursor = NIL THEN\r
BEGIN\r
Tail := NIL;\r
TailLineNO := CursorLineNo;\r
END;\r
END; { IF Head }\r
END; { Mark }\r
\r
PROCEDURE MoveCursor(VAR X: Stream; VAR FileX: Text);\r
{ FileX is the input file associated with stream X. The }\r
{ cursor for x is moved forwaard one line. Reading from X }\r
{ if necessary, and incrementing the line count. Endfile }\r
{ is set if eof is encountered on either stream. }\r
PROCEDURE ReadLine;\r
VAR\r
NewLine: LinePointer;\r
C, C2: 0 .. LineLength;\r
BEGIN { ReadLine }\r
IF NOT X.EndFile THEN\r
BEGIN\r
C := 0;\r
NewLine := FreeLines;\r
IF NewLine = NIL THEN\r
BEGIN\r
IF MaxAvail <= SizeOf( Line) THEN\r
BEGIN\r
Writeln(' Run out of Heap storage. COMPARE aborted. ');\r
halt;\r
END\r
ELSE\r
New(NewLine);\r
END\r
ELSE\r
FreeLines := FreeLines^.NextLine;\r
NewLine^.Image[0] := Chr(LineLength);\r
readln(FileX, NewLine^.Image);\r
\r
(* WHILE NOT Eoln(FileX) AND (C < LineLength) DO\r
BEGIN\r
C := C + 1;\r
Read(FileX, NewLine^.Image[C]);\r
END; { WHILE }\r
IF NOT Eoln(FileX) THEN LinesTooLong := True;\r
ReadLn(FileX);\r
*)\r
C := ord(NewLine^.Image[0]);\r
LinesTooLong := C >= LineLength;\r
IF TrailingBlanksIgnored THEN\r
BEGIN\r
WHILE NewLine^.Image[C] = ' ' DO C := C - 1;\r
NewLine^.Image[0] := Chr(C);\r
END;\r
NewLine^.Length := C;\r
NewLine^.NextLine := NIL;\r
IF X.Tail = NIL THEN\r
BEGIN\r
X.Head := NewLine;\r
X.TailLineNo := 1;\r
X.HeadLineNo := 1;\r
END\r
ELSE\r
BEGIN\r
X.Tail^.NextLine := NewLine;\r
X.TailLineNo := X.TailLineNo + 1;\r
END;\r
X.Tail := NewLine;\r
X.EndFile := Eof(FileX);\r
END; { IF }\r
END; { ReadLine }\r
\r
BEGIN { MoveCursor }\r
IF X.Cursor <> NIL THEN\r
BEGIN\r
IF X.Cursor = X.Tail THEN ReadLine;\r
X.Cursor := X.Cursor^.NextLine;\r
IF X.Cursor = NIL THEN EndFIle := True;\r
X.CursorLineNo := X.CursorLineNo + 1;\r
END\r
ELSE\r
IF NOT X.EndFile THEN { Begining of stream }\r
BEGIN\r
ReadLine;\r
X.Cursor := X.Head;\r
X.CursorLineNo := X.HeadLineNo;\r
END\r
ELSE { End of stream }\r
EndFile := True;\r
END; { MoveCursor }\r
\r
PROCEDURE BackTrack(VAR X: Stream; VAR XLines: Integer);\r
{ Causes the current position of stream x to become that }\r
{ of the last mark operation. I. E. the current line }\r
{ when the stream was marked last becommes the new cursor. }\r
{ XLines is set to the number of lines from the new cursor }\r
{ to the old cursor inclusive. }\r
BEGIN { BackTrack }\r
XLines := X.CursorLineNo + 1 - X.HeadLineNo;\r
X.Cursor := X.Head;\r
X.CursorLineNo := X.HeadLineNo;\r
EndFile := EndStream(A) OR EndStream(B);\r
END; { BackTrack }\r
\r
PROCEDURE CompareLines(VAR Match : Boolean);\r
{ Compare the current lines of streams A and B, returning }\r
{ match to signal their (non-) equivalence. Eof on both streams }\r
{ is considered a match, but eof on only one stream is a mismatch }\r
BEGIN { CompareLines }\r
IF (A.Cursor = NIL) OR (B.Cursor = NIL) THEN\r
Match := EndStream(A) AND EndStream(B)\r
ELSE\r
BEGIN\r
Match := (A.Cursor^.Length = B.Cursor^.Length);\r
IF Match THEN\r
Match := (A.Cursor^.Image = B.Cursor^.Image);\r
END\r
END; { CompareLines }\r
\r
PROCEDURE FindMisMatch;\r
BEGIN { FindMisMatch }\r
{ NOT EndFile AND Match }\r
REPEAT\r
MoveCursor(A, FileA);\r
MoveCursor(B, FileB);\r
Mark(A);\r
Mark(B);\r
CompareLines(Match);\r
UNTIL EndFile OR NOT Match;\r
END; { FindMisMatch }\r
\r
PROCEDURE FindMatch;\r
VAR\r
AdvanceB: Boolean; { Toggle one-line lookahead between streams }\r
\r
PROCEDURE Search(VAR X: Stream; { Stream to search }\r
VAR FileX: Text;\r
VAR Y: Stream; { Stream to lookahead }\r
VAR FileY: Text);\r
{ Look ahead one line on stream Y, and search for that line }\r
{ backtracking on stream X }\r
\r
VAR\r
Count: Integer; { Number of lines backtracked on X }\r
\r
PROCEDURE CheckFullMatch;\r
{ From the current positions in X and Y, which match, }\r
{ make sure that the next MinLinesForMatch - 1 lines also }\r
{ match, or else set match := false }\r
VAR\r
N: Integer;\r
SaveXCur, SaveYCur: LinePointer;\r
SaveXLine, SaveYLine: Integer;\r
BEGIN { CheckFullMatch }\r
SaveXCur := X.Cursor;\r
SaveYCur := Y.Cursor;\r
SaveXLine := X.CursorLineNo;\r
SaveYLine := Y.CursorLineNo;\r
CompareLines(match);\r
N := MinLinesForMatch - 1;\r
WHILE Match AND (N <> 0) DO\r
BEGIN\r
MoveCursor(X, FileX);\r
MoveCursor(Y, FileY);\r
CompareLines(match);\r
N := N - 1;\r
END; { WHILE }\r
X.Cursor := SaveXCur;\r
Y.Cursor := SaveYCur;\r
X.CursorLineNo := SaveXLine;\r
Y.CUrsorLineNo := SaveYLine;\r
END; { CheckFullMatch }\r
\r
BEGIN { Search }\r
MoveCursor(Y, FileY);\r
BackTrack(X, Count);\r
CheckFullMatch;\r
Count := Count - 1;\r
WHILE (Count <> 0) AND NOT Match DO\r
BEGIN\r
MoveCursor(X, FileX);\r
Count := Count - 1;\r
CheckFullMatch;\r
END\r
END; { Search }\r
\r
PROCEDURE PrintMisMatch;\r
VAR\r
EmptyA, EmptyB: Boolean;\r
\r
PROCEDURE WriteOneLine(Name: Char; L: Integer; P: Linepointer);\r
BEGIN { WriteOneLIne }\r
Write(' ', Name, L:5, ' ');\r
IF P^.Length = 0 THEN WriteLn\r
ELSE WriteLn(P^.Image: P^.Length);\r
END; { WriteOneLine }\r
\r
PROCEDURE WriteText(VAR X:Stream);\r
{ Write from X.Head to one line before X.Cursor }\r
VAR\r
P, Q: LinePointer; LineNo: Integer;\r
BEGIN { WriteText }\r
P := X.Head;\r
Q := X.Cursor;\r
LineNo := X.HeadLineNo;\r
WHILE (P <> NIL) AND (P <> Q) DO\r
BEGIN\r
WriteOneLine(X.Name, LineNo, P);\r
P := P^.NextLine;\r
LineNo := LineNo + 1;\r
END; { WHILE }\r
IF p = NIL THEN WriteLn(' *** eof ***');\r
WriteLn;\r
END; { WriteText }\r
\r
PROCEDURE WritePairs (Pa, Pb: LinePointer; La, Lb: Integer);\r
{ This writes from the head to the cursor, like procedure WriteText. }\r
{ Unklike WriteText, this procedure writes from both files at once }\r
{ Compares columns within lines, and marks unequal columns }\r
VAR\r
Col, MaxCol : Integer;\r
BEGIN { WritePairs }\r
REPEAT\r
WriteOneLine('a', La, Pa);\r
WriteOneLine('b', Lb, Pb);\r
IF Pa^.Length > Pb^.Length THEN MaxCol := Pa^.Length\r
ELSE MaxCol := Pb^.Length;\r
Write(' ':11);\r
FOR Col := 1 TO MaxCol DO\r
IF Pa^.Image[Col] = Pb^.Image[Col] THEN Write(' ')\r
ELSE Write('^');\r
WriteLn;\r
WriteLn;\r
Pa := Pa^.NextLine;\r
La := La + 1;\r
Pb := Pb^.NextLine;\r
Lb := Lb + 1;\r
UNTIL (Pa= A.Cursor) OR (Pa= NIL);\r
END; { WritePairs }\r
\r
PROCEDURE WriteLineNo(VAR X: Stream);\r
VAR\r
F, L: Integer;\r
BEGIN { WriteLineNO }\r
F := X.HeadLineNo;\r
L := X.CursorLineNo - 1;\r
Write('Line');\r
IF F = L THEN Write(' ', F:1)\r
ELSE Write('s ', F:1, ' thru ', L:1);\r
IF X.Cursor = NIL THEN Write(' (before eof)');\r
END; { WriteLineNo }\r
\r
PROCEDURE PrintExtraText(VAR X: Stream;\r
VAR Y: Stream);\r
BEGIN { PrintExtraText }\r
Write(' extra text: on file', X.Name, ', ');\r
IF Y.Head = NIL THEN\r
WriteLn(' Before eof on file', Y.Name)\r
ELSE\r
WriteLn(' between lines ', Y.HeadLineNo-1:1, ' and ',\r
Y.HeadLineNo:1, ' of file', Y.Name);\r
WriteLn;\r
WriteText(X);\r
END; { PrintExtraText }\r
\r
BEGIN { PrintMisMatch }\r
WriteLn(' ':11, '********************************************');\r
EmptyA := (A.Head = A.Cursor);\r
EmptyB := (B.Head = B.Cursor);\r
IF EmptyA OR EmptyB THEN\r
IF EmptyA THEN PrintExtraText(B, A)\r
ELSE PrintExtraText(A, B)\r
ELSE\r
BEGIN\r
Write(' mismatch: ');\r
Write(' filea, ');\r
WriteLineNo(A);\r
WriteLn(' not equal to ');\r
Write(' fileb, ');\r
WriteLineNo(B);\r
WriteLn(':');\r
WriteLn;\r
IF MarkUnequalColumns AND\r
((A.CursorLineNo - A.HeadLineNo) = (B.CursorLineNo - B.HeadLineNo))\r
THEN\r
WritePairs(A.Head, B.Head, A.HeadLineNo, B.HeadLineNO)\r
ELSE\r
BEGIN\r
WriteText(A);\r
WriteText(B);\r
END;\r
END;\r
END; { PrintMisMatch }\r
\r
BEGIN { FindMatch }\r
{ NOT Match }\r
AdvanceB := True;\r
REPEAT\r
IF NOT EndFile THEN AdvanceB := NOT AdvanceB\r
ELSE AdvanceB := EndStream(A);\r
IF AdvanceB THEN Search(A, FileA, B, FileB)\r
ELSE Search(B, FileB, A, FileA)\r
UNTIL Match;\r
PrintMisMatch;\r
END; { FindMatch }\r
\r
BEGIN { CompareFiles }\r
Match := True; { I. E. Beginning-of-files match }\r
REPEAT\r
IF Match THEN FindMisMatch\r
ELSE\r
BEGIN\r
Same := False;\r
FindMatch;\r
END\r
UNTIL EndFile AND Match;\r
{ Mark(A); Mark(B); Mark end of files, thereby disposing buffers }\r
END; { CompareFiles }\r
\r
PROCEDURE Initialize;\r
\r
PROCEDURE InitStream(VAR X: Stream; VAR FileX: Text);\r
BEGIN { InitStream }\r
WITH X DO\r
BEGIN\r
Cursor := NIL;\r
Head := NIL;\r
Tail := NIL;\r
CursorLineNo := 0;\r
HeadLineNo := 0;\r
TailLineNO := 0;\r
END;\r
Reset(FileX);\r
X.EndFile := eof(FileX);\r
END; { InitStream }\r
\r
BEGIN { Initialize }\r
\r
IF ( ParamCount = 0 ) OR\r
( ParamCount >= 1) AND ( ParamStr(1 ) = '?') THEN\r
BEGIN\r
ShowHelp;\r
Halt;\r
END;\r
\r
GetParams(ParamList, MaxParam, OptionList, MaxOption);\r
\r
MinLinesForMatch := OptionList[1].NumVal;\r
MarkUnequalColumns := OptionList[2].Textval = 'ON';\r
TrailingBlanksIgnored := OptionList[3].Textval = 'OFF';\r
Test_requested := OptionList[4].Textval = 'ON';\r
\r
InName1 := ParamList[1].TextVal;\r
InName2 := ParamList[2].TextVal;\r
\r
GetSysDate(Date);\r
CurrentDateText := DateTimeText(Date);\r
\r
{ Connect Output back to std. DOS out. }\r
{ (Because Crt unit is used) }\r
{ Then it is possible to use redirection of Output. }\r
Assign(Output, '');\r
Rewrite(Output);\r
Assign(FileA, InName1);\r
SetTextBuf(FileA, FileABuffer);\r
Assign(FileB, InName2);\r
SetTextBuf(FileB, FileBBuffer);\r
InitStream(A, FileA);\r
InitStream(B, FileB);\r
A.Name := 'a';\r
B.Name := 'b';\r
LinesTooLong := False;\r
EndFile := A.EndFile OR B.EndFile;\r
same := true;\r
FreeLines := NIL;\r
TempLine.Length := LineLength;\r
{ TempLine.Image[0] := 'x'; Sentinel }\r
InitialFree := MaxAvail; { Heap free for line images }\r
END; { Initialize }\r
\r
\r
BEGIN { MAIN of Compare }\r
Initialize;\r
WriteLn(' COMPARE (v.', version,\r
') At: ', CurrentDateText);\r
WriteLn;\r
Writeln(' Filea = ', FullFileName( InName1) );\r
Writeln(' Fileb = ', FullFileName( InName2) );\r
WriteLn(' Match criterion = ', MinLinesForMatch:1, ' lines.');\r
WriteLn;\r
IF A.EndFile THEN WriteLn(' Filea is Empty');\r
IF B.EndFile THEN WriteLn(' Fileb is Empty');\r
\r
IF NOT EndFile THEN\r
BEGIN\r
CompareFiles;\r
IF Same THEN WriteLn(' No Differences.');\r
IF LinesTooLong THEN\r
BEGIN\r
WriteLn;\r
WriteLn(' WARNING: Some lines were longer than ',\r
Linelength:1, ' characters.');\r
WriteLn(' They were not compared past that point.');\r
END;\r
IF Test_requested THEN\r
writeln(' Heap storage used: ', InitialFree - MaxAvail:0 , ' bytes. ',\r
MaxAvail:0, ' bytes remaining. ');\r
END;\r
END.\r
\r