version 1.45, 1995/10/29 21:35:13
|
version 1.46, 1995/11/07 18:06:47
|
Line 1
|
Line 1
|
\ KERNAL.FS GForth kernal 17dec92py |
\ KERNAL.FS GForth kernal 17dec92py |
\ $ID: |
|
|
\ Copyright (C) 1995 Free Software Foundation, Inc. |
|
|
|
\ This file is part of Gforth. |
|
|
|
\ Gforth is free software; you can redistribute it and/or |
|
\ modify it under the terms of the GNU General Public License |
|
\ as published by the Free Software Foundation; either version 2 |
|
\ of the License, or (at your option) any later version. |
|
|
|
\ This program is distributed in the hope that it will be useful, |
|
\ but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
\ GNU General Public License for more details. |
|
|
|
\ You should have received a copy of the GNU General Public License |
|
\ along with this program; if not, write to the Free Software |
|
\ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. |
|
|
\ Idea and implementation: Bernd Paysan (py) |
\ Idea and implementation: Bernd Paysan (py) |
\ Copyright 1992 by the ANSI figForth Development Group |
|
|
|
\ Log: ', '- usw. durch [char] ... ersetzt |
\ Log: ', '- usw. durch [char] ... ersetzt |
\ man sollte die unterschiedlichen zahlensysteme |
\ man sollte die unterschiedlichen zahlensysteme |
Line 1440 create image-included-files 0 , 0 , ( po
|
Line 1457 create image-included-files 0 , 0 , ( po
|
\ included-files points to ALLOCATEd space, while image-included-files |
\ included-files points to ALLOCATEd space, while image-included-files |
\ points to ALLOTed objects, so it survives a save-system |
\ points to ALLOTed objects, so it survives a save-system |
|
|
|
: loadfilename ( -- a-addr ) |
|
\ a-addr 2@ produces the current file name ( c-addr u ) |
|
included-files 2@ drop loadfilename# @ 2* cells + ; |
|
|
: init-included-files ( -- ) |
: init-included-files ( -- ) |
image-included-files 2@ 2* cells save-string drop ( addr ) |
image-included-files 2@ 2* cells save-string drop ( addr ) |
image-included-files 2@ nip included-files 2! ; |
image-included-files 2@ nip included-files 2! ; |
Line 1471 create image-included-files 0 , 0 , ( po
|
Line 1492 create image-included-files 0 , 0 , ( po
|
|
|
: included1 ( i*x file-id c-addr u -- j*x ) \ gforth |
: included1 ( i*x file-id c-addr u -- j*x ) \ gforth |
\ include the file file-id with the name given by c-addr u |
\ include the file file-id with the name given by c-addr u |
loadfilename 2@ >r >r |
loadfilename# @ >r |
save-string 2dup loadfilename 2! add-included-file ( file-id ) |
save-string add-included-file ( file-id ) |
|
included-files 2@ nip 1- loadfilename# ! |
['] include-file catch |
['] include-file catch |
r> r> loadfilename 2! throw ; |
r> loadfilename# ! |
|
throw ; |
|
|
: included ( i*x addr u -- j*x ) \ file |
: included ( i*x addr u -- j*x ) \ file |
open-path-file included1 ; |
open-path-file included1 ; |