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