home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / program / 18 / forthsup / compare.fth < prev    next >
Encoding:
Text File  |  1986-09-18  |  732 b   |  25 lines
  1. \ File comparison.  Silent if the files are the same, messages if they
  2. \ are different.
  3. \
  4. \ Use: comparing file1 file2
  5.  
  6. variable file1  variable file2
  7. : fcompare ( fd1 fd2 -- )
  8.    file2 !  file1 !
  9.    begin
  10.          file1 @ fgetc  file2 @ fgetc 2dup =
  11.    while
  12.          drop -1 =  if  exit  then
  13.    repeat   ( char1 char2 )
  14.    2dup
  15.    -1 =  if  ." End of file on file 2"  drop 2drop  exit then  ( ch1 ch2 ch1)
  16.    -1 =  if  ." End of file on file 1"       2drop  exit then  ( ch1 ch2 )
  17.    decimal ." Files differ at position " file1 @ ftell l. cr
  18.    hex swap ." File1: " .  ." File2: " . cr
  19. ;
  20. : comparing  \ file1 file2  ( -- )
  21.    reading  ifd @   reading  ifd @  ( fd1 fd2 )
  22.    2dup fcompare
  23.    close close
  24. ;
  25.