| 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 |
| 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 |
| |
|
| : 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 |
| |
|
| 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 ; |
| |
|
| 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 ; |
| |
|