OpenSolaris_b135/lib/efcode/engine/actions.c

/*
 * CDDL HEADER START
 *
 * The contents of this file are subject to the terms of the
 * Common Development and Distribution License, Version 1.0 only
 * (the "License").  You may not use this file except in compliance
 * with the License.
 *
 * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
 * or http://www.opensolaris.org/os/licensing.
 * See the License for the specific language governing permissions
 * and limitations under the License.
 *
 * When distributing Covered Code, include this CDDL HEADER in each
 * file and include the License file at usr/src/OPENSOLARIS.LICENSE.
 * If applicable, add the following below this CDDL HEADER, with the
 * fields enclosed by brackets "[]" replaced with your own identifying
 * information: Portions Copyright [yyyy] [name of copyright owner]
 *
 * CDDL HEADER END
 */
/*
 * Copyright (c) 2000 by Sun Microsystems, Inc.
 * All rights reserved.
 */

#pragma ident	"%Z%%M%	%I%	%E% SMI"

#include <stdio.h>
#include <string.h>

#include <fcode/private.h>
#include <fcode/log.h>

#define	NUM_DEFAULT_ACTIONS	7

/*
 * value_fetch and value_store are the same as "fetch" and "store", but
 * we'll leave them implemented here for now.
 */
static void
value_fetch(fcode_env_t *env)
{
	variable_t *addr;

	CHECK_DEPTH(env, 1, "value_fetch");
	addr = (variable_t *)POP(DS);
	PUSH(DS, (variable_t)*addr);
}

static void
value_store(fcode_env_t *env)
{
	variable_t *addr;

	CHECK_DEPTH(env, 1, "value_store");
	addr = (variable_t *)POP(DS);
	*addr = (variable_t)POP(DS);
}

void *
get_internal_address(fcode_env_t *env)
{
	int *ptr;

	CHECK_DEPTH(env, 1, "get_internal_address");
	ptr = (int *)POP(DS);
	if (*ptr > 0)
		return ((uchar_t *)env + *ptr);
	return ((uchar_t *)MYSELF - *ptr);
}

void
internal_env_fetch(fcode_env_t *env)
{
	instance_t **iptr;

	CHECK_DEPTH(env, 1, "internal_env_fetch");
	iptr = (instance_t **)get_internal_address(env);
	PUSH(DS, (fstack_t)(*iptr));
}

void
internal_env_store(fcode_env_t *env)
{
	instance_t **iptr;

	CHECK_DEPTH(env, 2, "internal_env_store");
	iptr = (instance_t **)get_internal_address(env);
	*iptr = (instance_t *)POP(DS);
}

void
internal_env_addr(fcode_env_t *env)
{
	fstack_t d;

	CHECK_DEPTH(env, 1, "internal_env_addr");
	d = (fstack_t)get_internal_address(env);
	PUSH(DS, d);
}

void
do_buffer_data(fcode_env_t *env, token_t *d, int instance)
{
	if (!*d) {	/* check if buffer not alloc'ed yet */
		token_t *buf;

		if (instance) {
			int n, off;

			n = TOKEN_ROUNDUP(d[1]);
			buf = alloc_instance_data(env, UINIT_DATA, n, &off);
			memset(buf, 0, d[1]);
		} else {
			buf = (token_t *)HERE;
			set_here(env, HERE + d[1], "do_buffer_data");
		}
		*d = (token_t)buf;
	}
	PUSH(DS, *d);
}

void
ibuffer_init(fcode_env_t *env)
{
	token_t *d;

	d = get_instance_address(env);
	do_buffer_data(env, d, 1);
}

void
buffer_init(fcode_env_t *env)
{
	token_t *d;

	CHECK_DEPTH(env, 1, "buffer_init");
	d = (token_t *)POP(DS);
	do_buffer_data(env, d, 0);
}

void
do_defer(fcode_env_t *env)
{
	fetch(env);
	execute(env);
}

token_t *value_actions[NUM_DEFAULT_ACTIONS];
token_t value_defines[NUM_DEFAULT_ACTIONS][3] = {
	{ (token_t)&value_fetch, (token_t)&value_store, (token_t)&noop },
	{ (token_t)&fetch_instance_data, (token_t)&set_instance_data,
	    (token_t)&address_instance_data },
	{ (token_t)&internal_env_fetch, (token_t)&internal_env_store,
	    (token_t)&internal_env_addr },
	{ (token_t)&do_defer, (token_t)&store, (token_t)&noop },
	{ (token_t)&idefer_exec, (token_t)&set_instance_data,
	    (token_t)&address_instance_data },
	{ (token_t)&buffer_init, (token_t)&two_drop, (token_t)&noop, },
	{ (token_t)&ibuffer_init, (token_t)&two_drop,
	    (token_t)&address_instance_data }
};

int
run_action(fcode_env_t *env, acf_t acf, int action)
{
	token_t *p = (token_t *)acf;

	if ((p[0] & 1) == 0) {
		log_message(MSG_WARN, "run_action: acf: %p @acf: %p not"
		    " indirect\n", acf, p[0]);
		return (1);
	}

	p = (token_t *)(p[0] & ~1);

	if (action >= p[1] || action < 0) {
		log_message(MSG_WARN, "run_action: acf: %p action: %d"
		    " out of range: 0-%d\n", acf, action, (int)p[1]);
		return (1);
	}

	if (p[0] == (token_t)&do_default_action) {
		fstack_t d;

		d = (fstack_t)p[action+2];
		PUSH(DS, d);
		execute(env);
		return (0);
	}
	log_message(MSG_WARN, "run_action: acf: %p/%p not default action\n",
	    acf, p[0]);
	return (1);
}

