[BACK]Return to kernal.fs CVS log [TXT] [DIR] Up to [gforth] / gforth

Diff for /gforth/Attic/kernal.fs between versions 1.25 and 1.27

version 1.25, 1994/11/15 16:54:56 version 1.27, 1995/01/30 18:47:52
Line 1197  create pathfilenamebuf 256 chars allot \ Line 1197  create pathfilenamebuf 256 chars allot \
     0<> -&38 and throw ( file-id u2 )      0<> -&38 and throw ( file-id u2 )
     pathfilenamebuf swap ;      pathfilenamebuf swap ;
   
 : included ( i*x addr u -- j*x )  create included-files 0 , 0 , ( pointer to and count of included files )
   
   : included? ( c-addr u -- f )
       \ true, iff filename c-addr u is in included-files
       included-files 2@ 0
       ?do ( c-addr u addr )
           dup >r 2@ 2over compare 0=
           if
               2drop rdrop unloop
               true EXIT
           then
           r> cell+ cell+
       loop
       2drop drop false ;
   
   : add-included-file ( c-addr u -- )
       \ add name c-addr u to included-files
       included-files 2@ tuck 1+ 2* cells resize throw
       swap 2dup 1+ included-files 2!
       2* cells + 2! ;
   
   : save-string           ( addr1 u -- addr2 u )
       swap >r
       dup allocate throw
       swap 2dup r> -rot move ;
   
   : included1 ( i*x file-id c-addr u -- j*x )
       \ include the file file-id with the name given by c-addr u
     loadfilename 2@ >r >r      loadfilename 2@ >r >r
     open-path-file ( file-id c-addr2 u2 )      save-string 2dup loadfilename 2! add-included-file ( file-id )
     dup allocate throw over loadfilename 2! ( file-id c-addr2 u2 )  
     drop loadfilename 2@ move  
     ['] include-file catch      ['] include-file catch
     \ don't free filenames; they don't take much space  
     \ and are used for debugging  
     r> r> loadfilename 2!  throw ;      r> r> loadfilename 2!  throw ;
       
   : included ( i*x addr u -- j*x )
       open-path-file included1 ;
   
   : required ( i*x addr u -- j*x )
       \ include the file with the name given by addr u, if it is not
       \ included already. Currently this works by comparing the name of
       \ the file (with path) against the names of earlier included
       \ files; however, it would probably be better to fstat the file,
       \ and compare the device and inode. The advantages would be: no
       \ problems with several paths to the same file (e.g., due to
       \ links) and we would catch files included with include-file and
       \ write a require-file.
       open-path-file 2dup included?
       if
           2drop close-file throw
       else
           included1
       then ;
   
 \ HEX DECIMAL                                           2may93jaw  \ HEX DECIMAL                                           2may93jaw
   
Line 1222  create pathfilenamebuf 256 chars allot \ Line 1264  create pathfilenamebuf 256 chars allot \
 : include  ( "file" -- )  : include  ( "file" -- )
   name included ;    name included ;
   
   : require  ( "file" -- )
     name required ;
   
 \ RECURSE                                               17may93jaw  \ RECURSE                                               17may93jaw
   
 : recurse ( -- )  : recurse ( -- )
Line 1421  Defer 'cold ' noop IS 'cold Line 1466  Defer 'cold ' noop IS 'cold
     ." GNU Forth 0.0alpha, Copyright (C) 1994 Free Software Foundation, Inc." cr      ." GNU Forth 0.0alpha, Copyright (C) 1994 Free Software Foundation, Inc." cr
     ." GNU Forth comes with ABSOLUTELY NO WARRANTY; for details type `license'" cr      ." GNU Forth comes with ABSOLUTELY NO WARRANTY; for details type `license'" cr
     ." Type `bye' to exit"      ." Type `bye' to exit"
     quit ;      loadline off quit ;
   
 : license ( -- ) cr  : license ( -- ) cr
  ." This program is free software; you can redistribute it and/or modify" cr   ." This program is free software; you can redistribute it and/or modify" cr
Removed from v.1.25  
changed lines
  Added in v.1.27

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>