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 \ The pForth software code is dedicated to the public domain,
16 \ and any third party may reproduce, distribute and modify
17 \ the pForth software code or any derivative works thereof
18 \ without any compensation or license. The pForth software
19 \ code is provided on an "as is" basis without any warranty
20 \ of any kind, including, without limitation, the implied
21 \ warranties of merchantability and fitness for a particular
22 \ purpose and their equivalents under the laws of any jurisdiction.
24 \ 10/27/99 Fixed : foo { -- } 55 ; was entering local frame but not exiting.
26 anew task-ansilocs.fth
31 16 constant LV_MAX_VARS \ maximum number of local variables
32 31 constant LV_MAX_CHARS \ maximum number of letters in name
34 lv_max_vars lv_max_chars $array LV-NAMES
35 variable LV-#NAMES \ number of names currently defined
37 \ Search name table for match
38 : LV.MATCH ( $string -- index true | $string false )
48 : LV.COMPILE.FETCH ( index -- )
49 1+ \ adjust for optimised (local@), LocalsPtr points above vars
51 1 OF compile (1_local@) ENDOF
52 2 OF compile (2_local@) ENDOF
53 3 OF compile (3_local@) ENDOF
54 4 OF compile (4_local@) ENDOF
55 5 OF compile (5_local@) ENDOF
56 6 OF compile (6_local@) ENDOF
57 7 OF compile (7_local@) ENDOF
58 8 OF compile (8_local@) ENDOF
59 dup [compile] literal compile (local@)
63 : LV.COMPILE.STORE ( index -- )
64 1+ \ adjust for optimised (local!), LocalsPtr points above vars
66 1 OF compile (1_local!) ENDOF
67 2 OF compile (2_local!) ENDOF
68 3 OF compile (3_local!) ENDOF
69 4 OF compile (4_local!) ENDOF
70 5 OF compile (5_local!) ENDOF
71 6 OF compile (6_local!) ENDOF
72 7 OF compile (7_local!) ENDOF
73 8 OF compile (8_local!) ENDOF
74 dup [compile] literal compile (local!)
78 : LV.COMPILE.LOCAL ( $name -- handled? , check for matching locals name )
79 \ ." LV.COMPILER.LOCAL name = " dup count type cr
89 : LV.CLEANUP ( -- , restore stack frame on exit from colon def )
95 : LV.FINISH ( -- , restore stack frame on exit from colon def )
106 ." Locals turned off" cr
115 : (LOCAL) ( adr len -- , ANSI local primitive )
118 lv-#names @ lv_max_vars >= abort" Too many local variables!"
119 lv-#names @ lv-names place
120 \ Warn programmer if local variable matches an existing dictionary name.
121 lv-#names @ lv-names find nip
124 lv-#names @ lv-names count type
125 ." redefined as a local variable in "
130 \ Last local. Finish building local stack frame.
132 lv-#names @ dup 0= \ fixed 10/27/99, Thanks to John Providenza
134 drop ." (LOCAL) - Warning: no locals defined!" cr
136 [compile] literal compile (local.entry)
137 ['] lv.compile.local local-compiler !
157 : TO ( val <name> -- )
164 1 = 0= abort" TO or -> before non-local or non-value"
165 >body \ point to data
167 IF \ compiling ( -- pfa )
170 ELSE \ executing ( -- val pfa )
176 : -> ( -- ) [compile] to ; immediate
178 : +-> ( val <name> -- )
182 1+ \ adjust for optimised (local!), LocalsPtr points above vars
183 [compile] literal compile (local+!)
186 1 = 0= abort" +-> before non-local or non-value"
187 >body \ point to data
189 IF \ compiling ( -- pfa )
192 ELSE \ executing ( -- val pfa )
199 : ; lv.finish [compile] ; ; immediate
200 : exit lv.cleanup compile exit ; immediate
201 : does> lv.finish [compile] does> ; immediate