2N/A/*
2N/A * CDDL HEADER START
2N/A *
2N/A * The contents of this file are subject to the terms of the
2N/A * Common Development and Distribution License (the "License").
2N/A * You may not use this file except in compliance with the License.
2N/A *
2N/A * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
2N/A * or http://www.opensolaris.org/os/licensing.
2N/A * See the License for the specific language governing permissions
2N/A * and limitations under the License.
2N/A *
2N/A * When distributing Covered Code, include this CDDL HEADER in each
2N/A * file and include the License file at usr/src/OPENSOLARIS.LICENSE.
2N/A * If applicable, add the following below this CDDL HEADER, with the
2N/A * fields enclosed by brackets "[]" replaced with your own identifying
2N/A * information: Portions Copyright [yyyy] [name of copyright owner]
2N/A *
2N/A * CDDL HEADER END
2N/A */
2N/A/*
2N/A * Copyright (c) 2000, 2012, Oracle and/or its affiliates. All rights reserved.
2N/A */
2N/A
2N/A#include <stdio.h>
2N/A#include <stdlib.h>
2N/A#include <string.h>
2N/A#include <ctype.h>
2N/A
2N/A#include <fcode/private.h>
2N/A#include <fcode/log.h>
2N/A
2N/Aint fcode_impl_count = 0;
2N/A
2N/Avoid (*crash_ptr)(fcode_env_t *env) = do_crash;
2N/A
2N/Auchar_t
2N/Anext_bytecode(fcode_env_t *env)
2N/A{
2N/A uchar_t byte;
2N/A
2N/A byte = *env->fcode_ptr;
2N/A env->fcode_ptr += env->fcode_incr;
2N/A return (byte);
2N/A}
2N/A
2N/Aushort_t
2N/Aget_next_token(fcode_env_t *env)
2N/A{
2N/A ushort_t token = next_bytecode(env);
2N/A if ((token) && (token < 0x10)) {
2N/A token = (token << 8) | next_bytecode(env);
2N/A }
2N/A env->last_fcode = token;
2N/A return (token);
2N/A}
2N/A
2N/Aushort_t
2N/Aget_short(fcode_env_t *env)
2N/A{
2N/A ushort_t u;
2N/A
2N/A /*
2N/A * Logical or DOES NOT guarantee left to right evaluation...
2N/A */
2N/A u = next_bytecode(env) << 8;
2N/A return (u | next_bytecode(env));
2N/A}
2N/A
2N/Auint_t
2N/Aget_int(fcode_env_t *env)
2N/A{
2N/A uint_t u;
2N/A
2N/A /*
2N/A * Logical or DOES NOT guarantee left to right evaluation...
2N/A */
2N/A u = get_short(env) << 16;
2N/A return (u | get_short(env));
2N/A}
2N/A
2N/Avoid
2N/Aexpose_acf(fcode_env_t *env, char *name)
2N/A{
2N/A if (name == NULL)
2N/A name = "<unknown>";
2N/A EXPOSE_ACF;
2N/A debug_msg(DEBUG_CONTEXT, "CONTEXT:expose_acf: acf: %p/'%s' %p\n",
2N/A LINK_TO_ACF(env->lastlink), name, env->current);
2N/A}
2N/A
2N/Avoid
2N/Ado_code(fcode_env_t *env, int token, char *name, void (*fn)(fcode_env_t *))
2N/A{
2N/A env->table[token].name = name;
2N/A if (fn == NULL) {
2N/A env->table[token].apf = NULL;
2N/A env->table[token].name = name;
2N/A } else {
2N/A header(env, name, strlen(name), 0);
2N/A env->table[token].apf = (acf_t)HERE;
2N/A COMPILE_TOKEN(fn);
2N/A expose_acf(env, name);
2N/A }
2N/A}
2N/A
2N/Avoid
2N/Adefine_word(fcode_env_t *env, int flag, char *name, void (*fn)(fcode_env_t *))
2N/A{
2N/A header(env, name, strlen(name), flag);
2N/A COMPILE_TOKEN(fn);
2N/A expose_acf(env, name);
2N/A}
2N/A
2N/Avoid
2N/Aend0(fcode_env_t *env)
2N/A{
2N/A env->interpretting = 0;
2N/A}
2N/A
2N/Astatic void
2N/Aend1(fcode_env_t *env)
2N/A{
2N/A env->interpretting = 0;
2N/A}
2N/A
2N/Avoid
2N/Ablit(fcode_env_t *env)
2N/A{
2N/A fstack_t d = (int)get_int(env);
2N/A PUSH(DS, d);
2N/A literal(env);
2N/A}
2N/A
2N/Avoid (*bbranch_ptrs[3])(fcode_env_t *env) = {
2N/A do_bbranch,
2N/A do_bqbranch,
2N/A do_bofbranch
2N/A};
2N/A
2N/Avoid
2N/Abranch_common(fcode_env_t *env, short direction, fstack_t which, int doswap)
2N/A{
2N/A fstack_t *sp;
2N/A token_t *branch_loc;
2N/A
2N/A ASSERT((which < 3) && (which >= 0));
2N/A which = (fstack_t)&bbranch_ptrs[which];
2N/A set_temporary_compile(env);
2N/A COMPILE_TOKEN(which);
2N/A if (direction >= 0) {
2N/A bmark(env);
2N/A if (doswap)
2N/A swap(env);
2N/A PUSH(DS, 0);
2N/A compile_comma(env);
2N/A } else {
2N/A
2N/A /*
2N/A * We look down the stack for a branch location
2N/A * that isn't pointing to zero (i.e. a forward branch label).
2N/A * We move the first one we find to the top of the stack,
2N/A * which is what gets compiled in with 'compile_comma'.
2N/A * Not finding a valid branch label is bad.
2N/A */
2N/A for (sp = env->ds; sp >= env->ds0; sp--) {
2N/A branch_loc = (token_t *)*sp;
2N/A if (branch_loc && *branch_loc) {
2N/A break;
2N/A }
2N/A }
2N/A if (sp < env->ds0)
2N/A log_message(MSG_ERROR, "branch_common: back: "
2N/A "no branch loc on stack\n");
2N/A else {
2N/A /* Move branch_loc to top of data stack */
2N/A for (; sp < env->ds; sp++)
2N/A *sp = sp[1];
2N/A *sp = (fstack_t)branch_loc;
2N/A }
2N/A env->level--;
2N/A compile_comma(env);
2N/A temporary_execute(env);
2N/A }
2N/A}
2N/A
2N/Avoid
2N/Abbranch(fcode_env_t *env)
2N/A{
2N/A short offset = (short)get_short(env);
2N/A
2N/A branch_common(env, offset, 0, 1);
2N/A}
2N/A
2N/Avoid
2N/Abqbranch(fcode_env_t *env)
2N/A{
2N/A short offset = (short)get_short(env);
2N/A
2N/A branch_common(env, offset, 1, 0);
2N/A}
2N/A
2N/Avoid
2N/Ado_quote(fcode_env_t *env)
2N/A{
2N/A int len;
2N/A uchar_t *strptr;
2N/A
2N/A strptr = (uchar_t *)IP;
2N/A len = *strptr;
2N/A PUSH(DS, (fstack_t)strptr+1);
2N/A PUSH(DS, len);
2N/A strptr += TOKEN_ROUNDUP(len+2);
2N/A IP = (token_t *)strptr;
2N/A}
2N/A
2N/Avoid
2N/Abquote(fcode_env_t *env)
2N/A{
2N/A char stringbuff[256];
2N/A int len, count;
2N/A char *strptr;
2N/A
2N/A count = len = next_bytecode(env);
2N/A if (env->state) {
2N/A COMPILE_TOKEN(&quote_ptr);
2N/A strptr = (char *)HERE;
2N/A *strptr++ = len;
2N/A while (count--)
2N/A *strptr++ = next_bytecode(env);
2N/A *strptr++ = 0;
2N/A set_here(env, (uchar_t *)strptr, "bquote");
2N/A token_roundup(env, "bquote");
2N/A } else {
2N/A strptr = stringbuff;
2N/A while (count--)
2N/A *strptr++ = next_bytecode(env);
2N/A *strptr = 0;
2N/A push_string(env, stringbuff, len);
2N/A }
2N/A}
2N/A
2N/Achar *
2N/Aget_name(token_t *linkp)
2N/A{
2N/A char *name, *p;
2N/A flag_t *fptr = LINK_TO_FLAGS(linkp);
2N/A int len;
2N/A char *cptr;
2N/A
2N/A if (*fptr & FLAG_NONAME)
2N/A return (NULL);
2N/A
2N/A cptr = (char *)fptr;
2N/A len = cptr[-1];
2N/A if (len <= 0 || len > 64 || cptr[-2] != '\0')
2N/A return (NULL);
2N/A
2N/A name = cptr - (len+2);
2N/A
2N/A for (p = name; *p != '\0'; p++)
2N/A if (!isprint(*p))
2N/A return (NULL);
2N/A
2N/A if ((p - name) != len)
2N/A return (NULL);
2N/A
2N/A return (name);
2N/A}
2N/A
2N/Avoid
2N/Aheader(fcode_env_t *env, char *name, int len, flag_t flag)
2N/A{
2N/A char *strptr;
2N/A flag_t *fptr;
2N/A acf_t dptr;
2N/A extern void add_debug_acf(fcode_env_t *, acf_t);
2N/A
2N/A /* Now form the entry in the dictionary */
2N/A token_roundup(env, "header");
2N/A dptr = (acf_t)HERE;
2N/A if (len) {
2N/A int bytes = len+2+sizeof (flag_t);
2N/A dptr = (acf_t)(TOKEN_ROUNDUP(HERE+bytes));
2N/A fptr = LINK_TO_FLAGS(dptr);
2N/A strptr = (char *)fptr - 1;
2N/A *strptr-- = len;
2N/A *strptr-- = 0;
2N/A while (len)
2N/A *strptr-- = name[--len];
2N/A } else {
2N/A dptr++;
2N/A fptr = LINK_TO_FLAGS(dptr);
2N/A flag |= FLAG_NONAME;
2N/A }
2N/A *fptr = flag;
2N/A *dptr = *((acf_t)env->current);
2N/A env->lastlink = dptr++;
2N/A set_here(env, (uchar_t *)dptr, "header");
2N/A
2N/A if (name_is_debugged(env, name)) {
2N/A log_message(MSG_INFO, "Turning debug on for %s\n", name);
2N/A add_debug_acf(env, LINK_TO_ACF(env->lastlink));
2N/A }
2N/A debug_msg(DEBUG_HEADER, "Define: '%s' @ %p\n", name, HERE);
2N/A}
2N/A
2N/Avoid
2N/Atoken_common(fcode_env_t *env, int headered, int visible)
2N/A{
2N/A char namebuff[32];
2N/A int len, count, token;
2N/A char *strptr, c;
2N/A
2N/A strptr = namebuff;
2N/A if (headered) {
2N/A len = next_bytecode(env);
2N/A for (count = 0; count < len; count++) {
2N/A c = next_bytecode(env);
2N/A if (count < sizeof (namebuff))
2N/A *strptr++ = c;
2N/A }
2N/A }
2N/A
2N/A if (!visible)
2N/A len = 0;
2N/A *strptr = 0;
2N/A token = get_short(env);
2N/A env->last_token = token;
2N/A
2N/A debug_msg(DEBUG_NEW_TOKEN, "Define %s token: '%s' (%x)\n",
2N/A (visible ? "named" : "headerless"), namebuff, token);
2N/A
2N/A header(env, namebuff, len, 0);
2N/A env->table[token].flags = 0;
2N/A if (len) {
2N/A env->table[token].name = MALLOC(len+1);
2N/A strncpy(env->table[token].name, namebuff, len);
2N/A } else {
2N/A env->table[token].name = NULL;
2N/A }
2N/A env->last_token = token;
2N/A}
2N/A
2N/Avoid
2N/Anamed_token(fcode_env_t *env)
2N/A{
2N/A token_common(env, 1, env->fcode_debug);
2N/A}
2N/A
2N/Avoid
2N/Aexternal_token(fcode_env_t *env)
2N/A{
2N/A token_common(env, 1, 1);
2N/A}
2N/A
2N/Avoid
2N/Anew_token(fcode_env_t *env)
2N/A{
2N/A token_common(env, 0, 0);
2N/A}
2N/A
2N/Avoid
2N/Aoffset16(fcode_env_t *env)
2N/A{
2N/A env->offset_incr = 2;
2N/A}
2N/A
2N/Avoid
2N/Aminus_one(fcode_env_t *env)
2N/A{
2N/A PUSH(DS, -1);
2N/A}
2N/A
2N/Avoid
2N/Azero(fcode_env_t *env)
2N/A{
2N/A PUSH(DS, 0);
2N/A}
2N/A
2N/Avoid
2N/Aone(fcode_env_t *env)
2N/A{
2N/A PUSH(DS, 1);
2N/A}
2N/A
2N/Avoid
2N/Atwo(fcode_env_t *env)
2N/A{
2N/A PUSH(DS, 2);
2N/A}
2N/A
2N/Avoid
2N/Athree(fcode_env_t *env)
2N/A{
2N/A PUSH(DS, 3);
2N/A}
2N/A
2N/Avoid
2N/Aversion1(fcode_env_t *env)
2N/A{
2N/A env->fcode_incr = 1;
2N/A}
2N/A
2N/Astatic void
2N/Astart0(fcode_env_t *env)
2N/A{
2N/A env->fcode_incr = 1;
2N/A}
2N/A
2N/Astatic void
2N/Astart1(fcode_env_t *env)
2N/A{
2N/A env->fcode_incr = 1;
2N/A}
2N/A
2N/Avoid
2N/Astart2(fcode_env_t *env)
2N/A{
2N/A env->fcode_incr = 2;
2N/A}
2N/A
2N/Astatic void
2N/Astart4(fcode_env_t *env)
2N/A{
2N/A env->fcode_incr = 4;
2N/A}
2N/A
2N/Aint
2N/Acheck_fcode_header(char *fname, uchar_t *header, int len)
2N/A{
2N/A uint32_t length;
2N/A static char func_name[] = "check_fcode_header";
2N/A
2N/A if (len <= 8) {
2N/A log_message(MSG_ERROR, "%s: '%s' fcode size (%d) <= 8\n",
2N/A func_name, fname, len);
2N/A return (0);
2N/A }
2N/A if (header[0] != 0xf1 && header[0] != 0xfd) {
2N/A log_message(MSG_ERROR, "%s: '%s' header[0] is 0x%02x not"
2N/A " 0xf1/0xfd\n", func_name, fname, header[0]);
2N/A return (0);
2N/A }
2N/A length = (header[4] << 24) | (header[5] << 16) | (header[6] << 8) |
2N/A header[7];
2N/A if (length > len) {
2N/A log_message(MSG_ERROR, "%s: '%s' length (%d) >"
2N/A " fcode size (%d)\n", func_name, fname, length, len);
2N/A return (0);
2N/A }
2N/A if (length < len) {
2N/A log_message(MSG_WARN, "%s: '%s' length (%d) <"
2N/A " fcode size (%d)\n", func_name, fname, length, len);
2N/A }
2N/A return (1);
2N/A}
2N/A
2N/Avoid
2N/Abyte_load(fcode_env_t *env)
2N/A{
2N/A uchar_t *fcode_buffer;
2N/A uchar_t *fcode_ptr;
2N/A int fcode_incr;
2N/A int offset_incr;
2N/A int fcode_xt;
2N/A int interpretting;
2N/A int depth;
2N/A int length;
2N/A int past_eob = 0;
2N/A int db;
2N/A
2N/A /* save any existing interpret state */
2N/A fcode_buffer = env->fcode_buffer;
2N/A fcode_ptr = env->fcode_ptr;
2N/A fcode_incr = env->fcode_incr;
2N/A offset_incr = env->offset_incr;
2N/A interpretting = env->interpretting;
2N/A depth = DEPTH-2;
2N/A
2N/A /* Now init them */
2N/A CHECK_DEPTH(env, 2, "byte-load");
2N/A fcode_xt = POP(DS);
2N/A env->fcode_ptr = env->fcode_buffer = (uchar_t *)POP(DS);
2N/A if (fcode_xt != 1) {
2N/A log_message(MSG_WARN, "byte-load: ignoring xt\n");
2N/A }
2N/A
2N/A length = (env->fcode_buffer[4] << 24) | (env->fcode_buffer[5] << 16) |
2N/A (env->fcode_buffer[6] << 8) | env->fcode_buffer[7];
2N/A if (!check_fcode_header("byte-load", env->fcode_ptr, length))
2N/A log_message(MSG_WARN, "byte-load: header NOT OK\n");
2N/A
2N/A env->fcode_incr = 1;
2N/A env->offset_incr = 1;
2N/A env->interpretting = 1;
2N/A env->level = 0;
2N/A
2N/A db = get_interpreter_debug_level() &
2N/A (DEBUG_BYTELOAD_DS|DEBUG_BYTELOAD_RS|DEBUG_BYTELOAD_TOKENS);
2N/A debug_msg(db, "byte_load: %p, %d\n", env->fcode_buffer, fcode_xt);
2N/A debug_msg(db, " header: %x, %x\n",
2N/A env->fcode_buffer[0], env->fcode_buffer[1]);
2N/A debug_msg(db, " crc: %x\n",
2N/A (env->fcode_buffer[2]<<8)|(env->fcode_buffer[3]));
2N/A debug_msg(db, " length: %x\n", length);
2N/A env->fcode_ptr += 8;
2N/A
2N/A debug_msg(db, "Interpretting: %d\n", env->interpretting);
2N/A
2N/A while (env->interpretting) {
2N/A int token;
2N/A fcode_token *entry;
2N/A acf_t apf;
2N/A
2N/A if (!past_eob && env->fcode_ptr >= env->fcode_buffer + length) {
2N/A log_message(MSG_WARN, "byte-load: past EOB\n");
2N/A past_eob = 1;
2N/A }
2N/A
2N/A env->last_fcode_ptr = env->fcode_ptr;
2N/A token = get_next_token(env);
2N/A
2N/A entry = &env->table[token];
2N/A apf = entry->apf;
2N/A
2N/A DEBUGF(BYTELOAD_DS, output_data_stack(env, MSG_FC_DEBUG));
2N/A DEBUGF(BYTELOAD_RS, output_return_stack(env, 1, MSG_FC_DEBUG));
2N/A DEBUGF(BYTELOAD_TOKENS, log_message(MSG_FC_DEBUG,
2N/A "%s: %04x %03x %s (%x)",
2N/A ((env->state && (entry->flags & IMMEDIATE) == 0)) ?
2N/A "Compile" : "Execute",
2N/A env->last_fcode_ptr - env->fcode_buffer, token,
2N/A entry->name ? entry->name : "???", entry->flags));
2N/A if (db)
2N/A log_message(MSG_FC_DEBUG, "\n");
2N/A if (apf) {
2N/A DEBUGF(TOKEN_USAGE, entry->usage++);
2N/A PUSH(DS, (fstack_t)apf);
2N/A if ((env->state) &&
2N/A ((entry->flags & IMMEDIATE) == 0)) {
2N/A /* Compile in references */
2N/A compile_comma(env);
2N/A } else {
2N/A execute(env);
2N/A }
2N/A }
2N/A }
2N/A if (DEPTH != depth) {
2N/A log_message(MSG_ERROR, "FCODE has net stack change of %d\n",
2N/A DEPTH-depth);
2N/A }
2N/A /* restore old state */
2N/A env->fcode_ptr = fcode_ptr;
2N/A env->fcode_buffer = fcode_buffer;
2N/A env->fcode_incr = fcode_incr;
2N/A env->offset_incr = offset_incr;
2N/A env->interpretting = interpretting;
2N/A}
2N/A
2N/Avoid
2N/Abtick(fcode_env_t *env)
2N/A{
2N/A int token = get_next_token(env);
2N/A
2N/A PUSH(DS, (fstack_t)env->table[token].apf);
2N/A tick_literal(env);
2N/A}
2N/A
2N/Astatic void
2N/Ashow_fcode_def(fcode_env_t *env, char *type)
2N/A{
2N/A int i = env->last_token;
2N/A
2N/A if (get_interpreter_debug_level() & DEBUG_DUMP_TOKENS) {
2N/A if (env->table[i].name)
2N/A log_message(MSG_INFO, "%s: %s %03x %p\n", type,
2N/A env->table[i].name, i, env->table[i].apf);
2N/A else
2N/A log_message(MSG_INFO, "%s: <noname> %03x %p\n", type, i,
2N/A env->table[i].apf);
2N/A }
2N/A}
2N/A
2N/Avoid
2N/Abcolon(fcode_env_t *env)
2N/A{
2N/A if (env->state == 0) {
2N/A env->table[env->last_token].apf = (acf_t)HERE;
2N/A env->table[env->last_token].flags = 0;
2N/A show_fcode_def(env, "bcolon");
2N/A }
2N/A env->state |= 1;
2N/A COMPILE_TOKEN(&do_colon);
2N/A}
2N/A
2N/Avoid
2N/Abcreate(fcode_env_t *env)
2N/A{
2N/A env->table[env->last_token].apf = (acf_t)HERE;
2N/A show_fcode_def(env, "bcreate");
2N/A COMPILE_TOKEN(&do_create);
2N/A expose_acf(env, "<bcreate>");
2N/A}
2N/A
2N/Avoid
2N/Aget_token_name(fcode_env_t *env, int token, char **name, int *len)
2N/A{
2N/A *name = env->table[token].name;
2N/A if (*name) {
2N/A *len = strlen(*name);
2N/A } else
2N/A *len = 0;
2N/A}
2N/A
2N/Avoid
2N/Abvalue(fcode_env_t *env)
2N/A{
2N/A env->table[env->last_token].apf = (acf_t)HERE;
2N/A show_fcode_def(env, "bvalue");
2N/A make_common_access(env, 0, 0, 1,
2N/A env->instance_mode, &noop, &noop, &set_value_actions);
2N/A}
2N/A
2N/Avoid
2N/Abvariable(fcode_env_t *env)
2N/A{
2N/A env->table[env->last_token].apf = (acf_t)HERE;
2N/A show_fcode_def(env, "bvariable");
2N/A PUSH(DS, 0);
2N/A make_common_access(env, 0, 0, 1,
2N/A env->instance_mode, &instance_variable, &do_create, NULL);
2N/A}
2N/A
2N/Avoid
2N/Abconstant(fcode_env_t *env)
2N/A{
2N/A env->table[env->last_token].apf = (acf_t)HERE;
2N/A show_fcode_def(env, "bconstant");
2N/A make_common_access(env, 0, 0, 1,
2N/A env->instance_mode, &do_constant, &do_constant, NULL);
2N/A}
2N/A
2N/Avoid
2N/Abdefer(fcode_env_t *env)
2N/A{
2N/A env->table[env->last_token].apf = (acf_t)HERE;
2N/A show_fcode_def(env, "bdefer");
2N/A
2N/A PUSH(DS, (fstack_t)&crash_ptr);
2N/A make_common_access(env, 0, 0, 1, env->instance_mode,
2N/A &noop, &noop, &set_defer_actions);
2N/A}
2N/A
2N/Avoid
2N/Abbuffer_colon(fcode_env_t *env)
2N/A{
2N/A env->table[env->last_token].apf = (acf_t)HERE;
2N/A show_fcode_def(env, "buffer:");
2N/A PUSH(DS, 0);
2N/A make_common_access(env, 0, 0, 2, env->instance_mode,
2N/A &noop, &noop, &set_buffer_actions);
2N/A}
2N/A
2N/Avoid
2N/Ado_field(fcode_env_t *env)
2N/A{
2N/A fstack_t *d;
2N/A
2N/A d = (fstack_t *)WA;
2N/A TOS += *d;
2N/A}
2N/A
2N/Avoid
2N/Abfield(fcode_env_t *env)
2N/A{
2N/A env->table[env->last_token].apf = (acf_t)HERE;
2N/A show_fcode_def(env, "bfield");
2N/A COMPILE_TOKEN(&do_field);
2N/A over(env);
2N/A compile_comma(env);
2N/A add(env);
2N/A expose_acf(env, "<bfield>");
2N/A}
2N/A
2N/Avoid
2N/Abto(fcode_env_t *env)
2N/A{
2N/A btick(env);
2N/A
2N/A if (env->state) {
2N/A COMPILE_TOKEN(&to_ptr);
2N/A } else {
2N/A do_set_action(env);
2N/A }
2N/A}
2N/A
2N/Avoid
2N/Aget_token(fcode_env_t *env)
2N/A{
2N/A fstack_t tok;
2N/A fstack_t immediate = 0;
2N/A
2N/A CHECK_DEPTH(env, 1, "get-token");
2N/A tok = POP(DS);
2N/A tok &= MAX_FCODE;
2N/A PUSH(DS, (fstack_t)env->table[tok].apf);
2N/A if (env->table[tok].flags & IMMEDIATE) immediate = 1;
2N/A PUSH(DS, immediate);
2N/A}
2N/A
2N/Avoid
2N/Aset_token(fcode_env_t *env)
2N/A{
2N/A fstack_t tok;
2N/A fstack_t immediate;
2N/A acf_t acf;
2N/A
2N/A CHECK_DEPTH(env, 3, "set-token");
2N/A tok = POP(DS);
2N/A tok &= MAX_FCODE;
2N/A immediate = POP(DS);
2N/A acf = (acf_t)POP(DS);
2N/A if (immediate)
2N/A env->table[tok].flags |= IMMEDIATE;
2N/A else
2N/A env->table[tok].flags &= ~IMMEDIATE;
2N/A env->table[tok].apf = acf;
2N/A immediate = env->last_token;
2N/A env->last_token = tok;
2N/A show_fcode_def(env, "set_token");
2N/A env->last_token = immediate;
2N/A}
2N/A
2N/Avoid
2N/Abof(fcode_env_t *env)
2N/A{
2N/A short offset = get_short(env);
2N/A branch_common(env, offset, 2, 0);
2N/A}
2N/A
2N/Avoid
2N/Abcase(fcode_env_t *env)
2N/A{
2N/A env->level++;
2N/A set_temporary_compile(env);
2N/A PUSH(DS, 0);
2N/A}
2N/A
2N/Avoid
2N/Abendcase(fcode_env_t *env)
2N/A{
2N/A COMPILE_TOKEN(env->table[0x46].apf); /* Hack for now... */
2N/A while (TOS) {
2N/A bresolve(env);
2N/A }
2N/A (void) POP(DS);
2N/A env->level--;
2N/A temporary_execute(env);
2N/A}
2N/A
2N/Avoid
2N/Abendof(fcode_env_t *env)
2N/A{
2N/A short offset = get_short(env);
2N/A branch_common(env, offset, 0, 1);
2N/A bresolve(env);
2N/A}
2N/A
2N/Avoid
2N/Afcode_revision(fcode_env_t *env)
2N/A{
2N/A /* We are Version 3.0 */
2N/A PUSH(DS, 0x30000);
2N/A}
2N/A
2N/Avoid
2N/Aalloc_mem(fcode_env_t *env)
2N/A{
2N/A CHECK_DEPTH(env, 1, "alloc-mem");
2N/A TOS = (fstack_t)MALLOC((size_t)TOS);
2N/A if (!TOS) {
2N/A throw_from_fclib(env, 1, "alloc-mem failed");
2N/A }
2N/A}
2N/A
2N/Avoid
2N/Afree_mem(fcode_env_t *env)
2N/A{
2N/A void *p;
2N/A
2N/A CHECK_DEPTH(env, 2, "free-mem");
2N/A (void) POP(DS);
2N/A p = (void *) POP(DS);
2N/A FREE(p);
2N/A}
2N/A
2N/Avoid
2N/Aparse_two_int(fcode_env_t *env)
2N/A{
2N/A uint_t lo, hi;
2N/A char *str;
2N/A int len;
2N/A
2N/A CHECK_DEPTH(env, 2, "parse-2int");
2N/A lo = 0;
2N/A hi = 0;
2N/A str = pop_a_string(env, &len);
2N/A if (len) {
2N/A if (sscanf(str, "%x,%x", &hi, &lo) != 2) {
2N/A throw_from_fclib(env, 1, "parse_2int");
2N/A }
2N/A }
2N/A PUSH(DS, lo);
2N/A PUSH(DS, hi);
2N/A}
2N/A
2N/Avoid
2N/Aleft_parse_string(fcode_env_t *env)
2N/A{
2N/A char sep, *cptr, *lstr, *rstr;
2N/A int len, llen, rlen;
2N/A
2N/A CHECK_DEPTH(env, 3, "left-parse-string");
2N/A sep = (char)POP(DS);
2N/A if (TOS == 0) {
2N/A two_dup(env);
2N/A return;
2N/A }
2N/A lstr = pop_a_string(env, &llen);
2N/A len = 0;
2N/A cptr = NULL;
2N/A while (len < llen) {
2N/A if (lstr[len] == sep) {
2N/A cptr = lstr+len;
2N/A break;
2N/A }
2N/A len++;
2N/A }
2N/A if (cptr != NULL) {
2N/A rstr = cptr+1;
2N/A rlen = lstr + llen - rstr;
2N/A llen = len;
2N/A } else {
2N/A rlen = 0;
2N/A rstr = lstr;
2N/A }
2N/A PUSH(DS, (fstack_t)rstr);
2N/A PUSH(DS, rlen);
2N/A PUSH(DS, (fstack_t)lstr);
2N/A PUSH(DS, llen);
2N/A}
2N/A
2N/A/*
2N/A * (is-user-word) ( name-str name-len xt -- )
2N/A */
2N/Avoid
2N/Ais_user_word(fcode_env_t *env)
2N/A{
2N/A fstack_t xt;
2N/A char *name;
2N/A int len;
2N/A
2N/A CHECK_DEPTH(env, 3, "(is-user-word)");
2N/A xt = POP(DS);
2N/A name = pop_a_string(env, &len);
2N/A header(env, name, len, 0);
2N/A COMPILE_TOKEN(&do_alias);
2N/A COMPILE_TOKEN(xt);
2N/A expose_acf(env, name);
2N/A}
2N/A
2N/A
2N/A
2N/Avoid
2N/Af_error(fcode_env_t *env)
2N/A{
2N/A#if 0
2N/A env->interpretting = 0;
2N/A log_message(MSG_ERROR, "Uniplemented FCODE token encountered %x\n",
2N/A env->last_fcode);
2N/A#else
2N/A forth_abort(env, "Unimplemented FCODE token: 0x%x\n", env->last_fcode);
2N/A#endif
2N/A}
2N/A
2N/Astatic void
2N/Afcode_buffer_addr(fcode_env_t *env)
2N/A{
2N/A PUSH(DS, (fstack_t)(env->fcode_buffer));
2N/A}
2N/A
2N/Avoid
2N/Amd_find_node(fcode_env_t *env)
2N/A{
2N/A fstack_t md_node_handle, name_len;
2N/A char *name_str;
2N/A
2N/A CHECK_DEPTH(env, 3, "md-find-node");
2N/A name_len = POP(DS);
2N/A name_str = (char *)POP(DS);
2N/A md_node_handle = POP(DS);
2N/A debug_msg(DEBUG_EXEC_TRACE, "md_find_node: node_hdl %p name %s "
2N/A "len %d\n", md_node_handle, name_str, name_len);
2N/A
2N/A PUSH(DS, 0);
2N/A}
2N/A
2N/Avoid
2N/Amd_node_name(fcode_env_t *env)
2N/A{
2N/A fstack_t md_node_handle;
2N/A
2N/A CHECK_DEPTH(env, 1, "md-node-name");
2N/A md_node_handle = POP(DS);
2N/A debug_msg(DEBUG_EXEC_TRACE, "md_node_name: node_hdl %p\n",
2N/A md_node_handle);
2N/A
2N/A PUSH(DS, 0);
2N/A PUSH(DS, NULL);
2N/A}
2N/A
2N/Avoid
2N/Amd_next_node(fcode_env_t *env)
2N/A{
2N/A fstack_t md_node_handle;
2N/A
2N/A CHECK_DEPTH(env, 1, "md-next-node");
2N/A md_node_handle = POP(DS);
2N/A debug_msg(DEBUG_EXEC_TRACE, "md_next_node: node_hdl %p\n",
2N/A md_node_handle);
2N/A
2N/A PUSH(DS, 0);
2N/A}
2N/A
2N/Avoid
2N/Amd_find_prop(fcode_env_t *env)
2N/A{
2N/A fstack_t md_node_handle, md_prop_type;
2N/A char *name_str;
2N/A int name_len;
2N/A
2N/A CHECK_DEPTH(env, 4, "md-find-prop");
2N/A md_prop_type = POP(DS);
2N/A name_len = POP(DS);
2N/A name_str = (char *)POP(DS);
2N/A md_node_handle = POP(DS);
2N/A debug_msg(DEBUG_EXEC_TRACE, "md_find_prop: node_hdl %p name %s "
2N/A "len %d prop_type %x\n", md_node_handle, name_str,
2N/A name_len, md_prop_type);
2N/A
2N/A PUSH(DS, 0);
2N/A}
2N/A
2N/Avoid
2N/Amd_prop_name(fcode_env_t *env)
2N/A{
2N/A fstack_t md_prop_handle;
2N/A
2N/A CHECK_DEPTH(env, 1, "md-prop-name");
2N/A md_prop_handle = POP(DS);
2N/A debug_msg(DEBUG_EXEC_TRACE, "md_prop_name: prop_hdl %p\n",
2N/A md_prop_handle);
2N/A
2N/A PUSH(DS, 0);
2N/A PUSH(DS, NULL);
2N/A}
2N/A
2N/A/* md-next-prop ( md-node-handle md-prop-handle -- md-prop-handle' | 0 ) */
2N/Avoid
2N/Amd_next_prop(fcode_env_t *env)
2N/A{
2N/A fstack_t md_node_handle, md_prop_handle;
2N/A
2N/A CHECK_DEPTH(env, 2, "md-next-prop");
2N/A md_prop_handle = POP(DS);
2N/A md_node_handle = POP(DS);
2N/A debug_msg(DEBUG_REG_ACCESS, "md_next_prop: prop %p node %p\n",
2N/A md_prop_handle, md_node_handle);
2N/A
2N/A PUSH(DS, 0);
2N/A}
2N/A
2N/Avoid
2N/Amd_prop_type(fcode_env_t *env)
2N/A{
2N/A fstack_t md_prop_handle;
2N/A
2N/A CHECK_DEPTH(env, 1, "md-prop-type");
2N/A md_prop_handle = POP(DS);
2N/A debug_msg(DEBUG_EXEC_TRACE, "md_prop_type: prop_hdl %p\n",
2N/A md_prop_handle);
2N/A
2N/A PUSH(DS, 0);
2N/A}
2N/A
2N/Avoid
2N/Amd_decode_prop(fcode_env_t *env)
2N/A{
2N/A fstack_t md_prop_handle;
2N/A
2N/A CHECK_DEPTH(env, 1, "md-decode-prop");
2N/A md_prop_handle = POP(DS);
2N/A debug_msg(DEBUG_EXEC_TRACE, "md_decode_prop: prop_hdl %p\n",
2N/A md_prop_handle);
2N/A
2N/A PUSH(DS, 0);
2N/A}
2N/A
2N/Avoid
2N/Amd_find_my_node(fcode_env_t *env)
2N/A{
2N/A debug_msg(DEBUG_EXEC_TRACE, "md-find-my-node\n");
2N/A PUSH(DS, 0);
2N/A}
2N/A
2N/A#pragma init(_init)
2N/A
2N/Astatic void
2N/A_init(void)
2N/A{
2N/A fcode_env_t *env = initial_env;
2N/A
2N/A ASSERT(env);
2N/A NOTICE;
2N/A
2N/A P1275(0x000, DEFINER, "end0", end0);
2N/A P1275(0x010, DEFINER, "b(lit)", blit);
2N/A P1275(0x011, DEFINER, "b(')", btick);
2N/A P1275(0x012, DEFINER, "b(\")", bquote);
2N/A P1275(0x013, DEFINER, "bbranch", bbranch);
2N/A P1275(0x014, DEFINER, "b?branch", bqbranch);
2N/A P1275(0x015, DEFINER, "b(loop)", bloop);
2N/A P1275(0x016, DEFINER, "b(+loop)", bplusloop);
2N/A P1275(0x017, DEFINER, "b(do)", bdo);
2N/A P1275(0x018, DEFINER, "b(?do)", bqdo);
2N/A P1275(0x01b, DEFINER, "b(leave)", bleave);
2N/A P1275(0x01c, DEFINER, "b(of)", bof);
2N/A
2N/A P1275(0x087, 0, "fcode-revision", fcode_revision);
2N/A
2N/A P1275(0x08b, 0, "alloc-mem", alloc_mem);
2N/A P1275(0x08c, 0, "free-mem", free_mem);
2N/A
2N/A P1275(0x0a4, 0, "-1", minus_one);
2N/A P1275(0x0a5, 0, "0", zero);
2N/A P1275(0x0a6, 0, "1", one);
2N/A P1275(0x0a7, 0, "2", two);
2N/A P1275(0x0a8, 0, "3", three);
2N/A
2N/A P1275(0x0ae, 0, "aligned", aligned);
2N/A P1275(0x0b1, DEFINER, "b(<mark)", bmark);
2N/A P1275(0x0b2, DEFINER, "b(>resolve)", bresolve);
2N/A FCODE(0x0b3, 0, "set-token-table", fc_historical);
2N/A FCODE(0x0b4, 0, "set-table", fc_historical);
2N/A P1275(0x0b5, 0, "new-token", new_token);
2N/A P1275(0x0b6, 0, "named-token", named_token);
2N/A P1275(0x0b7, DEFINER, "b(:)", bcolon);
2N/A P1275(0x0b8, DEFINER, "b(value)", bvalue);
2N/A P1275(0x0b9, DEFINER, "b(variable)", bvariable);
2N/A P1275(0x0ba, DEFINER, "b(constant)", bconstant);
2N/A P1275(0x0bb, DEFINER, "b(create)", bcreate);
2N/A P1275(0x0bc, DEFINER, "b(defer)", bdefer);
2N/A P1275(0x0bd, 0, "b(buffer:)", bbuffer_colon);
2N/A P1275(0x0be, 0, "b(field)", bfield);
2N/A FCODE(0x0bf, 0, "b(code)", fc_historical);
2N/A P1275(0x0c0, IMMEDIATE, "instance", instance);
2N/A
2N/A P1275(0x0c2, DEFINER, "b(;)", semi);
2N/A P1275(0x0c3, DEFINER, "b(to)", bto);
2N/A P1275(0x0c4, DEFINER, "b(case)", bcase);
2N/A P1275(0x0c5, DEFINER, "b(endcase)", bendcase);
2N/A P1275(0x0c6, DEFINER, "b(endof)", bendof);
2N/A
2N/A P1275(0x0ca, 0, "external-token", external_token);
2N/A P1275(0x0cc, 0, "offset16", offset16);
2N/A P1275(0x0cd, 0, "evaluate", evaluate);
2N/A
2N/A P1275(0x0da, 0, "get-token", get_token);
2N/A P1275(0x0db, 0, "set-token", set_token);
2N/A
2N/A P1275(0x0f0, 0, "start0", start0);
2N/A P1275(0x0f1, 0, "start1", start1);
2N/A P1275(0x0f2, 0, "start2", start2);
2N/A P1275(0x0f3, 0, "start4", start4);
2N/A
2N/A P1275(0x0fd, 0, "version1", version1);
2N/A FCODE(0x0fe, 0, "4-byte-id", fc_historical);
2N/A
2N/A P1275(0x0ff, 0, "end1", end1);
2N/A
2N/A /* Call it "old-dma-alloc" so no one gets confused */
2N/A FCODE(0x101, 0, "old-dma-alloc", fc_historical);
2N/A
2N/A FCODE(0x104, 0, "memmap", fc_historical);
2N/A FCODE(0x105, 0, "free-virtual", fc_unimplemented);
2N/A
2N/A FCODE(0x106, 0, ">physical", fc_historical);
2N/A
2N/A FCODE(0x10f, 0, "my-params", fc_historical);
2N/A
2N/A P1275(0x11b, 0, "parse-2int", parse_two_int);
2N/A
2N/A FCODE(0x122, 0, "memory-test-suite", fc_unimplemented);
2N/A FCODE(0x123, 0, "group-code", fc_historical);
2N/A FCODE(0x124, 0, "mask", fc_unimplemented);
2N/A
2N/A FCODE(0x130, 0, "map-low", fc_unimplemented);
2N/A FCODE(0x131, 0, "sbus-intr>cpu", fc_unimplemented);
2N/A
2N/A FCODE(0x170, 0, "fb1-draw-character", fc_historical);
2N/A FCODE(0x171, 0, "fb1-reset-screen", fc_historical);
2N/A FCODE(0x172, 0, "fb1-toggle-cursor", fc_historical);
2N/A FCODE(0x173, 0, "fb1-erase-screen", fc_historical);
2N/A FCODE(0x174, 0, "fb1-blink-screen", fc_historical);
2N/A FCODE(0x175, 0, "fb1-invert-screen", fc_historical);
2N/A FCODE(0x176, 0, "fb1-insert-characters", fc_historical);
2N/A FCODE(0x177, 0, "fb1-delete-characters", fc_historical);
2N/A FCODE(0x178, 0, "fb1-insert-lines", fc_historical);
2N/A FCODE(0x179, 0, "fb1-delete-lines", fc_historical);
2N/A FCODE(0x17a, 0, "fb1-draw-logo", fc_historical);
2N/A FCODE(0x17b, 0, "fb1-install", fc_historical);
2N/A FCODE(0x17c, 0, "fb1-slide-up", fc_historical);
2N/A
2N/A FCODE(0x190, 0, "VME-bus Support", fc_obsolete);
2N/A FCODE(0x191, 0, "VME-bus Support", fc_obsolete);
2N/A FCODE(0x192, 0, "VME-bus Support", fc_obsolete);
2N/A FCODE(0x193, 0, "VME-bus Support", fc_obsolete);
2N/A FCODE(0x194, 0, "VME-bus Support", fc_obsolete);
2N/A FCODE(0x195, 0, "VME-bus Support", fc_obsolete);
2N/A FCODE(0x196, 0, "VME-bus Support", fc_obsolete);
2N/A
2N/A FCODE(0x1a0, 0, "return-buffer", fc_historical);
2N/A FCODE(0x1a1, 0, "xmit-packet", fc_historical);
2N/A FCODE(0x1a2, 0, "poll-packet", fc_historical);
2N/A
2N/A FCODE(0x210, 0, "processor-type", fc_historical);
2N/A FCODE(0x211, 0, "firmware-version", fc_historical);
2N/A FCODE(0x212, 0, "fcode-version", fc_historical);
2N/A
2N/A FCODE(0x214, 0, "(is-user-word)", is_user_word);
2N/A FCODE(0x215, 0, "suspend-fcode", fc_unimplemented);
2N/A
2N/A FCODE(0x229, 0, "adr-mask", fc_historical);
2N/A
2N/A FCODE(0x238, 0, "probe", fc_historical);
2N/A FCODE(0x239, 0, "probe-virtual", fc_historical);
2N/A
2N/A P1275(0x23e, 0, "byte-load", byte_load);
2N/A
2N/A P1275(0x240, 0, "left-parse-string", left_parse_string);
2N/A FORTH(0, "fcode-buffer", fcode_buffer_addr);
2N/A FCODE(0x639, 0, "md-find-node", md_find_node);
2N/A FCODE(0x63a, 0, "md-node-name", md_node_name);
2N/A FCODE(0x63b, 0, "md-next-node", md_next_node);
2N/A FCODE(0x63c, 0, "md-find-prop", md_find_prop);
2N/A FCODE(0x63d, 0, "md-prop-name", md_prop_name);
2N/A FCODE(0x63e, 0, "md-next-prop", md_next_prop);
2N/A FCODE(0x63f, 0, "md-prop-type", md_prop_type);
2N/A FCODE(0x640, 0, "md-decode-prop", md_decode_prop);
2N/A FCODE(0x651, 0, "md-find-my-node", md_find_my_node);
2N/A
2N/A}