void
expose_acf(fcode_env_t *env, char *name)
{
if (name == NULL)
name = "<unknown>";
EXPOSE_ACF;
debug_msg(DEBUG_CONTEXT, "CONTEXT:expose_acf: acf: %p/'%s' %p\n",
LINK_TO_ACF(env->lastlink), name, env->current);
}
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);
}
static void
_init(void)
{
int i;
acf_t f_error_addr;
fcode_env_t *env;
NOTICE;
fcode_impl_count = 0;
env = MALLOC(sizeof (fcode_env_t));
env->table = MALLOC((MAX_FCODE + 1) * sizeof (fcode_token));
env->base = MALLOC(dict_size);
env->here = env->base;
env->ds = env->ds0 = MALLOC(stack_size * sizeof (fstack_t));
env->rs = env->rs0 = MALLOC(stack_size * sizeof (fstack_t));
env->order = MALLOC(MAX_ORDER * sizeof (token_t));
env->input = MALLOC(sizeof (input_typ));
env->num_base = 0x10;
/* Setup the initial forth environment */
do_forth(env);
do_definitions(env);
install_handlers(env);
initial_env = env;
/*
* Need to define this early because it is the default for
* all unimpl, FCODE functions
*/
P1275(0x0fc, IMMEDIATE, "ferror", f_error);
f_error_addr = LINK_TO_ACF(env->lastlink);
for (i = 0; i <= MAX_FCODE; i++) {
DEBUGF(ANY, env->table[i].usage = 0);
SET_TOKEN(i, IMMEDIATE, "ferror", f_error_addr);
}
fcode_impl_count = 0;
}
void
header(fcode_env_t *env, char *name, int len, flag_t flag)
{
char *strptr;
flag_t *fptr;
acf_t dptr;
extern void add_debug_acf(fcode_env_t *, acf_t);
/* Now form the entry in the dictionary */
token_roundup(env, "header");
dptr = (acf_t)HERE;
if (len) {
int bytes = len+2+sizeof (flag_t);
dptr = (acf_t)(TOKEN_ROUNDUP(HERE+bytes));
fptr = LINK_TO_FLAGS(dptr);
strptr = (char *)fptr - 1;
*strptr-- = len;
*strptr-- = 0;
while (len)
*strptr-- = name[--len];
} else {
dptr++;
fptr = LINK_TO_FLAGS(dptr);
flag |= FLAG_NONAME;
}
*fptr = flag;
*dptr = *((acf_t)env->current);
env->lastlink = dptr++;
set_here(env, (uchar_t *)dptr, "header");
if (name_is_debugged(env, name)) {
log_message(MSG_INFO, "Turning debug on for %s\n", name);
add_debug_acf(env, LINK_TO_ACF(env->lastlink));
}
debug_msg(DEBUG_HEADER, "Define: '%s' @ %p\n", name, HERE);
}