Return to require.fs CVS log

Up to [gforth] / gforth / kernel

Bug fixes

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