Return to require.fs CVS log

Up to [gforth] / gforth / kernel

.cvsignore -- added a couple of other files I was tired of seeing flagged
by CVS

README -- added references to a couple more .fs files that are part of
the gforth distribution

blocks.fs -- fixed a bug in UPDATED? and added glossary entries for all
words.

colorize.fs -- fixed a bug that was introduced by a dictionary
structure change between 0.3.0 and 0.4.0 (I think.. it used to work
on 0.3.0 and I compared the color WORDS with the normal WORDS and found
some dirrerences

doc/gforth.1 -- minor tweaks to man page. I now think that I'd like to
be able to auto-generate the man page from what is now Chapter 3 of the
manual. That's in line with GNU's general attitude towards man pages..

doc/gforth.ds -- added stuff about blocks, revamped Chapter 3 and other
miscellaneous changes.

kernel/comp.fs -- glossary tweaks

kernel/require.fs -- glossary tweaks

    1: \ require.fs
    2: 
    3: \ Copyright (C) 1995,1996,1997,1998 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., 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 )
   24: here ," ./the terminal" dup c@ swap 1 + swap , A, here 2 cells -
   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 not a (stream) file, the result is
   44:     \G undefined.
   45:     loadline @ ;
   46: 
   47: : init-included-files ( -- ) \ gforth
   48:     \G Clear the list of earlier included files.
   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
   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}
   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
   77:     \G Include the file file-id with the name given by @var{c-addr u}.
   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:     
   85: : included ( i*x c-addr u -- j*x ) \ file
   86:     \G @code{include-file} the file whose name is given by the string
   87:     \G @var{c-addr u}.
   88:     open-fpath-file throw included1 ;
   89: 
   90: : required ( i*x addr u -- j*x ) \ gforth
   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.
   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.
  100:     open-fpath-file throw 2dup included?
  101:     if
  102: 	2drop close-file throw
  103:     else
  104: 	included1
  105:     then ;
  106: 
  107: \ INCLUDE                                               9may93jaw
  108: 
  109: : include  ( ... "file" -- ... ) \ gforth
  110:     \G @code{include-file} the file @var{file}.
  111:     name included ;
  112: 
  113: : require  ( ... "file" -- ... ) \ gforth
  114:     \G @code{include-file} @var{file} only if it is not included already.
  115:     name required ;
  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
  152: \ \I $Id: require.fs,v 1.7 1999/04/16 22:19:54 crook Exp $
  153: