--- gforth/locals.fs	1994/03/11 20:34:37	1.1
+++ gforth/locals.fs	2000/09/23 15:46:57	1.5
@@ -1,23 +1,56 @@
 \ Local primitives                                      17jan92py
 
+\ 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., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
+
 Variable loffset   0 loffset !
 Variable locals  here locals !  100 ( some) cells allot
 : local, ( offset -- )  postpone rp@ loffset @ swap -
   postpone Literal postpone + ;
 : delocal, ( offset -- ) local, postpone rp! ;
 : (local  DOES>  @ local, postpone @ ;
+: f>r  r> rp@ 1 floats - dup rp! f! >r ;
+: (flocal DOES>  @ local, postpone f@ ;
 
-: <local ( -- sys1 )  current @ @ loffset @ locals @ ;  immediate
+: do-nothing ;
+: ralign  r>
+  BEGIN  rp@ [ 1 floats 1- ] Literal and
+         WHILE  [ ' do-nothing >body ] ALiteral >r
+  REPEAT  >r ;
+
+: <local ( -- sys1 )  current @ @ loffset @ locals @
+  over 0= IF  postpone  ralign  THEN  ;                 immediate
 : local: ( -- )  postpone >r  last @ lastcfa @ here locals @ dp !
   cell loffset +! Create  loffset @ , immediate (local
   here locals !  dp !  lastcfa ! last ! ;               immediate
+: flocal: ( -- )  last @ lastcfa @ here locals @ dp !
+  BEGIN  loffset @ 0 1 floats fm/mod drop  WHILE
+         0 postpone Literal postpone >r  1 cells  loffset +!  REPEAT
+  postpone f>r  Create  loffset @ , immediate (flocal
+  here locals !  dp !  lastcfa ! last ! ;               immediate
 : local> ( sys1 -- sys2 ) ;                             immediate
 : local; ( sys2 -- ) locals ! dup delocal,
   loffset ! current @ ! ;                               immediate
 : TO  >in @ ' dup @ [ ' (local >body cell+ ] ALiteral =
   IF    >body @ local, postpone ! drop
-  ELSE  drop >in ! postpone to  THEN  ;                 immediate
-: EXIT  loffset @ IF  0 delocal,  THEN  postpone EXIT ; immediate
+  ELSE  dup @ [ ' (flocal >body cell+ ] ALiteral =
+        IF    >body @ local, postpone f!  drop
+        ELSE  drop >in ! postpone to  THEN THEN ;       immediate
 
 : DO      2 cells loffset +!  postpone DO     ; immediate restrict
 : ?DO     2 cells loffset +!  postpone ?DO    ; immediate restrict
@@ -36,6 +69,12 @@ Variable locals  here locals !  100 ( so
   BEGIN  dup 0< 0= WHILE  >in ! postpone local:  REPEAT  drop
   r> >in ! postpone local> ;                  immediate restrict
 
+: F{ postpone <local  -1
+  BEGIN  >in @ name dup c@ 1 = swap 1+ c@ '| = and  UNTIL
+  drop >in @ >r
+  BEGIN  dup 0< 0= WHILE  >in ! postpone Flocal:  REPEAT  drop
+  r> >in ! postpone local> ;                  immediate restrict
+
 ' local; alias } immediate restrict
 
 \ ANS Locals                                           19aug93py
@@ -44,7 +83,7 @@ Create inlocal  5 cells allot  inlocal o
 : (local)  ( addr u -- )  inlocal @ 0=
   IF  postpone <local inlocal on
       inlocal 3 cells + 2!  inlocal cell+ 2! THEN
-  dup IF    linestart @ >r loadline @ >r loadfile @ >r
+  dup IF    linestart @ >r sourceline# >r loadfile @ >r
             blk @ >r >tib @ >r  #tib @ dup >r  >in @ >r
 
             >tib +! dup #tib ! >tib @ swap move
@@ -64,6 +103,7 @@ Create inlocal  5 cells allot  inlocal o
 
 : ;      ?local; postpone ; ;                 immediate restrict
 : DOES>  ?local; postpone DOES> ;             immediate
+: EXIT  inlocal @ IF  0 delocal,  THEN  postpone EXIT ; immediate
 
 : locals|
   BEGIN  name dup c@ 1 = over 1+ c@ '| = and 0=  WHILE