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

1.1       anton       1: \ require.fs
                      2: 
                      3: \ Copyright (C) 1995-1997 Free Software Foundation, Inc.
                      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: 
1.4     ! anton      23: \ $Id: require.fs,v 1.3 1997/06/01 20:55:22 jwilke Exp $
1.1       anton      24: 
                     25: create included-files 0 , 0 , ( pointer to and count of included files )
1.4     ! anton      26: here ," ./the terminal" dup c@ swap 1 + swap , A, here 2 cells -
1.1       anton      27: create image-included-files  1 , A, ( pointer to and count of included files )
                     28: \ included-files points to ALLOCATEd space, while image-included-files
                     29: \ points to ALLOTed objects, so it survives a save-system
                     30: 
                     31: : loadfilename ( -- a-addr )
                     32:     \G a-addr 2@ produces the current file name ( c-addr u )
                     33:     included-files 2@ loadfilename# @ min 2* cells + ;
                     34: 
                     35: : sourcefilename ( -- c-addr u ) \ gforth
                     36:     \G the name of the source file which is currently the input
                     37:     \G source.  The result is valid only while the file is being
                     38:     \G loaded.  If the current input source is no (stream) file, the
                     39:     \G result is undefined.
                     40:     loadfilename 2@ ;
                     41: 
                     42: : sourceline# ( -- u ) \ gforth                sourceline-number
                     43:     \G the line number of the line that is currently being interpreted
                     44:     \G from a (stream) file. The first line has the number 1. If the
                     45:     \G current input source is no (stream) file, the result is
                     46:     \G undefined.
                     47:     loadline @ ;
                     48: 
                     49: : init-included-files ( -- )
                     50:     image-included-files 2@ 2* cells save-mem drop ( addr )
                     51:     image-included-files 2@ nip included-files 2! ;
                     52: 
                     53: : included? ( c-addr u -- f ) \ gforth
                     54:     \G true, iff filename c-addr u is in included-files
                     55:     included-files 2@ 0
                     56:     ?do ( c-addr u addr )
                     57:        dup >r 2@ 2over compare 0=
                     58:        if
                     59:            2drop rdrop unloop
                     60:            true EXIT
                     61:        then
                     62:        r> cell+ cell+
                     63:     loop
                     64:     2drop drop false ;
                     65: 
                     66: : add-included-file ( c-addr u -- ) \ gforth
                     67:     \G add name c-addr u to included-files
                     68:     included-files 2@ 2* cells 2 cells extend-mem
                     69:     2/ cell / included-files 2!
                     70:     2! ;
                     71: 
                     72: : included1 ( i*x file-id c-addr u -- j*x ) \ gforth
                     73:     \G include the file file-id with the name given by c-addr u
                     74:     loadfilename# @ >r
                     75:     save-mem add-included-file ( file-id )
                     76:     included-files 2@ nip 1- loadfilename# !
                     77:     ['] include-file catch
                     78:     r> loadfilename# !
                     79:     throw ;
                     80:     
                     81: : included ( i*x addr u -- j*x ) \ file
1.4     ! anton      82:     \G @code{include-file} the file whose name is given by the string
        !            83:     \G @var{addr u}.
1.3       jwilke     84:     open-fpath-file throw included1 ;
1.1       anton      85: 
                     86: : required ( i*x addr u -- j*x ) \ gforth
1.4     ! anton      87:     \G include the file with the name given by @var{addr u}, if it is not
        !            88:     \G @code{included} (or @code{required}) already. Currently this
        !            89:     \G works by comparing the name of the file (with path) against the
        !            90:     \G names of earlier included files.
        !            91:     \ however, it may be better to fstat the file,
        !            92:     \ and compare the device and inode. The advantages would be: no
        !            93:     \ problems with several paths to the same file (e.g., due to
        !            94:     \ links) and we would catch files included with include-file and
        !            95:     \ write a require-file.
1.3       jwilke     96:     open-fpath-file throw 2dup included?
1.1       anton      97:     if
                     98:        2drop close-file throw
                     99:     else
                    100:        included1
                    101:     then ;
                    102: 
                    103: \ INCLUDE                                               9may93jaw
                    104: 
1.4     ! anton     105: : include  ( ... "file" -- ... ) \ gforth
        !           106: \G includes @var{file}
1.1       anton     107:   name included ;
                    108: 
1.4     ! anton     109: : require  ( ... "file" -- ... ) \ gforth
        !           110: \G includes @var{file} only if it is not included already
1.1       anton     111:   name required ;
                    112: 
                    113: 0 [IF]
                    114: : \I
                    115:   here 
                    116:   0 word count
                    117:   string,
                    118:   needsrcs^ @ ! ;
                    119: 
                    120: : .modules
                    121:   cr
                    122:   needs^ @
                    123:   BEGIN                dup 
                    124:   WHILE                dup cell+ count type cr
                    125:                5 spaces
                    126:                dup cell+ count + aligned
                    127:                @ dup IF count type ELSE drop THEN cr
                    128:                @
                    129:   REPEAT
                    130:   drop ;
                    131: 
                    132: : loadfilename#>str ( n -- adr len )
                    133: \ this converts the filenumber into the string
                    134:   loadfilenamecount @ swap -
                    135:   needs^ @
                    136:   swap 0 ?DO dup 0= IF LEAVE THEN @ LOOP 
                    137:   dup IF cell+ count ELSE drop s" NOT FOUND" THEN ;
                    138: [THEN]
                    139: 
                    140: : loadfilename#>str ( n -- adr len )
                    141:     included-files 2@ drop swap 2* cells + 2@ ;
                    142: 
                    143: : .modules
                    144:     included-files 2@ 2* cells bounds ?DO
                    145:        cr I 2@ type  2 cells +LOOP ;  
                    146: 
                    147: \ contains tools/newrequire.fs
1.4     ! anton     148: \ \I $Id: require.fs,v 1.3 1997/06/01 20:55:22 jwilke Exp $
1.1       anton     149: 

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