void
do_default_action(fcode_env_t *env)
{
	acf_t a;

	CHECK_DEPTH(env, 1, "do_default_action");
	a = (acf_t)TOS;
	(void) run_action(env, (a-1), 0);
}

void
do_set_action(fcode_env_t *env)
{
	acf_t  a = (acf_t)TOS;

	CHECK_DEPTH(env, 1, "do_set_action");
	TOS += sizeof (acf_t);
	(void) run_action(env, a, 1);
}

void
action_colon(fcode_env_t *env)
{
	token_roundup(env, "action_colon");
	env->action_ptr[env->action_count] = (token_t)HERE;
	COMPILE_TOKEN(&do_colon);
	env->action_count++;
	env->state |= 1;
}

void
actions(fcode_env_t *env)
{
	int n;
	token_t *d;

	token_roundup(env, "actions");
	d = (token_t *)HERE;
	*d++ = (token_t)&do_default_action;
	n = (int)POP(DS);
	*d++ = n;
	env->num_actions = n;
	env->action_count = 0;
	env->action_ptr = d;
	d += n;
	set_here(env, (uchar_t *)d, "actions");
}

void
install_actions(fcode_env_t *env, token_t *table)
{
	acf_t *dptr;
	token_t p;

	dptr  = (acf_t *)LINK_TO_ACF(env->lastlink);
	p = (token_t)table;
	p -= (sizeof (token_t) + sizeof (acf_t));
	*dptr = (acf_t)(p | 1);
}

void
use_actions(fcode_env_t *env)
{
	if (env->state) {
		TODO;	/* use-actions in compile state. */
	} else {
		install_actions(env, env->action_ptr);
	}
}

void
perform_action(fcode_env_t *env)
{
	int n;
	acf_t a;

	CHECK_DEPTH(env, 2, "perform_action");
	n = POP(DS);
	a = (acf_t)POP(DS);
	PUSH(DS, (fstack_t)ACF_TO_BODY(a));

	if (run_action(env, a, n)) {
		system_message(env, "Bad Object action");
	}
}

void
define_actions(fcode_env_t *env, int n, token_t *array)
{
	int a;

	PUSH(DS, (fstack_t)n);
	actions(env);

	a = 0;
	while (n--) {
		action_colon(env);
		COMPILE_TOKEN(&array[a]);
		env->state |= 8;
		semi(env);
		a++;
	}
}

/*
 * This is for things like my-self which have meaning to the
 * forth engine but I don't want to turn them into standard forth values
 * that would make the 'C' variables hard to understand, instead these
 * 'global' state variables will act directly upon the native 'C' structures.
 */

void
set_internal_value_actions(fcode_env_t *env)
{
	ASSERT(value_actions[2]);
	install_actions(env, value_actions[2]);
}

void
set_value_actions(fcode_env_t *env, int which)
{
	ASSERT((which == 0) || (which == 1));
	ASSERT(value_actions[which]);
	install_actions(env, value_actions[which]);
}

void
set_defer_actions(fcode_env_t *env, int which)
{
	ASSERT((which == 0) || (which == 1));
	ASSERT(value_actions[which+3]);
	install_actions(env, value_actions[which+3]);
}

void
set_buffer_actions(fcode_env_t *env, int which)
{
	ASSERT((which == 0) || (which == 1));
	ASSERT(value_actions[which+5]);
	install_actions(env, value_actions[which+5]);
}

#if defined(DEBUG)

void
do_get(fcode_env_t *env)
{
	PUSH(DS, 0);
	perform_action(env);
}

void
do_set(fcode_env_t *env)
{
	PUSH(DS, 1);
	perform_action(env);
}

void
do_addr(fcode_env_t *env)
{
	PUSH(DS, 2);
	perform_action(env);
}

void
dump_actions(fcode_env_t *env)
{
	int i;
	for (i = 0; i < NUM_DEFAULT_ACTIONS; i++) {
		log_message(MSG_INFO, "Action Set: %d = %p\n", i,
		    value_actions[i]);
	}
}
#endif	/* DEBUG */

#pragma init(_init)

static void
_init(void)
{
	fcode_env_t *env = initial_env;
	int i;

	ASSERT(env);
	NOTICE;

	for (i = 0; i < NUM_DEFAULT_ACTIONS; i++) {
		define_actions(env, 3, value_defines[i]);
		value_actions[i] = env->action_ptr;
	}

#if defined(DEBUG)
	FORTH(0,		"get",			do_get);
	FORTH(0,		"set",			do_set);
	FORTH(0,		"addr",			do_addr);
	FORTH(0,		"dump-actions",		dump_actions);
	FORTH(IMMEDIATE,	"actions",		actions);
	FORTH(IMMEDIATE,	"use-actions",		use_actions);
	FORTH(IMMEDIATE,	"action:",		action_colon);
	FORTH(0,		"perform-action",	perform_action);
#endif /* DEBUG */
}