--- gforth/Attic/kernal.fs	1995/10/29 21:35:13	1.45
+++ gforth/Attic/kernal.fs	1995/11/09 18:06:20	1.47
@@ -1,7 +1,24 @@
 \ 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)
-\ Copyright 1992 by the ANSI figForth Development Group
 
 \ Log:  ', '- usw. durch [char] ... ersetzt
 \       man sollte die unterschiedlichen zahlensysteme
@@ -1363,8 +1380,10 @@ create nl$ 1 c, A c, 0 c, \ gnu includes
 \ include-file                                         07apr93py
 
 : push-file  ( -- )  r>
-  loadline @ >r loadfile @ >r
-  blk @ >r >tib @ >r  #tib @ dup >r  >tib +!  >in @ >r  >r ;
+  loadline @ >r  loadfile @ >r
+  blk @ >r  tibstack @ >r  >tib @ >r  #tib @ >r
+  >tib @ tibstack @ = IF  r@ tibstack +!  THEN
+  tibstack @ >tib ! >in @ >r  >r ;
 
 : pop-file   ( throw-code -- throw-code )
   dup IF
@@ -1377,7 +1396,7 @@ create nl$ 1 c, A c, 0 c, \ gnu includes
 	 -1 cells +LOOP
   THEN
   r>
-  r> >in !  r> #tib !  r> >tib !  r> blk !
+  r> >in !  r> #tib !  r> >tib !  r> tibstack !  r> blk !
   r> loadfile ! r> loadline !  >r ;
 
 : read-loop ( i*x -- j*x )
@@ -1440,6 +1459,10 @@ create image-included-files 0 , 0 , ( po
 \ included-files points to ALLOCATEd space, while image-included-files
 \ 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 ( -- )
     image-included-files 2@ 2* cells save-string drop ( addr )
     image-included-files 2@ nip included-files 2! ;
@@ -1471,10 +1494,12 @@ create image-included-files 0 , 0 , ( po
 
 : included1 ( i*x file-id c-addr u -- j*x ) \ gforth
     \ include the file file-id with the name given by c-addr u
-    loadfilename 2@ >r >r
-    save-string 2dup loadfilename 2! add-included-file ( file-id )
+    loadfilename# @ >r
+    save-string add-included-file ( file-id )
+    included-files 2@ nip 1- loadfilename# !
     ['] include-file catch
-    r> r> loadfilename 2!  throw ;
+    r> loadfilename# !
+    throw ;
     
 : included ( i*x addr u -- j*x ) \ file
     open-path-file included1 ;
@@ -1536,9 +1561,8 @@ create image-included-files 0 , 0 , ( po
 \ EVALUATE                                              17may93jaw
 
 : evaluate ( c-addr len -- ) \ core,block
-  push-file  dup #tib ! >tib @ swap move
+  push-file  #tib ! >tib !
   >in off blk off loadfile off -1 loadline !
-\  BEGIN  interpret  >in @ #tib @ u>= UNTIL
   ['] interpret catch
   pop-file throw ;
 
@@ -1636,7 +1660,7 @@ DEFER DOERROR
 	postpone [
 	['] 'quit CATCH dup
     WHILE
-	DoError r@ >tib !
+	DoError r@ >tib ! r@ tibstack !
     REPEAT
     drop r> >tib ! ;
 
@@ -1745,7 +1769,7 @@ Defer 'cold ' noop IS 'cold
 
 : boot ( path **argv argc -- )
   argc ! argv ! cstring>sstring pathstring 2!  main-task up!
-  sp@ dup s0 ! $10 + >tib ! #tib off >in off
+  sp@ dup s0 ! $10 + dup >tib ! tibstack ! #tib off >in off
   rp@ r0 !  fp@ f0 !  cold ;
 
 : bye ( -- ) \ tools-ext