[BACK]Return to locals.fs CVS log [TXT] [DIR] Up to [gforth] / gforth

Diff for /gforth/locals.fs between versions 1.1 and 1.10

version 1.1, 1994/03/11 20:34:37 version 1.10, 2007/12/31 19:02:24
Line 1 Line 1
 \ Local primitives                                      17jan92py  \ Local primitives                                      17jan92py
   
   \ Copyright (C) 1995,2000,2003,2007 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 3
   \ 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, see http://www.gnu.org/licenses/.
   
 Variable loffset   0 loffset !  Variable loffset   0 loffset !
 Variable locals  here locals !  100 ( some) cells allot  Variable locals  here locals !  100 ( some) cells allot
 : local, ( offset -- )  postpone rp@ loffset @ swap -  : local, ( offset -- )  postpone rp@ loffset @ swap -
   postpone Literal postpone + ;    postpone Literal postpone + ;
 : delocal, ( offset -- ) local, postpone rp! ;  : delocal, ( offset -- ) local, postpone rp! ;
 : (local  DOES>  @ local, postpone @ ;  : (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 ;
 : local: ( -- )  postpone >r  last @ lastcfa @ here locals @ dp !  : 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  latest latestxt here locals @ dp !
   cell loffset +! Create  loffset @ , immediate (local    cell loffset +! Create  loffset @ , immediate (local
   here locals !  dp !  lastcfa ! last ! ;               immediate    here locals !  dp !  lastcfa ! last ! ;               immediate
   : flocal: ( -- )  latest latestxt 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> ( sys1 -- sys2 ) ;                             immediate
 : local; ( sys2 -- ) locals ! dup delocal,  : local; ( sys2 -- ) locals ! dup delocal,
   loffset ! current @ ! ;                               immediate    loffset ! current @ ! ;                               immediate
 : TO  >in @ ' dup @ [ ' (local >body cell+ ] ALiteral =  : TO  >in @ ' dup @ [ ' (local >body cell+ ] ALiteral =
   IF    >body @ local, postpone ! drop    IF    >body @ local, postpone ! drop
   ELSE  drop >in ! postpone to  THEN  ;                 immediate    ELSE  dup @ [ ' (flocal >body cell+ ] ALiteral =
 : EXIT  loffset @ IF  0 delocal,  THEN  postpone EXIT ; immediate          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
 : ?DO     2 cells loffset +!  postpone ?DO    ; immediate restrict  : ?DO     2 cells loffset +!  postpone ?DO    ; immediate restrict
Line 36  Variable locals  here locals !  100 ( so Line 68  Variable locals  here locals !  100 ( so
   BEGIN  dup 0< 0= WHILE  >in ! postpone local:  REPEAT  drop    BEGIN  dup 0< 0= WHILE  >in ! postpone local:  REPEAT  drop
   r> >in ! postpone local> ;                  immediate restrict    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  ' local; alias } immediate restrict
   
 \ ANS Locals                                           19aug93py  \ ANS Locals                                           19aug93py
Line 44  Create inlocal  5 cells allot  inlocal o Line 82  Create inlocal  5 cells allot  inlocal o
 : (local)  ( addr u -- )  inlocal @ 0=  : (local)  ( addr u -- )  inlocal @ 0=
   IF  postpone <local inlocal on    IF  postpone <local inlocal on
       inlocal 3 cells + 2!  inlocal cell+ 2! THEN        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              blk @ >r >tib @ >r  #tib @ dup >r  >in @ >r
   
             >tib +! dup #tib ! >tib @ swap move              >tib +! dup #tib ! >tib @ swap move
Line 64  Create inlocal  5 cells allot  inlocal o Line 102  Create inlocal  5 cells allot  inlocal o
   
 : ;      ?local; postpone ; ;                 immediate restrict  : ;      ?local; postpone ; ;                 immediate restrict
 : DOES>  ?local; postpone DOES> ;             immediate  : DOES>  ?local; postpone DOES> ;             immediate
   : EXIT  inlocal @ IF  0 delocal,  THEN  postpone EXIT ; immediate
   
 : locals|  : locals|
   BEGIN  name dup c@ 1 = over 1+ c@ '| = and 0=  WHILE    BEGIN  name dup c@ 1 = over 1+ c@ '| = and 0=  WHILE
Removed from v.1.1  
changed lines
  Added in v.1.10

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>