--- gforth/glocals.fs 2012/02/07 18:15:27 1.66 +++ gforth/glocals.fs 2012/12/31 15:25:18 1.70 @@ -1,6 +1,6 @@ \ A powerful locals implementation -\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2007,2011 Free Software Foundation, Inc. +\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2007,2011,2012 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -79,11 +79,6 @@ \ aligned correctly, but our locals stack must be float-aligned between \ words. -\ Other things about the internals are pretty unclear now. - -\ Currently locals may only be -\ defined at the outer level and TO is not supported. - require search.fs require float.fs require extend.fs \ for case @@ -572,12 +567,17 @@ forth definitions latest latestxt clear-leave-stack 0 locals-size ! - locals-mem-list @ free-list - 0 locals-mem-list ! 0 locals-list ! dead-code off defstart ; +[IFDEF] free-old-local-names +:noname ( -- ) + locals-mem-list @ free-list + 0 locals-mem-list ! ; +is free-old-local-names +[THEN] + : locals-;-hook ( sys addr xt sys -- sys ) def? 0 TO locals-wordlist @@ -657,6 +657,7 @@ forth definitions ' locals-:-hook IS :-hook ' locals-;-hook IS ;-hook + ' (then-like) IS then-like ' (begin-like) IS begin-like ' (again-like) IS again-like @@ -734,18 +735,21 @@ forth definitions code-address! then ; -:noname - ' dup >definer [ ' locals-wordlist ] literal >definer = - if - >body ! - else +: (int-to) ( xt -- ) dup >definer + case + [ ' locals-wordlist ] literal >definer \ value + of >body ! endof + [ ' parse-name ] literal >definer \ defer + of defer! endof -&32 throw - endif ; -:noname - comp' drop dup >definer + endcase ; + +: (comp-to) ( xt -- ) dup >definer case [ ' locals-wordlist ] literal >definer \ value OF >body POSTPONE Aliteral POSTPONE ! ENDOF + [ ' parse-name ] literal >definer \ defer + OF POSTPONE Aliteral POSTPONE defer! ENDOF \ !! dependent on c: etc. being does>-defining words \ this works, because >definer uses >does-code in this case, \ which produces a relocatable address @@ -759,6 +763,11 @@ forth definitions OF POSTPONE laddr# >body @ lp-offset, POSTPONE f! ENDOF -&32 throw endcase ; + +:noname + ' (int-to) ; +:noname + comp' drop (comp-to) ; interpret/compile: TO ( c|w|d|r "name" -- ) \ core-ext,local : locals| ( ... "name ..." -- ) \ local-ext locals-bar