Annotation of gforth/kernel/require.fs, revision 1.7
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
1.7 ! crook 34: \G The name of the source file which is currently the input
1.1 anton 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
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.7 ! crook 47: : init-included-files ( -- ) \ gforth
! 48: \G Clear the list of earlier included files.
1.1 anton 49: image-included-files 2@ 2* cells save-mem drop ( addr )
50: image-included-files 2@ nip included-files 2! ;
51:
52: : included? ( c-addr u -- f ) \ gforth
1.7 ! crook 53: \G True only if the file @var{c-addr u} is in the list of earlier
! 54: \G included files. If the file has been loaded, it may have been
! 55: \G specified as, say, foo.fs and found somewhere on the Forth
! 56: \G search path. To return true from @code{included?}, you must
! 57: \G specify the exact path to the file, even if that is
! 58: \G @code{./foo.fs}
1.1 anton 59: included-files 2@ 0
60: ?do ( c-addr u addr )
61: dup >r 2@ 2over compare 0=
62: if
63: 2drop rdrop unloop
64: true EXIT
65: then
66: r> cell+ cell+
67: loop
68: 2drop drop false ;
69:
70: : add-included-file ( c-addr u -- ) \ gforth
71: \G add name c-addr u to included-files
72: included-files 2@ 2* cells 2 cells extend-mem
73: 2/ cell / included-files 2!
74: 2! ;
75:
76: : included1 ( i*x file-id c-addr u -- j*x ) \ gforth
1.7 ! crook 77: \G Include the file file-id with the name given by @var{c-addr u}.
1.1 anton 78: loadfilename# @ >r
79: save-mem add-included-file ( file-id )
80: included-files 2@ nip 1- loadfilename# !
81: ['] include-file catch
82: r> loadfilename# !
83: throw ;
84:
1.7 ! crook 85: : included ( i*x c-addr u -- j*x ) \ file
1.4 anton 86: \G @code{include-file} the file whose name is given by the string
1.7 ! crook 87: \G @var{c-addr u}.
1.3 jwilke 88: open-fpath-file throw included1 ;
1.1 anton 89:
90: : required ( i*x addr u -- j*x ) \ gforth
1.7 ! crook 91: \G @code{include-file} the file with the name given by @var{addr
! 92: \G u}, if it is not @code{included} (or @code{required})
! 93: \G already. Currently this works by comparing the name of the file
! 94: \G (with path) against the names of earlier included files.
1.4 anton 95: \ however, it may be better to fstat the file,
96: \ and compare the device and inode. The advantages would be: no
97: \ problems with several paths to the same file (e.g., due to
98: \ links) and we would catch files included with include-file and
99: \ write a require-file.
1.3 jwilke 100: open-fpath-file throw 2dup included?
1.1 anton 101: if
102: 2drop close-file throw
103: else
104: included1
105: then ;
106:
107: \ INCLUDE 9may93jaw
108:
1.4 anton 109: : include ( ... "file" -- ... ) \ gforth
1.7 ! crook 110: \G @code{include-file} the file @var{file}.
! 111: name included ;
1.1 anton 112:
1.4 anton 113: : require ( ... "file" -- ... ) \ gforth
1.7 ! crook 114: \G @code{include-file} @var{file} only if it is not included already.
! 115: name required ;
1.1 anton 116:
117: 0 [IF]
118: : \I
119: here
120: 0 word count
121: string,
122: needsrcs^ @ ! ;
123:
124: : .modules
125: cr
126: needs^ @
127: BEGIN dup
128: WHILE dup cell+ count type cr
129: 5 spaces
130: dup cell+ count + aligned
131: @ dup IF count type ELSE drop THEN cr
132: @
133: REPEAT
134: drop ;
135:
136: : loadfilename#>str ( n -- adr len )
137: \ this converts the filenumber into the string
138: loadfilenamecount @ swap -
139: needs^ @
140: swap 0 ?DO dup 0= IF LEAVE THEN @ LOOP
141: dup IF cell+ count ELSE drop s" NOT FOUND" THEN ;
142: [THEN]
143:
144: : loadfilename#>str ( n -- adr len )
145: included-files 2@ drop swap 2* cells + 2@ ;
146:
147: : .modules
148: included-files 2@ 2* cells bounds ?DO
149: cr I 2@ type 2 cells +LOOP ;
150:
151: \ contains tools/newrequire.fs
1.7 ! crook 152: \ \I $Id: require.fs,v 1.6 1999/03/23 20:24:26 crook Exp $
1.1 anton 153:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to require.fs CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [gforth] / gforth / kernel