version 1.34, 1997/07/06 15:55:24
|
version 1.40, 1999/03/23 20:24:18
|
Line 1
|
Line 1
|
\ A powerful locals implementation |
\ A powerful locals implementation |
|
|
\ Copyright (C) 1995 Free Software Foundation, Inc. |
\ Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
Line 129 require float.fs
|
Line 129 require float.fs
|
slowvoc @ |
slowvoc @ |
slowvoc on \ we want a linked list for the vocabulary locals |
slowvoc on \ we want a linked list for the vocabulary locals |
vocabulary locals \ this contains the local variables |
vocabulary locals \ this contains the local variables |
' locals >body ' locals-list >body ! |
' locals >body wordlist-id ' locals-list >body ! |
slowvoc ! |
slowvoc ! |
|
|
create locals-buffer 1000 allot \ !! limited and unsafe |
create locals-buffer 1000 allot \ !! limited and unsafe |
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 ! |
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 |
Line 292 locals-types definitions
|
Line 292 locals-types definitions
|
postpone laddr# @ lp-offset, ; |
postpone laddr# @ lp-offset, ; |
|
|
\ you may want to make comments in a locals definitions group: |
\ you may want to make comments in a locals definitions group: |
' \ alias \ immediate |
' \ alias \ ( -- ) \ core-ext,block-ext backslash |
' ( alias ( immediate |
\G Line comment: if @code{BLK} contains 0, parse and discard the remainder |
|
\G of the parse area. Otherwise, parse and discard all subsequent characters in the |
|
\G parse area corresponding to the current line. |
|
immediate |
|
|
|
' ( alias ( ( compilation 'ccc<close-paren>' -- ; run-time -- ) \ core,file paren |
|
\G Comment: parse and discard all subsequent characters in the parse |
|
\G area until "@code{)}" is encountered. During interactive input, an end-of-line |
|
\G also acts as a comment terminator. For file input, it does not; if the |
|
\G end-of-file is encountered whilst parsing for the "@code{)}" delimiter, Gforth |
|
\G will generate a warning. |
|
immediate |
|
|
forth definitions |
forth definitions |
|
|
Line 328 slowvoc @
|
Line 339 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 356 locals-types definitions
|
Line 367 locals-types definitions
|
locals-size @ alignlp-f locals-size ! \ the strictest alignment |
locals-size @ alignlp-f locals-size ! \ the strictest alignment |
previous previous |
previous previous |
set-current lastcfa ! |
set-current lastcfa ! |
locals-list TO locals-wordlist ; |
locals-list 0 wordlist-id - TO locals-wordlist ; |
|
|
: -- ( addr wid 0 ... -- ) \ gforth dash-dash |
: -- ( addr wid 0 ... -- ) \ gforth dash-dash |
} |
} |
Line 457 forth definitions
|
Line 468 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 @ common-list |
|
dup list-size adjust-locals-size |
|
locals-list ! ; |
|
|
: 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 510 forth definitions
|
Line 523 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 647 forth definitions
|
Line 659 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 ; |