?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
fm: remove sparc-only modules
[unleashed.git] / usr / src / lib / efcode / engine / fcode.c
blobe8cedb3816eb52455c19e6b56d5497424b32b065
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 <stdlib.h>
31 #include <string.h>
32 #include <ctype.h>
33
34 #include <fcode/private.h>
35 #include <fcode/log.h>
36
37 int fcode_impl_count = 0;
38
39 void (*crash_ptr)(fcode_env_t *env) = do_crash;
40
41 uchar_t
42 next_bytecode(fcode_env_t *env)
43 {
44 uchar_t byte;
45
46 byte = *env->fcode_ptr;
47 env->fcode_ptr += env->fcode_incr;
48 return (byte);
49 }
50
51 ushort_t
52 get_next_token(fcode_env_t *env)
53 {
54 ushort_t token = next_bytecode(env);
55 if ((token) && (token < 0x10)) {
56 token = (token << 8) | next_bytecode(env);
57 }
58 env->last_fcode = token;
59 return (token);
60 }
61
62 ushort_t
63 get_short(fcode_env_t *env)
64 {
65 ushort_t u;
66
67 /*
68 * Logical or DOES NOT guarantee left to right evaluation...
69 */
70 u = next_bytecode(env) << 8;
71 return (u | next_bytecode(env));
72 }
73
74 uint_t
75 get_int(fcode_env_t *env)
76 {
77 uint_t u;
78
79 /*
80 * Logical or DOES NOT guarantee left to right evaluation...
81 */
82 u = get_short(env) << 16;
83 return (u | get_short(env));
84 }
85
86 void
87 expose_acf(fcode_env_t *env, char *name)
88 {
89 if (name == NULL)
90 name = "<unknown>";
91 EXPOSE_ACF;
92 debug_msg(DEBUG_CONTEXT, "CONTEXT:expose_acf: acf: %p/'%s' %p\n",
93 LINK_TO_ACF(env->lastlink), name, env->current);
94 }
95
96 void
97 do_code(fcode_env_t *env, int token, char *name, void (*fn)(fcode_env_t *))
98 {
99 env->table[token].name = name;
100 if (fn == NULL) {
101 env->table[token].apf = NULL;
102 env->table[token].name = name;
103 } else {
104 header(env, name, strlen(name), 0);
105 env->table[token].apf = (acf_t)HERE;
106 COMPILE_TOKEN(fn);
107 expose_acf(env, name);
108 }
109 }
110
111 void
112 define_word(fcode_env_t *env, int flag, char *name, void (*fn)(fcode_env_t *))
113 {
114 header(env, name, strlen(name), flag);
115 COMPILE_TOKEN(fn);
116 expose_acf(env, name);
117 }
118
119 void
120 end0(fcode_env_t *env)
121 {
122 env->interpretting = 0;
123 }
124
125 static void
126 end1(fcode_env_t *env)
127 {
128 env->interpretting = 0;
129 }
130
131 void
132 blit(fcode_env_t *env)
133 {
134 fstack_t d = (int)get_int(env);
135 PUSH(DS, d);
136 literal(env);
137 }
138
139 void (*bbranch_ptrs[3])(fcode_env_t *env) = {
140 do_bbranch,
141 do_bqbranch,
142 do_bofbranch
143 };
144
145 void
146 branch_common(fcode_env_t *env, short direction, fstack_t which, int doswap)
147 {
148 fstack_t *sp;
149 token_t *branch_loc;
150
151 ASSERT((which < 3) && (which >= 0));
152 which = (fstack_t)&bbranch_ptrs[which];
153 set_temporary_compile(env);
154 COMPILE_TOKEN(which);
155 if (direction >= 0) {
156 bmark(env);
157 if (doswap)
158 swap(env);
159 PUSH(DS, 0);
160 compile_comma(env);
161 } else {
162
163 /*
164 * We look down the stack for a branch location
165 * that isn't pointing to zero (i.e. a forward branch label).
166 * We move the first one we find to the top of the stack,
167 * which is what gets compiled in with 'compile_comma'.
168 * Not finding a valid branch label is bad.
169 */
170 for (sp = env->ds; sp >= env->ds0; sp--) {
171 branch_loc = (token_t *)*sp;
172 if (branch_loc && *branch_loc) {
173 break;
174 }
175 }
176 if (sp < env->ds0)
177 log_message(MSG_ERROR, "branch_common: back: "
178 "no branch loc on stack\n");
179 else {
180 /* Move branch_loc to top of data stack */
181 for (; sp < env->ds; sp++)
182 *sp = sp[1];
183 *sp = (fstack_t)branch_loc;
184 }
185 env->level--;
186 compile_comma(env);
187 temporary_execute(env);
188 }
189 }
190
191 void
192 bbranch(fcode_env_t *env)
193 {
194 short offset = (short)get_short(env);
195
196 branch_common(env, offset, 0, 1);
197 }
198
199 void
200 bqbranch(fcode_env_t *env)
201 {
202 short offset = (short)get_short(env);
203
204 branch_common(env, offset, 1, 0);
205 }
206
207 void
208 do_quote(fcode_env_t *env)
209 {
210 int len;
211 uchar_t *strptr;
212
213 strptr = (uchar_t *)IP;
214 len = *strptr;
215 PUSH(DS, (fstack_t)strptr+1);
216 PUSH(DS, len);
217 strptr += TOKEN_ROUNDUP(len+2);
218 IP = (token_t *)strptr;
219 }
220
221 void
222 bquote(fcode_env_t *env)
223 {
224 char stringbuff[256];
225 int len, count;
226 char *strptr;
227
228 count = len = next_bytecode(env);
229 if (env->state) {
230 COMPILE_TOKEN(&quote_ptr);
231 strptr = (char *)HERE;
232 *strptr++ = len;
233 while (count--)
234 *strptr++ = next_bytecode(env);
235 *strptr++ = 0;
236 set_here(env, (uchar_t *)strptr, "bquote");
237 token_roundup(env, "bquote");
238 } else {
239 strptr = stringbuff;
240 while (count--)
241 *strptr++ = next_bytecode(env);
242 *strptr = 0;
243 push_string(env, stringbuff, len);
244 }
245 }
246
247 char *
248 get_name(token_t *linkp)
249 {
250 char *name, *p;
251 flag_t *fptr = LINK_TO_FLAGS(linkp);
252 int len;
253 char *cptr;
254
255 if (*fptr & FLAG_NONAME)
256 return (NULL);
257
258 cptr = (char *)fptr;
259 len = cptr[-1];
260 if (len <= 0 || len > 64 || cptr[-2] != '\0')
261 return (NULL);
262
263 name = cptr - (len+2);
264
265 for (p = name; *p != '\0'; p++)
266 if (!isprint(*p))
267 return (NULL);
268
269 if ((p - name) != len)
270 return (NULL);
271
272 return (name);
273 }
274
275 void
276 header(fcode_env_t *env, char *name, int len, flag_t flag)
277 {
278 char *strptr;
279 flag_t *fptr;
280 acf_t dptr;
281 extern void add_debug_acf(fcode_env_t *, acf_t);
282
283 /* Now form the entry in the dictionary */
284 token_roundup(env, "header");
285 dptr = (acf_t)HERE;
286 if (len) {
287 int bytes = len+2+sizeof (flag_t);
288 dptr = (acf_t)(TOKEN_ROUNDUP(HERE+bytes));
289 fptr = LINK_TO_FLAGS(dptr);
290 strptr = (char *)fptr - 1;
291 *strptr-- = len;
292 *strptr-- = 0;
293 while (len)
294 *strptr-- = name[--len];
295 } else {
296 dptr++;
297 fptr = LINK_TO_FLAGS(dptr);
298 flag |= FLAG_NONAME;
299 }
300 *fptr = flag;
301 *dptr = *((acf_t)env->current);
302 env->lastlink = dptr++;
303 set_here(env, (uchar_t *)dptr, "header");
304
305 if (name_is_debugged(env, name)) {
306 log_message(MSG_INFO, "Turning debug on for %s\n", name);
307 add_debug_acf(env, LINK_TO_ACF(env->lastlink));
308 }
309 debug_msg(DEBUG_HEADER, "Define: '%s' @ %p\n", name, HERE);
310 }
311
312 void
313 token_common(fcode_env_t *env, int headered, int visible)
314 {
315 char namebuff[32];
316 int len, count, token;
317 char *strptr, c;
318
319 strptr = namebuff;
320 if (headered) {
321 len = next_bytecode(env);
322 for (count = 0; count < len; count++) {
323 c = next_bytecode(env);
324 if (count < sizeof (namebuff))
325 *strptr++ = c;
326 }
327 }
328
329 if (!visible)
330 len = 0;
331 *strptr = 0;
332 token = get_short(env);
333 env->last_token = token;
334
335 debug_msg(DEBUG_NEW_TOKEN, "Define %s token: '%s' (%x)\n",
336 (visible ? "named" : "headerless"), namebuff, token);
337
338 header(env, namebuff, len, 0);
339 env->table[token].flags = 0;
340 if (len) {
341 env->table[token].name = MALLOC(len+1);
342 strncpy(env->table[token].name, namebuff, len);
343 } else {
344 env->table[token].name = NULL;
345 }
346 env->last_token = token;
347 }
348
349 void
350 named_token(fcode_env_t *env)
351 {
352 token_common(env, 1, env->fcode_debug);
353 }
354
355 void
356 external_token(fcode_env_t *env)
357 {
358 token_common(env, 1, 1);
359 }
360
361 void
362 new_token(fcode_env_t *env)
363 {
364 token_common(env, 0, 0);
365 }
366
367 void
368 offset16(fcode_env_t *env)
369 {
370 env->offset_incr = 2;
371 }
372
373 void
374 minus_one(fcode_env_t *env)
375 {
376 PUSH(DS, -1);
377 }
378
379 void
380 zero(fcode_env_t *env)
381 {
382 PUSH(DS, 0);
383 }
384
385 void
386 one(fcode_env_t *env)
387 {
388 PUSH(DS, 1);
389 }
390
391 void
392 two(fcode_env_t *env)
393 {
394 PUSH(DS, 2);
395 }
396
397 void
398 three(fcode_env_t *env)
399 {
400 PUSH(DS, 3);
401 }
402
403 void
404 version1(fcode_env_t *env)
405 {
406 env->fcode_incr = 1;
407 }
408
409 static void
410 start0(fcode_env_t *env)
411 {
412 env->fcode_incr = 1;
413 }
414
415 static void
416 start1(fcode_env_t *env)
417 {
418 env->fcode_incr = 1;
419 }
420
421 void
422 start2(fcode_env_t *env)
423 {
424 env->fcode_incr = 2;
425 }
426
427 static void
428 start4(fcode_env_t *env)
429 {
430 env->fcode_incr = 4;
431 }
432
433 int
434 check_fcode_header(char *fname, uchar_t *header, int len)
435 {
436 uint32_t length;
437 static char func_name[] = "check_fcode_header";
438
439 if (len <= 8) {
440 log_message(MSG_ERROR, "%s: '%s' fcode size (%d) <= 8\n",
441 func_name, fname, len);
442 return (0);
443 }
444 if (header[0] != 0xf1 && header[0] != 0xfd) {
445 log_message(MSG_ERROR, "%s: '%s' header[0] is 0x%02x not"
446 " 0xf1/0xfd\n", func_name, fname, header[0]);
447 return (0);
448 }
449 length = (header[4] << 24) | (header[5] << 16) | (header[6] << 8) |
450 header[7];
451 if (length > len) {
452 log_message(MSG_ERROR, "%s: '%s' length (%d) >"
453 " fcode size (%d)\n", func_name, fname, length, len);
454 return (0);
455 }
456 if (length < len) {
457 log_message(MSG_WARN, "%s: '%s' length (%d) <"
458 " fcode size (%d)\n", func_name, fname, length, len);
459 }
460 return (1);
461 }
462
463 void
464 byte_load(fcode_env_t *env)
465 {
466 uchar_t *fcode_buffer;
467 uchar_t *fcode_ptr;
468 int fcode_incr;
469 int offset_incr;
470 int fcode_xt;
471 int interpretting;
472 int depth;
473 int length;
474 int past_eob = 0;
475 int db;
476
477 /* save any existing interpret state */
478 fcode_buffer = env->fcode_buffer;
479 fcode_ptr = env->fcode_ptr;
480 fcode_incr = env->fcode_incr;
481 offset_incr = env->offset_incr;
482 interpretting = env->interpretting;
483 depth = DEPTH-2;
484
485 /* Now init them */
486 CHECK_DEPTH(env, 2, "byte-load");
487 fcode_xt = POP(DS);
488 env->fcode_ptr = env->fcode_buffer = (uchar_t *)POP(DS);
489 if (fcode_xt != 1) {
490 log_message(MSG_WARN, "byte-load: ignoring xt\n");
491 }
492
493 length = (env->fcode_buffer[4] << 24) | (env->fcode_buffer[5] << 16) |
494 (env->fcode_buffer[6] << 8) | env->fcode_buffer[7];
495 if (!check_fcode_header("byte-load", env->fcode_ptr, length))
496 log_message(MSG_WARN, "byte-load: header NOT OK\n");
497
498 env->fcode_incr = 1;
499 env->offset_incr = 1;
500 env->interpretting = 1;
501 env->level = 0;
502
503 db = get_interpreter_debug_level() &
504 (DEBUG_BYTELOAD_DS|DEBUG_BYTELOAD_RS|DEBUG_BYTELOAD_TOKENS);
505 debug_msg(db, "byte_load: %p, %d\n", env->fcode_buffer, fcode_xt);
506 debug_msg(db, " header: %x, %x\n",
507 env->fcode_buffer[0], env->fcode_buffer[1]);
508 debug_msg(db, " crc: %x\n",
509 (env->fcode_buffer[2]<<8)|(env->fcode_buffer[3]));
510 debug_msg(db, " length: %x\n", length);
511 env->fcode_ptr += 8;
512
513 debug_msg(db, "Interpretting: %d\n", env->interpretting);
514
515 while (env->interpretting) {
516 int token;
517 fcode_token *entry;
518 acf_t apf;
519
520 if (!past_eob && env->fcode_ptr >= env->fcode_buffer + length) {
521 log_message(MSG_WARN, "byte-load: past EOB\n");
522 past_eob = 1;
523 }
524
525 env->last_fcode_ptr = env->fcode_ptr;
526 token = get_next_token(env);
527
528 entry = &env->table[token];
529 apf = entry->apf;
530
531 DEBUGF(BYTELOAD_DS, output_data_stack(env, MSG_FC_DEBUG));
532 DEBUGF(BYTELOAD_RS, output_return_stack(env, 1, MSG_FC_DEBUG));
533 DEBUGF(BYTELOAD_TOKENS, log_message(MSG_FC_DEBUG,
534 "%s: %04x %03x %s (%x)",
535 ((env->state && (entry->flags & IMMEDIATE) == 0)) ?
536 "Compile" : "Execute",
537 env->last_fcode_ptr - env->fcode_buffer, token,
538 entry->name ? entry->name : "???", entry->flags));
539 if (db)
540 log_message(MSG_FC_DEBUG, "\n");
541 if (apf) {
542 DEBUGF(TOKEN_USAGE, entry->usage++);
543 PUSH(DS, (fstack_t)apf);
544 if ((env->state) &&
545 ((entry->flags & IMMEDIATE) == 0)) {
546 /* Compile in references */
547 compile_comma(env);
548 } else {
549 execute(env);
550 }
551 }
552 }
553 if (DEPTH != depth) {
554 log_message(MSG_ERROR, "FCODE has net stack change of %d\n",
555 DEPTH-depth);
556 }
557 /* restore old state */
558 env->fcode_ptr = fcode_ptr;
559 env->fcode_buffer = fcode_buffer;
560 env->fcode_incr = fcode_incr;
561 env->offset_incr = offset_incr;
562 env->interpretting = interpretting;
563 }
564
565 void
566 btick(fcode_env_t *env)
567 {
568 int token = get_next_token(env);
569
570 PUSH(DS, (fstack_t)env->table[token].apf);
571 tick_literal(env);
572 }
573
574 static void
575 show_fcode_def(fcode_env_t *env, char *type)
576 {
577 int i = env->last_token;
578
579 if (get_interpreter_debug_level() & DEBUG_DUMP_TOKENS) {
580 if (env->table[i].name)
581 log_message(MSG_INFO, "%s: %s %03x %p\n", type,
582 env->table[i].name, i, env->table[i].apf);
583 else
584 log_message(MSG_INFO, "%s: <noname> %03x %p\n", type, i,
585 env->table[i].apf);
586 }
587 }
588
589 void
590 bcolon(fcode_env_t *env)
591 {
592 if (env->state == 0) {
593 env->table[env->last_token].apf = (acf_t)HERE;
594 env->table[env->last_token].flags = 0;
595 show_fcode_def(env, "bcolon");
596 }
597 env->state |= 1;
598 COMPILE_TOKEN(&do_colon);
599 }
600
601 void
602 bcreate(fcode_env_t *env)
603 {
604 env->table[env->last_token].apf = (acf_t)HERE;
605 show_fcode_def(env, "bcreate");
606 COMPILE_TOKEN(&do_create);
607 expose_acf(env, "<bcreate>");
608 }
609
610 void
611 get_token_name(fcode_env_t *env, int token, char **name, int *len)
612 {
613 *name = env->table[token].name;
614 if (*name) {
615 *len = strlen(*name);
616 } else
617 *len = 0;
618 }
619
620 void
621 bvalue(fcode_env_t *env)
622 {
623 env->table[env->last_token].apf = (acf_t)HERE;
624 show_fcode_def(env, "bvalue");
625 make_common_access(env, 0, 0, 1,
626 env->instance_mode, &noop, &noop, &set_value_actions);
627 }
628
629 void
630 bvariable(fcode_env_t *env)
631 {
632 env->table[env->last_token].apf = (acf_t)HERE;
633 show_fcode_def(env, "bvariable");
634 PUSH(DS, 0);
635 make_common_access(env, 0, 0, 1,
636 env->instance_mode, &instance_variable, &do_create, NULL);
637 }
638
639 void
640 bconstant(fcode_env_t *env)
641 {
642 env->table[env->last_token].apf = (acf_t)HERE;
643 show_fcode_def(env, "bconstant");
644 make_common_access(env, 0, 0, 1,
645 env->instance_mode, &do_constant, &do_constant, NULL);
646 }
647
648 void
649 bdefer(fcode_env_t *env)
650 {
651 env->table[env->last_token].apf = (acf_t)HERE;
652 show_fcode_def(env, "bdefer");
653
654 PUSH(DS, (fstack_t)&crash_ptr);
655 make_common_access(env, 0, 0, 1, env->instance_mode,
656 &noop, &noop, &set_defer_actions);
657 }
658
659 void
660 bbuffer_colon(fcode_env_t *env)
661 {
662 env->table[env->last_token].apf = (acf_t)HERE;
663 show_fcode_def(env, "buffer:");
664 PUSH(DS, 0);
665 make_common_access(env, 0, 0, 2, env->instance_mode,
666 &noop, &noop, &set_buffer_actions);
667 }
668
669 void
670 do_field(fcode_env_t *env)
671 {
672 fstack_t *d;
673
674 d = (fstack_t *)WA;
675 TOS += *d;
676 }
677
678 void
679 bfield(fcode_env_t *env)
680 {
681 env->table[env->last_token].apf = (acf_t)HERE;
682 show_fcode_def(env, "bfield");
683 COMPILE_TOKEN(&do_field);
684 over(env);
685 compile_comma(env);
686 add(env);
687 expose_acf(env, "<bfield>");
688 }
689
690 void
691 bto(fcode_env_t *env)
692 {
693 btick(env);
694
695 if (env->state) {
696 COMPILE_TOKEN(&to_ptr);
697 } else {
698 do_set_action(env);
699 }
700 }
701
702 void
703 get_token(fcode_env_t *env)
704 {
705 fstack_t tok;
706 fstack_t immediate = 0;
707
708 CHECK_DEPTH(env, 1, "get-token");
709 tok = POP(DS);
710 tok &= MAX_FCODE;
711 PUSH(DS, (fstack_t)env->table[tok].apf);
712 if (env->table[tok].flags & IMMEDIATE) immediate = 1;
713 PUSH(DS, immediate);
714 }
715
716 void
717 set_token(fcode_env_t *env)
718 {
719 fstack_t tok;
720 fstack_t immediate;
721 acf_t acf;
722
723 CHECK_DEPTH(env, 3, "set-token");
724 tok = POP(DS);
725 tok &= MAX_FCODE;
726 immediate = POP(DS);
727 acf = (acf_t)POP(DS);
728 if (immediate)
729 env->table[tok].flags |= IMMEDIATE;
730 else
731 env->table[tok].flags &= ~IMMEDIATE;
732 env->table[tok].apf = acf;
733 immediate = env->last_token;
734 env->last_token = tok;
735 show_fcode_def(env, "set_token");
736 env->last_token = immediate;
737 }
738
739 void
740 bof(fcode_env_t *env)
741 {
742 short offset = get_short(env);
743 branch_common(env, offset, 2, 0);
744 }
745
746 void
747 bcase(fcode_env_t *env)
748 {
749 env->level++;
750 set_temporary_compile(env);
751 PUSH(DS, 0);
752 }
753
754 void
755 bendcase(fcode_env_t *env)
756 {
757 COMPILE_TOKEN(env->table[0x46].apf); /* Hack for now... */
758 while (TOS) {
759 bresolve(env);
760 }
761 (void) POP(DS);
762 env->level--;
763 temporary_execute(env);
764 }
765
766 void
767 bendof(fcode_env_t *env)
768 {
769 short offset = get_short(env);
770 branch_common(env, offset, 0, 1);
771 bresolve(env);
772 }
773
774 void
775 fcode_revision(fcode_env_t *env)
776 {
777 /* We are Version 3.0 */
778 PUSH(DS, 0x30000);
779 }
780
781 void
782 alloc_mem(fcode_env_t *env)
783 {
784 CHECK_DEPTH(env, 1, "alloc-mem");
785 TOS = (fstack_t)MALLOC((size_t)TOS);
786 if (!TOS) {
787 throw_from_fclib(env, 1, "alloc-mem failed");
788 }
789 }
790
791 void
792 free_mem(fcode_env_t *env)
793 {
794 void *p;
795
796 CHECK_DEPTH(env, 2, "free-mem");
797 (void) POP(DS);
798 p = (void *) POP(DS);
799 FREE(p);
800 }
801
802 void
803 parse_two_int(fcode_env_t *env)
804 {
805 uint_t lo, hi;
806 char *str;
807 int len;
808
809 CHECK_DEPTH(env, 2, "parse-2int");
810 lo = 0;
811 hi = 0;
812 str = pop_a_string(env, &len);
813 if (len) {
814 if (sscanf(str, "%x,%x", &hi, &lo) != 2) {
815 throw_from_fclib(env, 1, "parse_2int");
816 }
817 }
818 PUSH(DS, lo);
819 PUSH(DS, hi);
820 }
821
822 void
823 left_parse_string(fcode_env_t *env)
824 {
825 char sep, *cptr, *lstr, *rstr;
826 int len, llen, rlen;
827
828 CHECK_DEPTH(env, 3, "left-parse-string");
829 sep = (char)POP(DS);
830 if (TOS == 0) {
831 two_dup(env);
832 return;
833 }
834 lstr = pop_a_string(env, &llen);
835 len = 0;
836 cptr = NULL;
837 while (len < llen) {
838 if (lstr[len] == sep) {
839 cptr = lstr+len;
840 break;
841 }
842 len++;
843 }
844 if (cptr != NULL) {
845 rstr = cptr+1;
846 rlen = lstr + llen - rstr;
847 llen = len;
848 } else {
849 rlen = 0;
850 rstr = lstr;
851 }
852 PUSH(DS, (fstack_t)rstr);
853 PUSH(DS, rlen);
854 PUSH(DS, (fstack_t)lstr);
855 PUSH(DS, llen);
856 }
857
858 /*
859 * (is-user-word) ( name-str name-len xt -- )
860 */
861 void
862 is_user_word(fcode_env_t *env)
863 {
864 fstack_t xt;
865 char *name;
866 int len;
867
868 CHECK_DEPTH(env, 3, "(is-user-word)");
869 xt = POP(DS);
870 name = pop_a_string(env, &len);
871 header(env, name, len, 0);
872 COMPILE_TOKEN(&do_alias);
873 COMPILE_TOKEN(xt);
874 expose_acf(env, name);
875 }
876
877 void
878 f_error(fcode_env_t *env)
879 {
880 #if 0
881 env->interpretting = 0;
882 log_message(MSG_ERROR, "Uniplemented FCODE token encountered %x\n",
883 env->last_fcode);
884 #else
885 forth_abort(env, "Unimplemented FCODE token: 0x%x\n", env->last_fcode);
886 #endif
887 }
888
889 static void
890 fcode_buffer_addr(fcode_env_t *env)
891 {
892 PUSH(DS, (fstack_t)(env->fcode_buffer));
893 }
894
895 #pragma init(_init)
896
897 static void
898 _init(void)
899 {
900 fcode_env_t *env = initial_env;
901
902 ASSERT(env);
903 NOTICE;
904
905 P1275(0x000, DEFINER, "end0", end0);
906 P1275(0x010, DEFINER, "b(lit)", blit);
907 P1275(0x011, DEFINER, "b(')", btick);
908 P1275(0x012, DEFINER, "b(\")", bquote);
909 P1275(0x013, DEFINER, "bbranch", bbranch);
910 P1275(0x014, DEFINER, "b?branch", bqbranch);
911 P1275(0x015, DEFINER, "b(loop)", bloop);
912 P1275(0x016, DEFINER, "b(+loop)", bplusloop);
913 P1275(0x017, DEFINER, "b(do)", bdo);
914 P1275(0x018, DEFINER, "b(?do)", bqdo);
915 P1275(0x01b, DEFINER, "b(leave)", bleave);
916 P1275(0x01c, DEFINER, "b(of)", bof);
917
918 P1275(0x087, 0, "fcode-revision", fcode_revision);
919
920 P1275(0x08b, 0, "alloc-mem", alloc_mem);
921 P1275(0x08c, 0, "free-mem", free_mem);
922
923 P1275(0x0a4, 0, "-1", minus_one);
924 P1275(0x0a5, 0, "0", zero);
925 P1275(0x0a6, 0, "1", one);
926 P1275(0x0a7, 0, "2", two);
927 P1275(0x0a8, 0, "3", three);
928
929 P1275(0x0ae, 0, "aligned", aligned);
930 P1275(0x0b1, DEFINER, "b(<mark)", bmark);
931 P1275(0x0b2, DEFINER, "b(>resolve)", bresolve);
932 FCODE(0x0b3, 0, "set-token-table", fc_historical);
933 FCODE(0x0b4, 0, "set-table", fc_historical);
934 P1275(0x0b5, 0, "new-token", new_token);
935 P1275(0x0b6, 0, "named-token", named_token);
936 P1275(0x0b7, DEFINER, "b(:)", bcolon);
937 P1275(0x0b8, DEFINER, "b(value)", bvalue);
938 P1275(0x0b9, DEFINER, "b(variable)", bvariable);
939 P1275(0x0ba, DEFINER, "b(constant)", bconstant);
940 P1275(0x0bb, DEFINER, "b(create)", bcreate);
941 P1275(0x0bc, DEFINER, "b(defer)", bdefer);
942 P1275(0x0bd, 0, "b(buffer:)", bbuffer_colon);
943 P1275(0x0be, 0, "b(field)", bfield);
944 FCODE(0x0bf, 0, "b(code)", fc_historical);
945 P1275(0x0c0, IMMEDIATE, "instance", instance);
946
947 P1275(0x0c2, DEFINER, "b(;)", semi);
948 P1275(0x0c3, DEFINER, "b(to)", bto);
949 P1275(0x0c4, DEFINER, "b(case)", bcase);
950 P1275(0x0c5, DEFINER, "b(endcase)", bendcase);
951 P1275(0x0c6, DEFINER, "b(endof)", bendof);
952
953 P1275(0x0ca, 0, "external-token", external_token);
954 P1275(0x0cc, 0, "offset16", offset16);
955 P1275(0x0cd, 0, "evaluate", evaluate);
956
957 P1275(0x0da, 0, "get-token", get_token);
958 P1275(0x0db, 0, "set-token", set_token);
959
960 P1275(0x0f0, 0, "start0", start0);
961 P1275(0x0f1, 0, "start1", start1);
962 P1275(0x0f2, 0, "start2", start2);
963 P1275(0x0f3, 0, "start4", start4);
964
965 P1275(0x0fd, 0, "version1", version1);
966 FCODE(0x0fe, 0, "4-byte-id", fc_historical);
967
968 P1275(0x0ff, 0, "end1", end1);
969
970 /* Call it "old-dma-alloc" so no one gets confused */
971 FCODE(0x101, 0, "old-dma-alloc", fc_historical);
972
973 FCODE(0x104, 0, "memmap", fc_historical);
974 FCODE(0x105, 0, "free-virtual", fc_unimplemented);
975
976 FCODE(0x106, 0, ">physical", fc_historical);
977
978 FCODE(0x10f, 0, "my-params", fc_historical);
979
980 P1275(0x11b, 0, "parse-2int", parse_two_int);
981
982 FCODE(0x122, 0, "memory-test-suite", fc_unimplemented);
983 FCODE(0x123, 0, "group-code", fc_historical);
984 FCODE(0x124, 0, "mask", fc_unimplemented);
985
986 FCODE(0x130, 0, "map-low", fc_unimplemented);
987 FCODE(0x131, 0, "sbus-intr>cpu", fc_unimplemented);
988
989 FCODE(0x170, 0, "fb1-draw-character", fc_historical);
990 FCODE(0x171, 0, "fb1-reset-screen", fc_historical);
991 FCODE(0x172, 0, "fb1-toggle-cursor", fc_historical);
992 FCODE(0x173, 0, "fb1-erase-screen", fc_historical);
993 FCODE(0x174, 0, "fb1-blink-screen", fc_historical);
994 FCODE(0x175, 0, "fb1-invert-screen", fc_historical);
995 FCODE(0x176, 0, "fb1-insert-characters", fc_historical);
996 FCODE(0x177, 0, "fb1-delete-characters", fc_historical);
997 FCODE(0x178, 0, "fb1-insert-lines", fc_historical);
998 FCODE(0x179, 0, "fb1-delete-lines", fc_historical);
999 FCODE(0x17a, 0, "fb1-draw-logo", fc_historical);
1000 FCODE(0x17b, 0, "fb1-install", fc_historical);
1001 FCODE(0x17c, 0, "fb1-slide-up", fc_historical);
1002
1003 FCODE(0x190, 0, "VME-bus Support", fc_obsolete);
1004 FCODE(0x191, 0, "VME-bus Support", fc_obsolete);
1005 FCODE(0x192, 0, "VME-bus Support", fc_obsolete);
1006 FCODE(0x193, 0, "VME-bus Support", fc_obsolete);
1007 FCODE(0x194, 0, "VME-bus Support", fc_obsolete);
1008 FCODE(0x195, 0, "VME-bus Support", fc_obsolete);
1009 FCODE(0x196, 0, "VME-bus Support", fc_obsolete);
1010
1011 FCODE(0x1a0, 0, "return-buffer", fc_historical);
1012 FCODE(0x1a1, 0, "xmit-packet", fc_historical);
1013 FCODE(0x1a2, 0, "poll-packet", fc_historical);
1014
1015 FCODE(0x210, 0, "processor-type", fc_historical);
1016 FCODE(0x211, 0, "firmware-version", fc_historical);
1017 FCODE(0x212, 0, "fcode-version", fc_historical);
1018
1019 FCODE(0x214, 0, "(is-user-word)", is_user_word);
1020 FCODE(0x215, 0, "suspend-fcode", fc_unimplemented);
1021
1022 FCODE(0x229, 0, "adr-mask", fc_historical);
1023
1024 FCODE(0x238, 0, "probe", fc_historical);
1025 FCODE(0x239, 0, "probe-virtual", fc_historical);
1026
1027 P1275(0x23e, 0, "byte-load", byte_load);
1028
1029 P1275(0x240, 0, "left-parse-string", left_parse_string);
1030 FORTH(0, "fcode-buffer", fcode_buffer_addr);
1031 }
Unleashed OS