home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TPA2_A.ZIP / COMPARE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-02-11  |  6.4 KB  |  183 lines
  1. {═════════════════════════ COMPARE.PAS ═════════════════════════}
  2. { Usage:  Compare fname1.ext fname2.ext                         }
  3. {  (Use "Options Parameters" when run from Editor)              }
  4. {═════════════════════════ COMPARE.PAS ═════════════════════════}
  5.  
  6. {- Compare two files and set errorlevel if they differ.  Also   }
  7. {- display a Hex and Ascii comparison of the first 15 bytes     }
  8. {- following a miscompare.  Demonstrates calling a Pascal       }
  9. {- Procedure (DumpBytes) from within Assemble.                  }
  10.  
  11.  
  12. {══════════════════════════ HexDigits ══════════════════════════}
  13. CONST  HexDigits: ARRAY[0..15] OF CHAR = '0123456789ABCDEF';
  14.  
  15. {═══════════════════════════ HexByte ═══════════════════════════}
  16. TYPE St2 = STRING[2];
  17. FUNCTION HexByte(SrcB: BYTE): St2;
  18. BEGIN
  19.   HexByte := HexDigits[SrcB Shr 4] + HexDigits[SrcB AND $F];
  20. END; {FUNCTION HexByte}
  21.  
  22. {═══════════════════════════ HexWord ═══════════════════════════}
  23. TYPE St4 = STRING[4];
  24. FUNCTION HexWord(SrcW: INTEGER): St4;
  25. BEGIN
  26.   HexWord := HexByte(Hi(SrcW)) + HexByte(Lo(SrcW));
  27. END; {FUNCTION HexByte}
  28.  
  29. {══════════════════════════ DumpBytes ══════════════════════════}
  30. {  Dump 16 byte comparison in Hex and Ascii                     }
  31. {══════════════════════════ DumpBytes ══════════════════════════}
  32. PROCEDURE DumpBytes(Offset: INTEGER; Var B1,B2: BYTE);
  33. VAR n,b: BYTE;
  34. BEGIN
  35.   WRITELN( 'First compare error at Offset: ',HexWord(Offset) );
  36.  
  37.   WRITE('F1: ');
  38.   FOR n := 0 TO 15 DO WRITE(' ',HexByte(Mem[Seg(B1):Ofs(B1)+n]));
  39.   WRITE('    ');
  40.   FOR n := 0 TO 15 DO BEGIN
  41.     b := Mem[Seg(B1):Ofs(B1)+n];
  42.     IF b < 32 THEN WRITE('·') {- avoid certain unprintable characters -}
  43.               ELSE WRITE(Chr(b));
  44.   END; {FOR n := 0 TO 15 DO }
  45.   WRITELN;
  46.  
  47.   WRITE('F2: ');
  48.   FOR n := 0 TO 15 DO WRITE(' ',HexByte(Mem[Seg(B2):Ofs(B2)+n]));
  49.   WRITE('    ');
  50.   FOR n := 0 TO 15 DO BEGIN
  51.     b := Mem[Seg(B2):Ofs(B2)+n];
  52.     IF b < 32 THEN WRITE('·') {- avoid certain unprintable characters -}
  53.               ELSE WRITE(Chr(b));
  54.   END; {FOR n := 0 TO 15 DO }
  55.   WRITELN;
  56. END; {PROCEDURE DumpBytes}
  57.  
  58.  
  59. {══════════════════════════ Identical ══════════════════════════}
  60. {  Compare COUNT bytes at address V1 with bytes at address V2   }
  61. {    Matches calling convention for Standard Procedure Move     }
  62. {  Calls Pascal Procedure DumpBytes to display differences if   }
  63. {  files are not identical.                                     }
  64. {══════════════════════════ Identical ══════════════════════════}
  65. FUNCTION Identical(VAR V1,V2; Count: INTEGER): BOOLEAN;
  66. BEGIN
  67. ASSEMBLE
  68.   Cld
  69.   Mov Identical,TRUE
  70.   Push Ds
  71.   Mov Cx,Count
  72.   Les Di,V1
  73.   Lds Si,V2      ;GLOBAL Pascal symbols unavailable until we Pop Ds again
  74.   RepE CmpsB
  75.  
  76.   Mov Dx,Ds      ;Save Seg(V2)       Preserves Flags
  77.   Pop Ds         ;restore Turbo Ds   Preserves Flags
  78.   jE Finish      ; (using flags from RepE CmpsB)
  79.  
  80.   Mov Identical,FALSE
  81.   Dec Di,Si      ; Undo implicit 'Inc Di,Si' from last CmpsB
  82.   Mov Ax,Di      ; compute offset of first miscompare
  83.   Sub Ax,W V1    ;'W V1' uses low Word of V1 (overrides Dword definition)
  84.  
  85. ; Push registers you want preserved
  86. ;   (Ax,Bx,Cx,Dx,Di,Si, and Es may be modified by the Pascal Proc/Function)
  87.  
  88.    ; Now Push Parameters for Pascal Proc call
  89.    ; Multiple operands to Push, Pop, Inc, Dec
  90.    ; - A86 specialty supported for compatibility
  91.   Push Ax, Es,Di, Dx,Si ; Push Offset, Ptr(Byte in File1), Ptr(Byte in File2)
  92.  
  93.   Call DumpBytes          ; Display byte comparison and remove parameters
  94.  
  95. ; Pop registers you pushed above
  96.  
  97. Finish:
  98. END; {Assemble}
  99. END; {FUNCTION Identical(Var V1,V2; Count:WORD);}
  100.  
  101.  
  102. {══════════════════════════ MaxAvailK ══════════════════════════}
  103. {  Size of largest available block on heap in 1K (1024) units   }
  104. {   Corrects for differences in Version 3/Version 4 MaxAvail    }
  105. {══════════════════════════ MaxAvailK ══════════════════════════}
  106. FUNCTION MaxAvailK: INTEGER; BEGIN
  107.   IF $FFFF > 0 THEN MaxAvailK := MaxAvail SHR 10  {- Version 4 -}
  108.                ELSE MaxAvailK := MaxAvail SHR  6; {- Version 3 -}
  109. END; {FUNCTION MaxAvailK: INTEGER;}
  110.  
  111.  
  112. TYPE
  113.   BufferType= ARRAY[1..$7FFF] OF BYTE; {- 32767 bytes -}
  114.  
  115. VAR
  116.   Buffer1,Buffer2: ^BufferType;
  117.   File1,File2: File;
  118.   Size1,Size2: INTEGER;
  119.  
  120.  
  121. BEGIN {MAIN}
  122.   IF MaxAvailK < 65 THEN BEGIN
  123.     WRITELN('This Demonstration requires 64K available memory');
  124.     WRITELN('Version 4 users, try using the command line compiler as follows:');
  125.     WRITELN('A>tpam tpc compare /r"fname1.ext fname2.ext"      - OR -');
  126.     WRITELN('A>tpam c compare /r"fname1.ext fname2.ext"');
  127.     Halt(3);
  128.   END; {IF MaxAvailK < 65 THEN }
  129.  
  130.   IF ParamCount<>2 THEN BEGIN
  131.     WRITELN('Invalid number of parameters');
  132.     IF ParamCount=0
  133.     THEN WRITELN('(Use "Options Parameters" to run from the Editor)');
  134.     Halt(2);
  135.   END; {IF ParamCount=0 THEN }
  136.  
  137.   New(Buffer1);  New(Buffer2);
  138.  
  139. {$I-}
  140.   Assign(File1,ParamStr(1)); Reset(File1,1);
  141.   IF IOresult<>0 THEN BEGIN
  142.     WRITELN('File ',ParamStr(1),' not found');  Halt(2);
  143.   END; {IF IOresult<>0 THEN }
  144.  
  145.   Assign(File2,ParamStr(2)); Reset(File2,1);
  146.   IF IOresult<>0 THEN BEGIN
  147.     WRITELN('File ',ParamStr(2),' not found');  Halt(2);
  148.   END; {IF IOresult<>0 THEN }
  149. {$I+}
  150.  
  151.   BlockRead(File1,Buffer1^,SizeOf(Buffer1^),Size1);
  152.   BlockRead(File2,Buffer2^,SizeOf(Buffer2^),Size2);
  153.  
  154.   IF (Size1 = SizeOf(Buffer1^)) OR (Size2 = SizeOf(Buffer2^)) THEN BEGIN
  155.     IF (Size1 = SizeOf(Buffer1^)) THEN WRITE('File ',ParamStr(1))
  156.                                   ELSE WRITE('File ',ParamStr(2));
  157.     WRITELN(' is too large');
  158.     WRITELN('This Demonstration limited to files smaller than 32K');  Halt(2);
  159.   END; {IF (Size1 = SizeOf(Buffer1^)) OR (Size2 = SizeOf(Buffer2^)) THEN }
  160.  
  161.   WRITELN(Size1,' Bytes in file F1: ',ParamStr(1));
  162.   WRITELN(Size2,' Bytes in file F2: ',ParamStr(2));
  163.  
  164.   IF Size1<>Size2 THEN BEGIN
  165.     IF Size1<Size2
  166.     THEN IF Identical(Buffer1^,Buffer2^,Size1)
  167.          THEN WRITELN('Bytes left in F2')
  168.          ELSE WRITELN('Files are different')
  169.     ELSE IF Identical(Buffer1^,Buffer2^,Size2)
  170.          THEN WRITELN('Bytes left in F1')
  171.          ELSE WRITELN('Files are different');
  172.     Halt(1);
  173.   END; {IF Size1<>Size2 THEN }
  174.  
  175.   IF Identical(Buffer1^,Buffer2^,Size1) THEN BEGIN
  176.     WRITELN('Files are identical'); Halt(0);
  177.   END {IF Identical(Buffer1^,Buffer2^,Size1) THEN }
  178.   ELSE BEGIN
  179.     WRITELN('Files are different'); Halt(1);
  180.   END; {ELSE }
  181.  
  182. END.
  183.