version 1.32, 1997/04/10 15:00:07
|
version 1.36, 1998/10/10 10:28:34
|
Line 85
|
Line 85
|
\ Currently locals may only be |
\ Currently locals may only be |
\ defined at the outer level and TO is not supported. |
\ defined at the outer level and TO is not supported. |
|
|
require search-order.fs |
require search.fs |
require float.fs |
require float.fs |
|
|
: compile-@local ( n -- ) \ gforth compile-fetch-local |
: compile-@local ( n -- ) \ gforth compile-fetch-local |
Line 183 variable locals-dp \ so here's the speci
|
Line 183 variable locals-dp \ so here's the speci
|
= ; |
= ; |
|
|
: list-size ( list -- u ) \ gforth-internal |
: list-size ( list -- u ) \ gforth-internal |
\ size of the locals frame represented by list |
\ size of the locals frame represented by list |
0 ( list n ) |
0 ( list n ) |
begin |
begin |
over 0<> |
over 0<> |
while |
while |
over |
over |
((name>)) >body @ max |
((name>)) >body @ max |
swap @ swap ( get next ) |
swap @ swap ( get next ) |
repeat |
repeat |
faligned nip ; |
faligned nip ; |
|
|
: set-locals-size-list ( list -- ) |
: set-locals-size-list ( list -- ) |
dup locals-list ! |
dup locals-list wordlist-id ! |
list-size locals-size ! ; |
list-size locals-size ! ; |
|
|
: check-begin ( list -- ) |
: check-begin ( list -- ) |
\ warn if list is not a sublist of locals-list |
\ warn if list is not a sublist of locals-list |
locals-list @ sub-list? 0= if |
locals-list wordlist-id @ sub-list? 0= if |
\ !! print current position |
\ !! print current position |
." compiler was overly optimistic about locals at a BEGIN" cr |
." compiler was overly optimistic about locals at a BEGIN" cr |
\ !! print assumption and reality |
\ !! print assumption and reality |
Line 322 create new-locals-map ( -- wordlist-map
|
Line 322 create new-locals-map ( -- wordlist-map
|
' new-locals-find A, |
' new-locals-find A, |
' new-locals-reveal A, |
' new-locals-reveal A, |
' drop A, \ rehash method |
' drop A, \ rehash method |
|
' drop A, |
|
|
slowvoc @ |
slowvoc @ |
slowvoc on |
slowvoc on |
vocabulary new-locals |
vocabulary new-locals |
slowvoc ! |
slowvoc ! |
new-locals-map ' new-locals >body cell+ A! \ !! use special access words |
new-locals-map ' new-locals >body wordlist-map A! \ !! use special access words |
|
|
variable old-dpp |
variable old-dpp |
|
|
Line 456 forth definitions
|
Line 457 forth definitions
|
\ explicit scoping |
\ explicit scoping |
|
|
: scope ( compilation -- scope ; run-time -- ) \ gforth |
: scope ( compilation -- scope ; run-time -- ) \ gforth |
cs-push-part scopestart ; immediate |
cs-push-part scopestart ; immediate |
|
|
|
: adjust-locals-list ( wid -- ) |
|
locals-list wordlist-id @ common-list |
|
dup list-size adjust-locals-size |
|
locals-list wordlist-id ! ; |
|
|
: endscope ( compilation scope -- ; run-time -- ) \ gforth |
: endscope ( compilation scope -- ; run-time -- ) \ gforth |
scope? |
scope? |
drop |
drop adjust-locals-list ; immediate |
locals-list @ common-list |
|
dup list-size adjust-locals-size |
|
locals-list ! ; immediate |
|
|
|
\ adapt the hooks |
\ adapt the hooks |
|
|
Line 474 forth definitions
|
Line 477 forth definitions
|
clear-leave-stack |
clear-leave-stack |
0 locals-size ! |
0 locals-size ! |
locals-buffer locals-dp ! |
locals-buffer locals-dp ! |
0 locals-list ! |
0 locals-list wordlist-id ! |
dead-code off |
dead-code off |
defstart ; |
defstart ; |
|
|
Line 509 forth definitions
|
Line 512 forth definitions
|
else \ both live |
else \ both live |
over list-size adjust-locals-size |
over list-size adjust-locals-size |
>resolve |
>resolve |
locals-list @ common-list dup list-size adjust-locals-size |
adjust-locals-list |
locals-list ! |
|
then |
then |
then ; |
then ; |
|
|
Line 646 forth definitions
|
Line 648 forth definitions
|
case |
case |
[ ' locals-wordlist ] literal >definer \ value |
[ ' locals-wordlist ] literal >definer \ value |
OF >body POSTPONE Aliteral POSTPONE ! ENDOF |
OF >body POSTPONE Aliteral POSTPONE ! ENDOF |
[ comp' clocal drop ] literal >definer |
\ !! 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 |
OF POSTPONE laddr# >body @ lp-offset, POSTPONE c! ENDOF |
[ comp' wlocal drop ] literal >definer |
[ comp' wlocal drop >definer ] literal |
OF POSTPONE laddr# >body @ lp-offset, POSTPONE ! ENDOF |
OF POSTPONE laddr# >body @ lp-offset, POSTPONE ! ENDOF |
[ comp' dlocal drop ] literal >definer |
[ comp' dlocal drop >definer ] literal |
OF POSTPONE laddr# >body @ lp-offset, POSTPONE 2! ENDOF |
OF POSTPONE laddr# >body @ lp-offset, POSTPONE 2! ENDOF |
[ comp' flocal drop ] literal >definer |
[ comp' flocal drop >definer ] literal |
OF POSTPONE laddr# >body @ lp-offset, POSTPONE f! ENDOF |
OF POSTPONE laddr# >body @ lp-offset, POSTPONE f! ENDOF |
-&32 throw |
-&32 throw |
endcase ; |
endcase ; |