\ Local primitives 17jan92py
\ Copyright (C) 1995,2000 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@ ;
: 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 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
: FOR 2 cells loffset +! postpone FOR ; immediate restrict
: LOOP -2 cells loffset +! postpone LOOP ; immediate restrict
: +LOOP -2 cells loffset +! postpone +LOOP ; immediate restrict
: NEXT -2 cells loffset +! postpone NEXT ; immediate restrict
: >R 1 cells loffset +! postpone >R ; immediate restrict
: R> -1 cells loffset +! postpone R> ; immediate restrict
\ High level locals 19aug93py
: { postpone <local -1
BEGIN >in @ name dup c@ 1 = swap 1+ c@ '| = and UNTIL
drop >in @ >r
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
Create inlocal 5 cells allot inlocal off
: (local) ( addr u -- ) inlocal @ 0=
IF postpone <local inlocal on
inlocal 3 cells + 2! inlocal cell+ 2! THEN
dup IF linestart @ >r sourceline# >r loadfile @ >r
blk @ >r >tib @ >r #tib @ dup >r >in @ >r
>tib +! dup #tib ! >tib @ swap move
>in off blk off loadfile off -1 linestart !
postpone local:
r> >in ! r> #tib ! r> >tib ! r> blk !
r> loadfile ! r> loadline ! r> linestart !
ELSE 2drop inlocal cell+ 2@ inlocal 3 cells + 2@
postpone local>
inlocal 2 cells + 2! inlocal cell+ ! THEN ;
: ?local; inlocal @
IF inlocal cell+ @ inlocal 2 cells + 2@
postpone local; inlocal off THEN ;
: ; ?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
count (local) REPEAT 0 (local) ; immediate restrict
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>