Return to require.fs CVS log

Up to [gforth] / gforth / kernel

Annotation of gforth/kernel/require.fs, revision 1.1

1.1     ! anton       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: newrequire.fs,v 1.2 1996/02/28 17:37:20 jeans Exp jeans $
        !            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: newrequire.fs,v 1.2 1996/02/28 17:37:20 jeans Exp jeans $
        !           144: