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

1.1       anton       1: \ require.fs
                      2: 
1.28      anton       3: \ Copyright (C) 1995,1996,1997,1998,2000,2003 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
1.18      anton      19: \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
1.1       anton      20: 
                     21: \ Now: Kernel Module, Reloadable
                     22: 
                     23: create included-files 0 , 0 , ( pointer to and count of included files )
1.15      anton      24: \ note: these names must not contain a "/" or "\"; otherwise a part of
                     25: \ that name might be used when expanding "./" (see expandtopic).
1.25      anton      26: here ," *somewhere*" dup c@ swap 1 + swap
                     27: , A, here 2 cells -
                     28: create image-included-files 1 , A, ( pointer to and count of included files )
1.16      anton      29: \ included-files points to ALLOCATEd space, while image-included-files
                     30: \ points to ALLOTed objects, so it survives a save-system
1.1       anton      31: 
                     32: : sourcefilename ( -- c-addr u ) \ gforth
1.7       crook      33:     \G The name of the source file which is currently the input
1.1       anton      34:     \G source.  The result is valid only while the file is being
                     35:     \G loaded.  If the current input source is no (stream) file, the
1.11      anton      36:     \G result is undefined.  In Gforth, the result is valid during the
                     37:     \G whole seesion (but not across @code{savesystem} etc.).
1.24      anton      38:     loadfilename 2@ ;
1.1       anton      39: 
                     40: : sourceline# ( -- u ) \ gforth                sourceline-number
1.7       crook      41:     \G The line number of the line that is currently being interpreted
1.1       anton      42:     \G from a (stream) file. The first line has the number 1. If the
1.7       crook      43:     \G current input source is not a (stream) file, the result is
1.1       anton      44:     \G undefined.
                     45:     loadline @ ;
                     46: 
1.11      anton      47: : init-included-files ( -- ) \ gforth-internal
1.1       anton      48:     image-included-files 2@ 2* cells save-mem drop ( addr )
                     49:     image-included-files 2@ nip included-files 2! ;
                     50: 
                     51: : included? ( c-addr u -- f ) \ gforth
1.7       crook      52:     \G True only if the file @var{c-addr u} is in the list of earlier
                     53:     \G included files. If the file has been loaded, it may have been
1.9       crook      54:     \G specified as, say, @file{foo.fs} and found somewhere on the
                     55:     \G Forth search path. To return @code{true} from @code{included?},
                     56:     \G you must specify the exact path to the file, even if that is
                     57:     \G @file{./foo.fs}
1.1       anton      58:     included-files 2@ 0
                     59:     ?do ( c-addr u addr )
1.21      anton      60:        dup >r 2@ 2over str=
1.1       anton      61:        if
                     62:            2drop rdrop unloop
                     63:            true EXIT
                     64:        then
                     65:        r> cell+ cell+
                     66:     loop
                     67:     2drop drop false ;
                     68: 
                     69: : add-included-file ( c-addr u -- ) \ gforth
                     70:     \G add name c-addr u to included-files
                     71:     included-files 2@ 2* cells 2 cells extend-mem
                     72:     2/ cell / included-files 2!
                     73:     2! ;
                     74: 
1.19      pazsan     75: has? new-input [IF]
                     76: : included1 ( i*x file-id c-addr u -- j*x ) \ gforth
1.29      anton      77: \G Include the file file-id with the name given by @var{c-addr u}.
                     78:     save-mem 2dup add-included-file
                     79:     includefilename 2@ 2>r 2dup includefilename 2!
                     80:     ['] read-loop execute-parsing-named-file
                     81:     2r> includefilename 2! ;
1.19      pazsan     82: [ELSE]
1.1       anton      83: : included1 ( i*x file-id c-addr u -- j*x ) \ gforth
1.24      anton      84: \G Include the file file-id with the name given by @var{c-addr u}.
1.26      anton      85:     save-mem 2dup loadfilename>r
1.29      anton      86:     includefilename 2@ 2>r 2dup includefilename 2!
1.24      anton      87:     add-included-file ( file-id )
1.14      anton      88:     ['] include-file2 catch
1.29      anton      89:     2r> includefilename 2! r>loadfilename
1.1       anton      90:     throw ;
1.19      pazsan     91: [THEN]
                     92: 
1.30    ! pazsan     93: : included ( i*x c-addr u -- j*x ) \ file
        !            94:     \G @code{include-file} the file whose name is given by the string
        !            95:     \G @var{c-addr u}.
1.3       jwilke     96:     open-fpath-file throw included1 ;
1.1       anton      97: 
1.30    ! pazsan     98: : required ( i*x addr u -- i*x ) \ gforth
        !            99:     \G @code{include-file} the file with the name given by @var{addr
        !           100:     \G u}, if it is not @code{included} (or @code{required})
        !           101:     \G already. Currently this works by comparing the name of the file
        !           102:     \G (with path) against the names of earlier included files.
1.4       anton     103:     \ however, it may be better to fstat the file,
                    104:     \ and compare the device and inode. The advantages would be: no
                    105:     \ problems with several paths to the same file (e.g., due to
                    106:     \ links) and we would catch files included with include-file and
                    107:     \ write a require-file.
1.3       jwilke    108:     open-fpath-file throw 2dup included?
1.1       anton     109:     if
                    110:        2drop close-file throw
                    111:     else
                    112:        included1
                    113:     then ;
                    114: 
                    115: \ INCLUDE                                               9may93jaw
                    116: 
1.4       anton     117: : include  ( ... "file" -- ... ) \ gforth
1.7       crook     118:     \G @code{include-file} the file @var{file}.
1.30    ! pazsan    119:     name included ;
1.1       anton     120: 
1.4       anton     121: : require  ( ... "file" -- ... ) \ gforth
1.7       crook     122:     \G @code{include-file} @var{file} only if it is not included already.
1.30    ! pazsan    123:     name required ;
1.1       anton     124: 
1.12      anton     125: \ : \I
                    126: \   here 
                    127: \   0 word count
                    128: \   string,
                    129: \   needsrcs^ @ ! ;
1.1       anton     130: 
1.12      anton     131: \ : .included ( -- ) \ gforth
                    132: \     \G list the names of the files that have been @code{included}
                    133: \   cr
                    134: \   needs^ @
                    135: \   BEGIN              dup 
                    136: \   WHILE              dup cell+ count type cr
                    137: \              5 spaces
                    138: \              dup cell+ count + aligned
                    139: \              @ dup IF count type ELSE drop THEN cr
                    140: \              @
                    141: \   REPEAT
                    142: \   drop ;
1.1       anton     143: 
1.13      anton     144: : .strings ( addr u -- ) \ gforth
                    145:     \G list the strings from an array of string descriptors at addr
                    146:     \G with u entries, one per line.
1.14      anton     147:     2* cells bounds ?DO
1.13      anton     148:        cr I 2@ type 2 cells +LOOP ;
                    149: 
1.10      anton     150: : .included ( -- ) \ gforth
                    151:     \G list the names of the files that have been @code{included}
1.25      anton     152:     included-files 2@ 2 cells under+ 1- .strings ;

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