version 1.14, 1995/10/16 18:33:10
|
version 1.25, 1996/08/26 10:07:18
|
Line 1
|
Line 1
|
|
\ A powerful locals implementation |
|
|
|
\ 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. |
|
|
|
|
|
\ More documentation can be found in the manual and in |
|
\ http://www.complang.tuwien.ac.at/papers/ertl94l.ps.gz |
|
|
\ Local variables are quite important for writing readable programs, but |
\ Local variables are quite important for writing readable programs, but |
\ IMO (anton) they are the worst part of the standard. There they are very |
\ IMO (anton) they are the worst part of the standard. There they are very |
\ restricted and have an ugly interface. |
\ restricted and have an ugly interface. |
Line 230 previous
|
Line 254 previous
|
: new-locals-reveal ( -- ) |
: new-locals-reveal ( -- ) |
true abort" this should not happen: new-locals-reveal" ; |
true abort" this should not happen: new-locals-reveal" ; |
|
|
create new-locals-map ' new-locals-find A, ' new-locals-reveal A, |
create new-locals-map ( -- wordlist-map ) |
|
' new-locals-find A, ' new-locals-reveal A, |
|
|
vocabulary new-locals |
vocabulary new-locals |
new-locals-map ' new-locals >body cell+ A! \ !! use special access words |
new-locals-map ' new-locals >body cell+ A! \ !! use special access words |
Line 464 forth definitions
|
Line 489 forth definitions
|
\ this gives a unique identifier for the way the xt was defined |
\ this gives a unique identifier for the way the xt was defined |
\ words defined with different does>-codes have different definers |
\ words defined with different does>-codes have different definers |
\ the definer can be used for comparison and in definer! |
\ the definer can be used for comparison and in definer! |
dup >code-address [ ' bits >code-address ] Literal = |
dup >code-address [ ' spaces >code-address ] Literal = |
\ !! this definition will not work on some implementations for `bits' |
\ !! this definition will not work on some implementations for `bits' |
if \ if >code-address delivers the same value for all does>-def'd words |
if \ if >code-address delivers the same value for all does>-def'd words |
>does-code 1 or \ bit 0 marks special treatment for does codes |
>does-code 1 or \ bit 0 marks special treatment for does codes |
Line 480 forth definitions
|
Line 505 forth definitions
|
code-address! |
code-address! |
then ; |
then ; |
|
|
\ !! untested |
:noname |
: TO ( c|w|d|r "name" -- ) \ core-ext,local |
' dup >definer [ ' locals-wordlist >definer ] literal = |
\ !! state smart |
if |
0 0 0. 0.0e0 { c: clocal w: wlocal d: dlocal f: flocal } |
>body ! |
' dup >definer |
else |
state @ |
-&32 throw |
if |
endif ; |
case |
:noname |
[ ' locals-wordlist >definer ] literal \ value |
0 0 0. 0.0e0 { c: clocal w: wlocal d: dlocal f: flocal } |
OF >body POSTPONE Aliteral POSTPONE ! ENDOF |
' dup >definer |
[ ' clocal >definer ] literal |
case |
OF POSTPONE laddr# >body @ lp-offset, POSTPONE c! ENDOF |
[ ' locals-wordlist >definer ] literal \ value |
[ ' wlocal >definer ] literal |
OF >body POSTPONE Aliteral POSTPONE ! ENDOF |
OF POSTPONE laddr# >body @ lp-offset, POSTPONE ! ENDOF |
[ comp' clocal drop >definer ] literal |
[ ' dlocal >definer ] literal |
OF POSTPONE laddr# >body @ lp-offset, POSTPONE c! ENDOF |
OF POSTPONE laddr# >body @ lp-offset, POSTPONE d! ENDOF |
[ comp' wlocal drop >definer ] literal |
[ ' flocal >definer ] literal |
OF POSTPONE laddr# >body @ lp-offset, POSTPONE ! ENDOF |
OF POSTPONE laddr# >body @ lp-offset, POSTPONE f! ENDOF |
[ comp' dlocal drop >definer ] literal |
-&32 throw |
OF POSTPONE laddr# >body @ lp-offset, POSTPONE 2! ENDOF |
endcase |
[ comp' flocal drop >definer ] literal |
else |
OF POSTPONE laddr# >body @ lp-offset, POSTPONE f! ENDOF |
[ ' locals-wordlist >definer ] literal = |
-&32 throw |
if |
endcase ; |
>body ! |
interpret/compile: TO ( c|w|d|r "name" -- ) \ core-ext,local |
else |
|
-&32 throw |
|
endif |
|
endif ; immediate |
|
|
|
: locals| |
: locals| |
\ don't use 'locals|'! use '{'! A portable and free '{' |
\ don't use 'locals|'! use '{'! A portable and free '{' |
\ implementation is anslocals.fs |
\ implementation is compat/anslocals.fs |
BEGIN |
BEGIN |
name 2dup s" |" compare 0<> |
name 2dup s" |" compare 0<> |
WHILE |
WHILE |