1 \ @(#) ansilocs.fth 98/01/26 1.3
2 \ local variable support words
3 \ These support the ANSI standard (LOCAL) and TO words.
5 \ They are built from the following low level primitives written in 'C':
6 \ (local@) ( i+1 -- n , fetch from ith local variable )
7 \ (local!) ( n i+1 -- , store to ith local variable )
8 \ (local.entry) ( num -- , allocate stack frame for num local variables )
9 \ (local.exit) ( -- , free local variable stack frame )
10 \ local-compiler ( -- addr , variable containing CFA of locals compiler )
13 \ Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom
15 \ Permission to use, copy, modify, and/or distribute this
16 \ software for any purpose with or without fee is hereby granted.
18 \ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
19 \ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
20 \ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
21 \ THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
22 \ CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING
23 \ FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
24 \ CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
25 \ OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
27 \ 10/27/99 Fixed : foo { -- } 55 ; was entering local frame but not exiting.
29 anew task-ansilocs.fth
34 16 constant LV_MAX_VARS \ maximum number of local variables
35 31 constant LV_MAX_CHARS \ maximum number of letters in name
37 lv_max_vars lv_max_chars $array LV-NAMES
38 variable LV-#NAMES \ number of names currently defined
40 \ Search name table for match
41 : LV.MATCH ( $string -- index true | $string false )
51 : LV.COMPILE.FETCH ( index -- )
52 1+ \ adjust for optimised (local@), LocalsPtr points above vars
54 1 OF compile (1_local@) ENDOF
55 2 OF compile (2_local@) ENDOF
56 3 OF compile (3_local@) ENDOF
57 4 OF compile (4_local@) ENDOF
58 5 OF compile (5_local@) ENDOF
59 6 OF compile (6_local@) ENDOF
60 7 OF compile (7_local@) ENDOF
61 8 OF compile (8_local@) ENDOF
62 dup [compile] literal compile (local@)
66 : LV.COMPILE.STORE ( index -- )
67 1+ \ adjust for optimised (local!), LocalsPtr points above vars
69 1 OF compile (1_local!) ENDOF
70 2 OF compile (2_local!) ENDOF
71 3 OF compile (3_local!) ENDOF
72 4 OF compile (4_local!) ENDOF
73 5 OF compile (5_local!) ENDOF
74 6 OF compile (6_local!) ENDOF
75 7 OF compile (7_local!) ENDOF
76 8 OF compile (8_local!) ENDOF
77 dup [compile] literal compile (local!)
81 : LV.COMPILE.LOCAL ( $name -- handled? , check for matching locals name )
82 \ ." LV.COMPILER.LOCAL name = " dup count type cr
92 : LV.CLEANUP ( -- , restore stack frame on exit from colon def )
98 : LV.FINISH ( -- , restore stack frame on exit from colon def )
109 ." Locals turned off" cr
118 : (LOCAL) ( adr len -- , ANSI local primitive )
121 lv-#names @ lv_max_vars >= abort" Too many local variables!"
122 lv-#names @ lv-names place
123 \ Warn programmer if local variable matches an existing dictionary name.
124 lv-#names @ lv-names find nip
127 lv-#names @ lv-names count type
128 ." redefined as a local variable in "
133 \ Last local. Finish building local stack frame.
135 lv-#names @ dup 0= \ fixed 10/27/99, Thanks to John Providenza
137 drop ." (LOCAL) - Warning: no locals defined!" cr
139 [compile] literal compile (local.entry)
140 ['] lv.compile.local local-compiler !
152 : TO ( val <name> -- )
160 >body \ point to data
162 IF \ compiling ( -- pfa )
165 ELSE \ executing ( -- val pfa )
171 : -> ( -- ) [compile] to ; immediate
173 : +-> ( val <name> -- )
177 1+ \ adjust for optimised (local!), LocalsPtr points above vars
178 [compile] literal compile (local+!)
182 >body \ point to data
184 IF \ compiling ( -- pfa )
187 ELSE \ executing ( -- val pfa )
194 : ; lv.finish [compile] ; ; immediate
195 : exit lv.cleanup compile exit ; immediate
196 : does> lv.finish [compile] does> ; immediate