--- gforth/glocals.fs 1996/01/25 16:45:52 1.18 +++ gforth/glocals.fs 1996/07/16 20:57:09 1.23 @@ -254,7 +254,8 @@ previous : 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 new-locals-map ' new-locals >body cell+ A! \ !! use special access words @@ -504,37 +505,34 @@ forth definitions code-address! then ; -: TO ( c|w|d|r "name" -- ) \ core-ext,local -\ !! state smart - 0 0 0. 0.0e0 { c: clocal w: wlocal d: dlocal f: flocal } - ' dup >definer - state @ - if - case - [ ' locals-wordlist >definer ] literal \ value - OF >body POSTPONE Aliteral POSTPONE ! ENDOF - [ ' clocal >definer ] literal - OF POSTPONE laddr# >body @ lp-offset, POSTPONE c! ENDOF - [ ' wlocal >definer ] literal - OF POSTPONE laddr# >body @ lp-offset, POSTPONE ! ENDOF - [ ' dlocal >definer ] literal - OF POSTPONE laddr# >body @ lp-offset, POSTPONE d! ENDOF - [ ' flocal >definer ] literal - OF POSTPONE laddr# >body @ lp-offset, POSTPONE f! ENDOF - -&32 throw - endcase - else - [ ' locals-wordlist >definer ] literal = - if - >body ! - else - -&32 throw - endif - endif ; immediate +:noname + ' dup >definer [ ' locals-wordlist >definer ] literal = + if + >body ! + else + -&32 throw + endif ; +:noname + 0 0 0. 0.0e0 { c: clocal w: wlocal d: dlocal f: flocal } + ' dup >definer + case + [ ' locals-wordlist >definer ] literal \ value + OF >body POSTPONE Aliteral POSTPONE ! ENDOF + [ ' clocal >definer ] literal + OF POSTPONE laddr# >body @ lp-offset, POSTPONE c! ENDOF + [ ' wlocal >definer ] literal + OF POSTPONE laddr# >body @ lp-offset, POSTPONE ! ENDOF + [ ' dlocal >definer ] literal + OF POSTPONE laddr# >body @ lp-offset, POSTPONE 2! ENDOF + [ ' flocal >definer ] literal + OF POSTPONE laddr# >body @ lp-offset, POSTPONE f! ENDOF + -&32 throw + endcase ; +special: TO ( c|w|d|r "name" -- ) \ core-ext,local : locals| \ don't use 'locals|'! use '{'! A portable and free '{' - \ implementation is anslocals.fs + \ implementation is compat/anslocals.fs BEGIN name 2dup s" |" compare 0<> WHILE