--- gforth/glocals.fs 1996/09/30 13:16:10 1.28 +++ gforth/glocals.fs 1997/10/04 17:33:53 1.35 @@ -85,7 +85,7 @@ \ Currently locals may only be \ defined at the outer level and TO is not supported. -require search-order.fs +require search.fs require float.fs : compile-@local ( n -- ) \ gforth compile-fetch-local @@ -319,7 +319,10 @@ previous true abort" this should not happen: new-locals-reveal" ; create new-locals-map ( -- wordlist-map ) -' new-locals-find A, ' new-locals-reveal A, +' new-locals-find A, +' new-locals-reveal A, +' drop A, \ rehash method +' drop A, slowvoc @ slowvoc on @@ -330,17 +333,18 @@ new-locals-map ' new-locals >body cell+ variable old-dpp \ and now, finally, the user interface words -: { ( -- addr wid 0 ) \ gforth open-brace +: { ( -- lastxt wid 0 ) \ gforth open-brace dp old-dpp ! locals-dp dpp ! + lastxt get-current also new-locals - also get-current locals definitions locals-types + also locals definitions locals-types 0 TO locals-wordlist 0 postpone [ ; immediate locals-types definitions -: } ( addr wid 0 a-addr1 xt1 ... -- ) \ gforth close-brace +: } ( lastxt wid 0 a-addr1 xt1 ... -- ) \ gforth close-brace \ ends locals definitions ] old-dpp @ dpp ! begin @@ -350,8 +354,8 @@ locals-types definitions repeat drop locals-size @ alignlp-f locals-size ! \ the strictest alignment - set-current previous previous + set-current lastcfa ! locals-list TO locals-wordlist ; : -- ( addr wid 0 ... -- ) \ gforth dash-dash @@ -495,16 +499,17 @@ forth definitions \ ELSE. However, if ELSE generates an appropriate "lp+!#" before the \ branch, there will be none after the target . -: (then-like) ( orig -- addr ) - swap -rot dead-orig = +: (then-like) ( orig -- ) + dead-orig = if - drop + >resolve drop else dead-code @ if - set-locals-size-list dead-code off + >resolve set-locals-size-list dead-code off else \ both live - dup list-size adjust-locals-size + over list-size adjust-locals-size + >resolve locals-list @ common-list dup list-size adjust-locals-size locals-list ! then @@ -614,10 +619,9 @@ forth definitions \ this gives a unique identifier for the way the xt was defined \ words defined with different does>-codes have different definers \ the definer can be used for comparison and in definer! - dup >code-address [ ' spaces >code-address ] Literal = - \ !! this definition will not work on some implementations for `bits' - 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 + dup >does-code + ?dup-if + nip 1 or else >code-address then ; @@ -631,7 +635,7 @@ forth definitions then ; :noname - ' dup >definer [ ' locals-wordlist >definer ] literal = + ' dup >definer [ ' locals-wordlist ] literal >definer = if >body ! else @@ -641,8 +645,11 @@ forth definitions 0 0 0. 0.0e0 { c: clocal w: wlocal d: dlocal f: flocal } comp' drop dup >definer case - [ ' locals-wordlist >definer ] literal \ value + [ ' locals-wordlist ] literal >definer \ value OF >body POSTPONE Aliteral POSTPONE ! ENDOF + \ !! dependent on c: etc. being does>-defining words + \ this works, because >definer uses >does-code in this case, + \ which produces a relocatable address [ comp' clocal drop >definer ] literal OF POSTPONE laddr# >body @ lp-offset, POSTPONE c! ENDOF [ comp' wlocal drop >definer ] literal