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