Annotation of gforth/kernel/require.fs, revision 1.33
1.1 anton 1: \ require.fs
2:
1.32 anton 3: \ Copyright (C) 1995,1996,1997,1998,2000,2003,2006 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
1.33 ! anton 9: \ as published by the Free Software Foundation, either version 3
1.1 anton 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
1.33 ! anton 18: \ along with this program. If not, see http://www.gnu.org/licenses/.
1.1 anton 19:
20: \ Now: Kernel Module, Reloadable
21:
22: create included-files 0 , 0 , ( pointer to and count of included files )
1.15 anton 23: \ note: these names must not contain a "/" or "\"; otherwise a part of
24: \ that name might be used when expanding "./" (see expandtopic).
1.25 anton 25: here ," *somewhere*" dup c@ swap 1 + swap
26: , A, here 2 cells -
27: create image-included-files 1 , A, ( pointer to and count of included files )
1.16 anton 28: \ included-files points to ALLOCATEd space, while image-included-files
29: \ points to ALLOTed objects, so it survives a save-system
1.1 anton 30:
31: : sourcefilename ( -- c-addr u ) \ gforth
1.7 crook 32: \G The name of the source file which is currently the input
1.1 anton 33: \G source. The result is valid only while the file is being
34: \G loaded. If the current input source is no (stream) file, the
1.11 anton 35: \G result is undefined. In Gforth, the result is valid during the
36: \G whole seesion (but not across @code{savesystem} etc.).
1.24 anton 37: loadfilename 2@ ;
1.1 anton 38:
39: : sourceline# ( -- u ) \ gforth sourceline-number
1.7 crook 40: \G The line number of the line that is currently being interpreted
1.1 anton 41: \G from a (stream) file. The first line has the number 1. If the
1.7 crook 42: \G current input source is not a (stream) file, the result is
1.1 anton 43: \G undefined.
44: loadline @ ;
45:
1.11 anton 46: : init-included-files ( -- ) \ gforth-internal
1.1 anton 47: image-included-files 2@ 2* cells save-mem drop ( addr )
48: image-included-files 2@ nip included-files 2! ;
49:
50: : included? ( c-addr u -- f ) \ gforth
1.7 crook 51: \G True only if the file @var{c-addr u} is in the list of earlier
52: \G included files. If the file has been loaded, it may have been
1.9 crook 53: \G specified as, say, @file{foo.fs} and found somewhere on the
54: \G Forth search path. To return @code{true} from @code{included?},
55: \G you must specify the exact path to the file, even if that is
56: \G @file{./foo.fs}
1.1 anton 57: included-files 2@ 0
58: ?do ( c-addr u addr )
1.21 anton 59: dup >r 2@ 2over str=
1.1 anton 60: if
61: 2drop rdrop unloop
62: true EXIT
63: then
64: r> cell+ cell+
65: loop
66: 2drop drop false ;
67:
68: : add-included-file ( c-addr u -- ) \ gforth
69: \G add name c-addr u to included-files
70: included-files 2@ 2* cells 2 cells extend-mem
71: 2/ cell / included-files 2!
72: 2! ;
73:
1.19 pazsan 74: : included1 ( i*x file-id c-addr u -- j*x ) \ gforth
1.29 anton 75: \G Include the file file-id with the name given by @var{c-addr u}.
76: save-mem 2dup add-included-file
77: includefilename 2@ 2>r 2dup includefilename 2!
78: ['] read-loop execute-parsing-named-file
79: 2r> includefilename 2! ;
1.19 pazsan 80:
1.30 pazsan 81: : included ( i*x c-addr u -- j*x ) \ file
82: \G @code{include-file} the file whose name is given by the string
83: \G @var{c-addr u}.
1.3 jwilke 84: open-fpath-file throw included1 ;
1.1 anton 85:
1.30 pazsan 86: : required ( i*x addr u -- i*x ) \ gforth
87: \G @code{include-file} the file with the name given by @var{addr
88: \G u}, if it is not @code{included} (or @code{required})
89: \G already. Currently this works by comparing the name of the file
90: \G (with path) against the names of earlier included files.
1.4 anton 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
1.7 crook 106: \G @code{include-file} the file @var{file}.
1.30 pazsan 107: name included ;
1.1 anton 108:
1.4 anton 109: : require ( ... "file" -- ... ) \ gforth
1.7 crook 110: \G @code{include-file} @var{file} only if it is not included already.
1.30 pazsan 111: name required ;
1.1 anton 112:
1.12 anton 113: \ : \I
114: \ here
115: \ 0 word count
116: \ string,
117: \ needsrcs^ @ ! ;
1.1 anton 118:
1.12 anton 119: \ : .included ( -- ) \ gforth
120: \ \G list the names of the files that have been @code{included}
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 ;
1.1 anton 131:
1.13 anton 132: : .strings ( addr u -- ) \ gforth
133: \G list the strings from an array of string descriptors at addr
134: \G with u entries, one per line.
1.14 anton 135: 2* cells bounds ?DO
1.13 anton 136: cr I 2@ type 2 cells +LOOP ;
137:
1.10 anton 138: : .included ( -- ) \ gforth
139: \G list the names of the files that have been @code{included}
1.25 anton 140: included-files 2@ 2 cells under+ 1- .strings ;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>