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, Devid 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 anew task-ansilocs.fth
29 16 constant LV_MAX_VARS \ maximum number of local variables
30 31 constant LV_MAX_CHARS \ maximum number of letters in name
32 lv_max_vars lv_max_chars $array LV-NAMES
33 variable LV-#NAMES \ number of names currently defined
35 \ Search name table for match
36 : LV.MATCH ( $string -- index true | $string false )
46 : LV.COMPILE.FETCH ( index -- )
47 1+ \ adjust for optimised (local@), LocalsPtr points above vars
49 1 OF compile (1_local@) ENDOF
50 2 OF compile (2_local@) ENDOF
51 3 OF compile (3_local@) ENDOF
52 4 OF compile (4_local@) ENDOF
53 5 OF compile (5_local@) ENDOF
54 6 OF compile (6_local@) ENDOF
55 7 OF compile (7_local@) ENDOF
56 8 OF compile (8_local@) ENDOF
57 dup [compile] literal compile (local@)
61 : LV.COMPILE.STORE ( index -- )
62 1+ \ adjust for optimised (local!), LocalsPtr points above vars
64 1 OF compile (1_local!) ENDOF
65 2 OF compile (2_local!) ENDOF
66 3 OF compile (3_local!) ENDOF
67 4 OF compile (4_local!) ENDOF
68 5 OF compile (5_local!) ENDOF
69 6 OF compile (6_local!) ENDOF
70 7 OF compile (7_local!) ENDOF
71 8 OF compile (8_local!) ENDOF
72 dup [compile] literal compile (local!)
76 : LV.COMPILE.LOCAL ( $name -- handled? , check for matching locals name )
77 \ ." LV.COMPILER.LOCAL name = " dup count type cr
87 : LV.CLEANUP ( -- , restore stack frame on exit from colon def )
93 : LV.FINISH ( -- , restore stack frame on exit from colon def )
104 ." Locals turned off" cr
113 : (LOCAL) ( adr len -- , ANSI local primitive )
116 lv-#names @ lv_max_vars >= abort" Too many local variables!"
117 lv-#names @ lv-names place
118 \ Warn programmer if local variable matches an existing dictionary name.
119 lv-#names @ lv-names find nip
122 lv-#names @ lv-names count type
123 ." redefined as a local variable in "
128 \ Last local. Finish building local stack frame.
130 lv-#names @ [compile] literal compile (local.entry)
131 ['] lv.compile.local local-compiler !
150 : TO ( val <name> -- )
157 1 = 0= abort" TO or -> before non-local or non-value"
158 >body \ point to data
160 IF \ compiling ( -- pfa )
163 ELSE \ executing ( -- val pfa )
169 : -> ( -- ) [compile] to ; immediate
171 : +-> ( val <name> -- )
175 1+ \ adjust for optimised (local!), LocalsPtr points above vars
176 [compile] literal compile (local+!)
179 1 = 0= abort" +-> before non-local or non-value"
180 >body \ point to data
182 IF \ compiling ( -- pfa )
185 ELSE \ executing ( -- val pfa )
192 : ; lv.finish [compile] ; ; immediate
193 : exit lv.cleanup compile exit ; immediate
194 : does> lv.finish [compile] does> ; immediate