Commit | Line | Data |
---|---|---|
8e9db35f PB |
1 | \ @(#) ansilocs.fth 98/01/26 1.3 |
2 | \ local variable support words | |
3 | \ These support the ANSI standard (LOCAL) and TO words. | |
4 | \ | |
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 ) | |
11 | \ | |
12 | \ Author: Phil Burk | |
13 | \ Copyright 1994 3DO, Phil Burk, Larry Polansky, Devid Rosenboom | |
14 | \ | |
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. | |
23 | \ | |
24 | \ 10/27/99 Fixed : foo { -- } 55 ; was entering local frame but not exiting. | |
25 | ||
26 | anew task-ansilocs.fth | |
27 | ||
28 | private{ | |
29 | ||
30 | decimal | |
31 | 16 constant LV_MAX_VARS \ maximum number of local variables | |
32 | 31 constant LV_MAX_CHARS \ maximum number of letters in name | |
33 | ||
34 | lv_max_vars lv_max_chars $array LV-NAMES | |
35 | variable LV-#NAMES \ number of names currently defined | |
36 | ||
37 | \ Search name table for match | |
38 | : LV.MATCH ( $string -- index true | $string false ) | |
39 | 0 swap | |
40 | lv-#names @ 0 | |
41 | ?DO i lv-names | |
42 | over $= | |
43 | IF 2drop true i LEAVE | |
44 | THEN | |
45 | LOOP swap | |
46 | ; | |
47 | ||
48 | : LV.COMPILE.FETCH ( index -- ) | |
49 | 1+ \ adjust for optimised (local@), LocalsPtr points above vars | |
50 | CASE | |
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@) | |
60 | ENDCASE | |
61 | ; | |
62 | ||
63 | : LV.COMPILE.STORE ( index -- ) | |
64 | 1+ \ adjust for optimised (local!), LocalsPtr points above vars | |
65 | CASE | |
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!) | |
75 | ENDCASE | |
76 | ; | |
77 | ||
78 | : LV.COMPILE.LOCAL ( $name -- handled? , check for matching locals name ) | |
79 | \ ." LV.COMPILER.LOCAL name = " dup count type cr | |
80 | lv.match | |
81 | IF ( index ) | |
82 | lv.compile.fetch | |
83 | true | |
84 | ELSE | |
85 | drop false | |
86 | THEN | |
87 | ; | |
88 | ||
89 | : LV.CLEANUP ( -- , restore stack frame on exit from colon def ) | |
90 | lv-#names @ | |
91 | IF | |
92 | compile (local.exit) | |
93 | THEN | |
94 | ; | |
95 | : LV.FINISH ( -- , restore stack frame on exit from colon def ) | |
96 | lv.cleanup | |
97 | lv-#names off | |
98 | local-compiler off | |
99 | ; | |
100 | ||
101 | : LV.SETUP ( -- ) | |
102 | 0 lv-#names ! | |
103 | ; | |
104 | ||
105 | : LV.TERM | |
106 | ." Locals turned off" cr | |
107 | lv-#names off | |
108 | local-compiler off | |
109 | ; | |
110 | ||
111 | if.forgotten lv.term | |
112 | ||
113 | }private | |
114 | ||
115 | : (LOCAL) ( adr len -- , ANSI local primitive ) | |
116 | dup | |
117 | IF | |
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 | |
122 | IF | |
123 | ." (LOCAL) - Note: " | |
124 | lv-#names @ lv-names count type | |
125 | ." redefined as a local variable in " | |
126 | latest id. cr | |
127 | THEN | |
128 | 1 lv-#names +! | |
129 | ELSE | |
130 | \ Last local. Finish building local stack frame. | |
131 | 2drop | |
132 | lv-#names @ dup 0= \ fixed 10/27/99, Thanks to John Providenza | |
133 | IF | |
134 | drop ." (LOCAL) - Warning: no locals defined!" cr | |
135 | ELSE | |
136 | [compile] literal compile (local.entry) | |
137 | ['] lv.compile.local local-compiler ! | |
138 | THEN | |
139 | THEN | |
140 | ; | |
141 | ||
142 | ||
143 | : VALUE | |
144 | CREATE ( n <name> ) | |
145 | , | |
146 | immediate | |
147 | DOES> | |
148 | state @ | |
149 | IF | |
150 | [compile] aliteral | |
151 | compile @ | |
152 | ELSE | |
153 | @ | |
154 | THEN | |
155 | ; | |
156 | ||
157 | : TO ( val <name> -- ) | |
158 | bl word | |
159 | lv.match | |
160 | IF ( -- index ) | |
161 | lv.compile.store | |
162 | ELSE | |
163 | find | |
164 | 1 = 0= abort" TO or -> before non-local or non-value" | |
165 | >body \ point to data | |
166 | state @ | |
167 | IF \ compiling ( -- pfa ) | |
168 | [compile] aliteral | |
169 | compile ! | |
170 | ELSE \ executing ( -- val pfa ) | |
171 | ! | |
172 | THEN | |
173 | THEN | |
174 | ; immediate | |
175 | ||
176 | : -> ( -- ) [compile] to ; immediate | |
177 | ||
178 | : +-> ( val <name> -- ) | |
179 | bl word | |
180 | lv.match | |
181 | IF ( -- index ) | |
182 | 1+ \ adjust for optimised (local!), LocalsPtr points above vars | |
183 | [compile] literal compile (local+!) | |
184 | ELSE | |
185 | find | |
186 | 1 = 0= abort" +-> before non-local or non-value" | |
187 | >body \ point to data | |
188 | state @ | |
189 | IF \ compiling ( -- pfa ) | |
190 | [compile] aliteral | |
191 | compile +! | |
192 | ELSE \ executing ( -- val pfa ) | |
193 | +! | |
194 | THEN | |
195 | THEN | |
196 | ; immediate | |
197 | ||
198 | : : lv.setup : ; | |
199 | : ; lv.finish [compile] ; ; immediate | |
200 | : exit lv.cleanup compile exit ; immediate | |
201 | : does> lv.finish [compile] does> ; immediate | |
202 | ||
203 | privatize |