1 /*
2 * CDDL HEADER START
3 *
4 * The contents of this file are subject to the terms of the
5 * Common Development and Distribution License, Version 1.0 only
6 * (the "License"). You may not use this file except in compliance
7 * with the License.
8 *
9 * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
10 * or http://www.opensolaris.org/os/licensing.
11 * See the License for the specific language governing permissions
12 * and limitations under the License.
13 *
14 * When distributing Covered Code, include this CDDL HEADER in each
15 * file and include the License file at usr/src/OPENSOLARIS.LICENSE.
16 * If applicable, add the following below this CDDL HEADER, with the
17 * fields enclosed by brackets "[]" replaced with your own identifying
18 * information: Portions Copyright [yyyy] [name of copyright owner]
19 *
20 * CDDL HEADER END
21 */
22 /*
23 * Copyright (c) 2000 by Sun Microsystems, Inc.
24 * All rights reserved.
25 */
26
27 #pragma ident "%Z%%M% %I% %E% SMI"
28
29 #include <stdio.h>
30 #include <string.h>
31
32 #include <fcode/private.h>
33 #include <fcode/log.h>
34
35 #define NUM_DEFAULT_ACTIONS 7
36
37 /*
38 * value_fetch and value_store are the same as "fetch" and "store", but
39 * we'll leave them implemented here for now.
40 */
41 static void
value_fetch(fcode_env_t * env)42 value_fetch(fcode_env_t *env)
43 {
44 variable_t *addr;
45
46 CHECK_DEPTH(env, 1, "value_fetch");
47 addr = (variable_t *)POP(DS);
48 PUSH(DS, (variable_t)*addr);
49 }
50
51 static void
value_store(fcode_env_t * env)52 value_store(fcode_env_t *env)
53 {
54 variable_t *addr;
55
56 CHECK_DEPTH(env, 1, "value_store");
57 addr = (variable_t *)POP(DS);
58 *addr = (variable_t)POP(DS);
59 }
60
61 void *
get_internal_address(fcode_env_t * env)62 get_internal_address(fcode_env_t *env)
63 {
64 int *ptr;
65
66 CHECK_DEPTH(env, 1, "get_internal_address");
67 ptr = (int *)POP(DS);
68 if (*ptr > 0)
69 return ((uchar_t *)env + *ptr);
70 return ((uchar_t *)MYSELF - *ptr);
71 }
72
73 void
internal_env_fetch(fcode_env_t * env)74 internal_env_fetch(fcode_env_t *env)
75 {
76 instance_t **iptr;
77
78 CHECK_DEPTH(env, 1, "internal_env_fetch");
79 iptr = (instance_t **)get_internal_address(env);
80 PUSH(DS, (fstack_t)(*iptr));
81 }
82
83 void
internal_env_store(fcode_env_t * env)84 internal_env_store(fcode_env_t *env)
85 {
86 instance_t **iptr;
87
88 CHECK_DEPTH(env, 2, "internal_env_store");
89 iptr = (instance_t **)get_internal_address(env);
90 *iptr = (instance_t *)POP(DS);
91 }
92
93 void
internal_env_addr(fcode_env_t * env)94 internal_env_addr(fcode_env_t *env)
95 {
96 fstack_t d;
97
98 CHECK_DEPTH(env, 1, "internal_env_addr");
99 d = (fstack_t)get_internal_address(env);
100 PUSH(DS, d);
101 }
102
103 void
do_buffer_data(fcode_env_t * env,token_t * d,int instance)104 do_buffer_data(fcode_env_t *env, token_t *d, int instance)
105 {
106 if (!*d) { /* check if buffer not alloc'ed yet */
107 token_t *buf;
108
109 if (instance) {
110 int n, off;
111
112 n = TOKEN_ROUNDUP(d[1]);
113 buf = alloc_instance_data(env, UINIT_DATA, n, &off);
114 memset(buf, 0, d[1]);
115 } else {
116 buf = (token_t *)HERE;
117 set_here(env, HERE + d[1], "do_buffer_data");
118 }
119 *d = (token_t)buf;
120 }
121 PUSH(DS, *d);
122 }
123
124 void
ibuffer_init(fcode_env_t * env)125 ibuffer_init(fcode_env_t *env)
126 {
127 token_t *d;
128
129 d = get_instance_address(env);
130 do_buffer_data(env, d, 1);
131 }
132
133 void
buffer_init(fcode_env_t * env)134 buffer_init(fcode_env_t *env)
135 {
136 token_t *d;
137
138 CHECK_DEPTH(env, 1, "buffer_init");
139 d = (token_t *)POP(DS);
140 do_buffer_data(env, d, 0);
141 }
142
143 void
do_defer(fcode_env_t * env)144 do_defer(fcode_env_t *env)
145 {
146 fetch(env);
147 execute(env);
148 }
149
150 token_t *value_actions[NUM_DEFAULT_ACTIONS];
151 token_t value_defines[NUM_DEFAULT_ACTIONS][3] = {
152 { (token_t)&value_fetch, (token_t)&value_store, (token_t)&noop },
153 { (token_t)&fetch_instance_data, (token_t)&set_instance_data,
154 (token_t)&address_instance_data },
155 { (token_t)&internal_env_fetch, (token_t)&internal_env_store,
156 (token_t)&internal_env_addr },
157 { (token_t)&do_defer, (token_t)&store, (token_t)&noop },
158 { (token_t)&idefer_exec, (token_t)&set_instance_data,
159 (token_t)&address_instance_data },
160 { (token_t)&buffer_init, (token_t)&two_drop, (token_t)&noop, },
161 { (token_t)&ibuffer_init, (token_t)&two_drop,
162 (token_t)&address_instance_data }
163 };
164
165 int
run_action(fcode_env_t * env,acf_t acf,int action)166 run_action(fcode_env_t *env, acf_t acf, int action)
167 {
168 token_t *p = (token_t *)acf;
169
170 if ((p[0] & 1) == 0) {
171 log_message(MSG_WARN, "run_action: acf: %p @acf: %p not"
172 " indirect\n", acf, p[0]);
173 return (1);
174 }
175
176 p = (token_t *)(p[0] & ~1);
177
178 if (action >= p[1] || action < 0) {
179 log_message(MSG_WARN, "run_action: acf: %p action: %d"
180 " out of range: 0-%d\n", acf, action, (int)p[1]);
181 return (1);
182 }
183
184 if (p[0] == (token_t)&do_default_action) {
185 fstack_t d;
186
187 d = (fstack_t)p[action+2];
188 PUSH(DS, d);
189 execute(env);
190 return (0);
191 }
192 log_message(MSG_WARN, "run_action: acf: %p/%p not default action\n",
193 acf, p[0]);
194 return (1);
195 }
196
197 void
do_default_action(fcode_env_t * env)198 do_default_action(fcode_env_t *env)
199 {
200 acf_t a;
201
202 CHECK_DEPTH(env, 1, "do_default_action");
203 a = (acf_t)TOS;
204 (void) run_action(env, (a-1), 0);
205 }
206
207 void
do_set_action(fcode_env_t * env)208 do_set_action(fcode_env_t *env)
209 {
210 acf_t a = (acf_t)TOS;
211
212 CHECK_DEPTH(env, 1, "do_set_action");
213 TOS += sizeof (acf_t);
214 (void) run_action(env, a, 1);
215 }
216
217 void
action_colon(fcode_env_t * env)218 action_colon(fcode_env_t *env)
219 {
220 token_roundup(env, "action_colon");
221 env->action_ptr[env->action_count] = (token_t)HERE;
222 COMPILE_TOKEN(&do_colon);
223 env->action_count++;
224 env->state |= 1;
225 }
226
227 void
actions(fcode_env_t * env)228 actions(fcode_env_t *env)
229 {
230 int n;
231 token_t *d;
232
233 token_roundup(env, "actions");
234 d = (token_t *)HERE;
235 *d++ = (token_t)&do_default_action;
236 n = (int)POP(DS);
237 *d++ = n;
238 env->num_actions = n;
239 env->action_count = 0;
240 env->action_ptr = d;
241 d += n;
242 set_here(env, (uchar_t *)d, "actions");
243 }
244
245 void
install_actions(fcode_env_t * env,token_t * table)246 install_actions(fcode_env_t *env, token_t *table)
247 {
248 acf_t *dptr;
249 token_t p;
250
251 dptr = (acf_t *)LINK_TO_ACF(env->lastlink);
252 p = (token_t)table;
253 p -= (sizeof (token_t) + sizeof (acf_t));
254 *dptr = (acf_t)(p | 1);
255 }
256
257 void
use_actions(fcode_env_t * env)258 use_actions(fcode_env_t *env)
259 {
260 if (env->state) {
261 TODO; /* use-actions in compile state. */
262 } else {
263 install_actions(env, env->action_ptr);
264 }
265 }
266
267 void
perform_action(fcode_env_t * env)268 perform_action(fcode_env_t *env)
269 {
270 int n;
271 acf_t a;
272
273 CHECK_DEPTH(env, 2, "perform_action");
274 n = POP(DS);
275 a = (acf_t)POP(DS);
276 PUSH(DS, (fstack_t)ACF_TO_BODY(a));
277
278 if (run_action(env, a, n)) {
279 system_message(env, "Bad Object action");
280 }
281 }
282
283 void
define_actions(fcode_env_t * env,int n,token_t * array)284 define_actions(fcode_env_t *env, int n, token_t *array)
285 {
286 int a;
287
288 PUSH(DS, (fstack_t)n);
289 actions(env);
290
291 a = 0;
292 while (n--) {
293 action_colon(env);
294 COMPILE_TOKEN(&array[a]);
295 env->state |= 8;
296 semi(env);
297 a++;
298 }
299 }
300
301 /*
302 * This is for things like my-self which have meaning to the
303 * forth engine but I don't want to turn them into standard forth values
304 * that would make the 'C' variables hard to understand, instead these
305 * 'global' state variables will act directly upon the native 'C' structures.
306 */
307
308 void
set_internal_value_actions(fcode_env_t * env)309 set_internal_value_actions(fcode_env_t *env)
310 {
311 ASSERT(value_actions[2]);
312 install_actions(env, value_actions[2]);
313 }
314
315 void
set_value_actions(fcode_env_t * env,int which)316 set_value_actions(fcode_env_t *env, int which)
317 {
318 ASSERT((which == 0) || (which == 1));
319 ASSERT(value_actions[which]);
320 install_actions(env, value_actions[which]);
321 }
322
323 void
set_defer_actions(fcode_env_t * env,int which)324 set_defer_actions(fcode_env_t *env, int which)
325 {
326 ASSERT((which == 0) || (which == 1));
327 ASSERT(value_actions[which+3]);
328 install_actions(env, value_actions[which+3]);
329 }
330
331 void
set_buffer_actions(fcode_env_t * env,int which)332 set_buffer_actions(fcode_env_t *env, int which)
333 {
334 ASSERT((which == 0) || (which == 1));
335 ASSERT(value_actions[which+5]);
336 install_actions(env, value_actions[which+5]);
337 }
338
339 #if defined(DEBUG)
340
341 void
do_get(fcode_env_t * env)342 do_get(fcode_env_t *env)
343 {
344 PUSH(DS, 0);
345 perform_action(env);
346 }
347
348 void
do_set(fcode_env_t * env)349 do_set(fcode_env_t *env)
350 {
351 PUSH(DS, 1);
352 perform_action(env);
353 }
354
355 void
do_addr(fcode_env_t * env)356 do_addr(fcode_env_t *env)
357 {
358 PUSH(DS, 2);
359 perform_action(env);
360 }
361
362 void
dump_actions(fcode_env_t * env)363 dump_actions(fcode_env_t *env)
364 {
365 int i;
366 for (i = 0; i < NUM_DEFAULT_ACTIONS; i++) {
367 log_message(MSG_INFO, "Action Set: %d = %p\n", i,
368 value_actions[i]);
369 }
370 }
371 #endif /* DEBUG */
372
373 #pragma init(_init)
374
375 static void
_init(void)376 _init(void)
377 {
378 fcode_env_t *env = initial_env;
379 int i;
380
381 ASSERT(env);
382 NOTICE;
383
384 for (i = 0; i < NUM_DEFAULT_ACTIONS; i++) {
385 define_actions(env, 3, value_defines[i]);
386 value_actions[i] = env->action_ptr;
387 }
388
389 #if defined(DEBUG)
390 FORTH(0, "get", do_get);
391 FORTH(0, "set", do_set);
392 FORTH(0, "addr", do_addr);
393 FORTH(0, "dump-actions", dump_actions);
394 FORTH(IMMEDIATE, "actions", actions);
395 FORTH(IMMEDIATE, "use-actions", use_actions);
396 FORTH(IMMEDIATE, "action:", action_colon);
397 FORTH(0, "perform-action", perform_action);
398 #endif /* DEBUG */
399 }
400