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