Annotation of gforth/kernel/require.fs, revision 1.12

1.1       anton       1: \ require.fs
                      2: 
1.5       anton       3: \ Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
1.1       anton       4: 
                      5: \ This file is part of Gforth.
                      6: 
                      7: \ Gforth is free software; you can redistribute it and/or
                      8: \ modify it under the terms of the GNU General Public License
                      9: \ as published by the Free Software Foundation; either version 2
                     10: \ of the License, or (at your option) any later version.
                     11: 
                     12: \ This program is distributed in the hope that it will be useful,
                     13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
                     14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     15: \ GNU General Public License for more details.
                     16: 
                     17: \ You should have received a copy of the GNU General Public License
                     18: \ along with this program; if not, write to the Free Software
                     19: \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                     20: 
                     21: \ Now: Kernel Module, Reloadable
                     22: 
                     23: create included-files 0 , 0 , ( pointer to and count of included files )
1.8       jwilke     24: \ here ," ./the terminal" dup c@ swap 1 + swap , A, here 2 cells -
                     25: \ ./ is confusing for the search path stuff! There should be never a .
                     26: \ in sourcefilename....
                     27: here ," #terminal#" dup c@ swap 1 + swap , A, here 2 cells -
1.1       anton      28: create image-included-files  1 , A, ( pointer to and count of included files )
                     29: \ included-files points to ALLOCATEd space, while image-included-files
                     30: \ points to ALLOTed objects, so it survives a save-system
                     31: 
1.11      anton      32: : loadfilename ( -- a-addr ) \ gforth-internal
1.9       crook      33:     \G @i{a-addr} @code{2@@} produces the current file name ( @i{c-addr u} )
1.1       anton      34:     included-files 2@ loadfilename# @ min 2* cells + ;
                     35: 
                     36: : sourcefilename ( -- c-addr u ) \ gforth
1.7       crook      37:     \G The name of the source file which is currently the input
1.1       anton      38:     \G source.  The result is valid only while the file is being
                     39:     \G loaded.  If the current input source is no (stream) file, the
1.11      anton      40:     \G result is undefined.  In Gforth, the result is valid during the
                     41:     \G whole seesion (but not across @code{savesystem} etc.).
1.1       anton      42:     loadfilename 2@ ;
                     43: 
                     44: : sourceline# ( -- u ) \ gforth                sourceline-number
1.7       crook      45:     \G The line number of the line that is currently being interpreted
1.1       anton      46:     \G from a (stream) file. The first line has the number 1. If the
1.7       crook      47:     \G current input source is not a (stream) file, the result is
1.1       anton      48:     \G undefined.
                     49:     loadline @ ;
                     50: 
1.11      anton      51: : init-included-files ( -- ) \ gforth-internal
1.1       anton      52:     image-included-files 2@ 2* cells save-mem drop ( addr )
                     53:     image-included-files 2@ nip included-files 2! ;
                     54: 
                     55: : included? ( c-addr u -- f ) \ gforth
1.7       crook      56:     \G True only if the file @var{c-addr u} is in the list of earlier
                     57:     \G included files. If the file has been loaded, it may have been
1.9       crook      58:     \G specified as, say, @file{foo.fs} and found somewhere on the
                     59:     \G Forth search path. To return @code{true} from @code{included?},
                     60:     \G you must specify the exact path to the file, even if that is
                     61:     \G @file{./foo.fs}
1.1       anton      62:     included-files 2@ 0
                     63:     ?do ( c-addr u addr )
                     64:        dup >r 2@ 2over compare 0=
                     65:        if
                     66:            2drop rdrop unloop
                     67:            true EXIT
                     68:        then
                     69:        r> cell+ cell+
                     70:     loop
                     71:     2drop drop false ;
                     72: 
                     73: : add-included-file ( c-addr u -- ) \ gforth
                     74:     \G add name c-addr u to included-files
                     75:     included-files 2@ 2* cells 2 cells extend-mem
                     76:     2/ cell / included-files 2!
                     77:     2! ;
                     78: 
                     79: : included1 ( i*x file-id c-addr u -- j*x ) \ gforth
