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("e_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 } 1032