File:  [gforth] / gforth / kernel / require.fs
Revision 1.23: download - view: text, annotated - select for diffs
Mon Jan 20 17:07:42 2003 UTC (18 years, 10 months ago) by anton
Branches: MAIN
CVS tags: HEAD
undid changes to copyright notices

    1: \ require.fs
    2: 
    3: \ Copyright (C) 1995,1996,1997,1998,2000 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., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
   20: 
   21: \ Now: Kernel Module, Reloadable
   22: 
   23: create included-files 0 , 0 , ( pointer to and count of included files )
   24: \ note: these names must not contain a "/" or "\"; otherwise a part of
   25: \ that name might be used when expanding "./" (see expandtopic).
   26: here ," *a file*" dup c@ swap 1 + swap
   27: here ," *a block*" dup c@ swap 1 + swap
   28: here ," *evaluated string*" dup c@ swap 1 + swap
   29: here ," *the terminal*" dup c@ swap 1 + swap
   30: , A, , A, , A, , A, here 8 cells -
   31: create image-included-files 4 , A, ( pointer to and count of included files )
   32: \ included-files points to ALLOCATEd space, while image-included-files
   33: \ points to ALLOTed objects, so it survives a save-system
   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.  In Gforth, the result is valid during the
   40:     \G whole seesion (but not across @code{savesystem} etc.).
   41:     loadfilename# @ loadfilename#>str ;
   42: 
   43: : sourceline# ( -- u ) \ gforth		sourceline-number
   44:     \G The line number of the line that is currently being interpreted
   45:     \G from a (stream) file. The first line has the number 1. If the
   46:     \G current input source is not a (stream) file, the result is
   47:     \G undefined.
   48:     loadline @ ;
   49: 
   50: : init-included-files ( -- ) \ gforth-internal
   51:     image-included-files 2@ 2* cells save-mem drop ( addr )
   52:     image-included-files 2@ nip included-files 2! ;
   53: 
   54: : included? ( c-addr u -- f ) \ gforth
   55:     \G True only if the file @var{c-addr u} is in the list of earlier
   56:     \G included files. If the file has been loaded, it may have been
   57:     \G specified as, say, @file{foo.fs} and found somewhere on the
   58:     \G Forth search path. To return @code{true} from @code{included?},
   59:     \G you must specify the exact path to the file, even if that is
   60:     \G @file{./foo.fs}
   61:     included-files 2@ 0
   62:     ?do ( c-addr u addr )
   63: 	dup >r 2@ 2over str=
   64: 	if
   65: 	    2drop rdrop unloop
   66: 	    true EXIT
   67: 	then
   68: 	r> cell+ cell+
   69:     loop
   70:     2drop drop false ;
   71: 
   72: : add-included-file ( c-addr u -- ) \ gforth
   73:     \G add name c-addr u to included-files
   74:     included-files 2@ 2* cells 2 cells extend-mem
   75:     2/ cell / included-files 2!
   76:     2! ;
   77: 
   78: has? new-input [IF]
   79: : included1 ( i*x file-id c-addr u -- j*x ) \ gforth
   80:     \G Include the file file-id with the name given by @var{c-addr u}.
   81:     save-mem add-included-file ( file-id )
   82:     included-files @ 1- ['] include-file2 catch
   83:     throw ;
   84: [ELSE]
   85: : included1 ( i*x file-id c-addr u -- j*x ) \ gforth
   86:     \G Include the file file-id with the name given by @var{c-addr u}.
   87:     loadfilename# @ >r
   88:     save-mem add-included-file ( file-id )
   89:     included-files 2@ nip 1- loadfilename# !
   90:     ['] include-file2 catch
   91:     r> loadfilename# !
   92:     throw ;
   93: [THEN]
   94: 
   95: : included ( i*x c-addr u -- j*x ) \ file
   96:     \G @code{include-file} the file whose name is given by the string
   97:     \G @var{c-addr u}.
   98:     open-fpath-file throw included1 ;
   99: 
  100: : required ( i*x addr u -- j*x ) \ gforth
  101:     \G @code{include-file} the file with the name given by @var{addr
  102:     \G u}, if it is not @code{included} (or @code{required})
  103:     \G already. Currently this works by comparing the name of the file
  104:     \G (with path) against the names of earlier included files.
  105:     \ however, it may be better to fstat the file,
  106:     \ and compare the device and inode. The advantages would be: no
  107:     \ problems with several paths to the same file (e.g., due to
  108:     \ links) and we would catch files included with include-file and
  109:     \ write a require-file.
  110:     open-fpath-file throw 2dup included?
  111:     if
  112: 	2drop close-file throw
  113:     else
  114: 	included1
  115:     then ;
  116: 
  117: \ INCLUDE                                               9may93jaw
  118: 
  119: : include  ( ... "file" -- ... ) \ gforth
  120:     \G @code{include-file} the file @var{file}.
  121:     name included ;
  122: 
  123: : require  ( ... "file" -- ... ) \ gforth
  124:     \G @code{include-file} @var{file} only if it is not included already.
  125:     name required ;
  126: 
  127: \ : \I
  128: \   here 
  129: \   0 word count
  130: \   string,
  131: \   needsrcs^ @ ! ;
  132: 
  133: \ : .included ( -- ) \ gforth
  134: \     \G list the names of the files that have been @code{included}
  135: \   cr
  136: \   needs^ @
  137: \   BEGIN		dup 
  138: \   WHILE		dup cell+ count type cr
  139: \ 		5 spaces
  140: \ 		dup cell+ count + aligned
  141: \ 		@ dup IF count type ELSE drop THEN cr
  142: \ 		@
  143: \   REPEAT
  144: \   drop ;
  145: 
  146: \ : loadfilename#>str ( n -- adr len )
  147: \ \ this converts the filenumber into the string
  148: \   loadfilenamecount @ swap -
  149: \   needs^ @
  150: \   swap 0 ?DO dup 0= IF LEAVE THEN @ LOOP 
  151: \   dup IF cell+ count ELSE drop s" NOT FOUND" THEN ;
  152: 
  153: : loadfilename#>str ( n -- adr len )
  154:     included-files 2@ drop swap 2* cells + 2@ ;
  155: 
  156: : .strings ( addr u -- ) \ gforth
  157:     \G list the strings from an array of string descriptors at addr
  158:     \G with u entries, one per line.
  159:     2* cells bounds ?DO
  160: 	cr I 2@ type 2 cells +LOOP ;
  161: 
  162: : .included ( -- ) \ gforth
  163:     \G list the names of the files that have been @code{included}
  164:     included-files 2@ .strings ;

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