1.7       crook      80:     \G Include the file file-id with the name given by @var{c-addr u}.
1.1       anton      81:     loadfilename# @ >r
                     82:     save-mem add-included-file ( file-id )
                     83:     included-files 2@ nip 1- loadfilename# !
                     84:     ['] include-file catch
                     85:     r> loadfilename# !
                     86:     throw ;
                     87:     
1.7       crook      88: : included ( i*x c-addr u -- j*x ) \ file
1.4       anton      89:     \G @code{include-file} the file whose name is given by the string
1.7       crook      90:     \G @var{c-addr u}.
1.3       jwilke     91:     open-fpath-file throw included1 ;
1.1       anton      92: 
                     93: : required ( i*x addr u -- j*x ) \ gforth
1.7       crook      94:     \G @code{include-file} the file with the name given by @var{addr
                     95:     \G u}, if it is not @code{included} (or @code{required})
                     96:     \G already. Currently this works by comparing the name of the file
                     97:     \G (with path) against the names of earlier included files.
1.4       anton      98:     \ however, it may be better to fstat the file,
                     99:     \ and compare the device and inode. The advantages would be: no
                    100:     \ problems with several paths to the same file (e.g., due to
                    101:     \ links) and we would catch files included with include-file and
                    102:     \ write a require-file.
1.3       jwilke    103:     open-fpath-file throw 2dup included?
1.1       anton     104:     if
                    105:        2drop close-file throw
                    106:     else
                    107:        included1
                    108:     then ;
                    109: 
                    110: \ INCLUDE                                               9may93jaw
                    111: 
1.4       anton     112: : include  ( ... "file" -- ... ) \ gforth
1.7       crook     113:     \G @code{include-file} the file @var{file}.
                    114:     name included ;
1.1       anton     115: 
1.4       anton     116: : require  ( ... "file" -- ... ) \ gforth
1.7       crook     117:     \G @code{include-file} @var{file} only if it is not included already.
                    118:     name required ;
1.1       anton     119: 
1.12    ! anton     120: \ : \I
        !           121: \   here 
        !           122: \   0 word count
        !           123: \   string,
        !           124: \   needsrcs^ @ ! ;
1.1       anton     125: 
1.12    ! anton     126: \ : .included ( -- ) \ gforth
        !           127: \     \G list the names of the files that have been @code{included}
        !           128: \   cr
        !           129: \   needs^ @
        !           130: \   BEGIN              dup 
        !           131: \   WHILE              dup cell+ count type cr
        !           132: \              5 spaces
        !           133: \              dup cell+ count + aligned
        !           134: \              @ dup IF count type ELSE drop THEN cr
        !           135: \              @
        !           136: \   REPEAT
        !           137: \   drop ;
1.1       anton     138: 
1.12    ! anton     139: \ : loadfilename#>str ( n -- adr len )
        !           140: \ \ this converts the filenumber into the string
        !           141: \   loadfilenamecount @ swap -
        !           142: \   needs^ @
        !           143: \   swap 0 ?DO dup 0= IF LEAVE THEN @ LOOP 
        !           144: \   dup IF cell+ count ELSE drop s" NOT FOUND" THEN ;
1.1       anton     145: 
                    146: : loadfilename#>str ( n -- adr len )
                    147:     included-files 2@ drop swap 2* cells + 2@ ;
                    148: 
1.10      anton     149: : .included ( -- ) \ gforth
                    150:     \G list the names of the files that have been @code{included}
1.1       anton     151:     included-files 2@ 2* cells bounds ?DO
                    152:        cr I 2@ type  2 cells +LOOP ;  
                    153: 
                    154: \ contains tools/newrequire.fs
1.12    ! anton     155: \ \I $Id: require.fs,v 1.11 2000/08/17 12:46:59 anton Exp $
1.1       anton     156: 

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