1*0Sstevel@tonic-gate /* 2*0Sstevel@tonic-gate * CDDL HEADER START 3*0Sstevel@tonic-gate * 4*0Sstevel@tonic-gate * The contents of this file are subject to the terms of the 5*0Sstevel@tonic-gate * Common Development and Distribution License, Version 1.0 only 6*0Sstevel@tonic-gate * (the "License"). You may not use this file except in compliance 7*0Sstevel@tonic-gate * with the License. 8*0Sstevel@tonic-gate * 9*0Sstevel@tonic-gate * You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE 10*0Sstevel@tonic-gate * or http://www.opensolaris.org/os/licensing. 11*0Sstevel@tonic-gate * See the License for the specific language governing permissions 12*0Sstevel@tonic-gate * and limitations under the License. 13*0Sstevel@tonic-gate * 14*0Sstevel@tonic-gate * When distributing Covered Code, include this CDDL HEADER in each 15*0Sstevel@tonic-gate * file and include the License file at usr/src/OPENSOLARIS.LICENSE. 16*0Sstevel@tonic-gate * If applicable, add the following below this CDDL HEADER, with the 17*0Sstevel@tonic-gate * fields enclosed by brackets "[]" replaced with your own identifying 18*0Sstevel@tonic-gate * information: Portions Copyright [yyyy] [name of copyright owner] 19*0Sstevel@tonic-gate * 20*0Sstevel@tonic-gate * CDDL HEADER END 21*0Sstevel@tonic-gate */ 22*0Sstevel@tonic-gate /* 23*0Sstevel@tonic-gate * Copyright (c) 2000 by Sun Microsystems, Inc. 24*0Sstevel@tonic-gate * All rights reserved. 25*0Sstevel@tonic-gate */ 26*0Sstevel@tonic-gate 27*0Sstevel@tonic-gate #pragma ident "%Z%%M% %I% %E% SMI" 28*0Sstevel@tonic-gate 29*0Sstevel@tonic-gate #include <stdio.h> 30*0Sstevel@tonic-gate #include <string.h> 31*0Sstevel@tonic-gate 32*0Sstevel@tonic-gate #include <fcode/private.h> 33*0Sstevel@tonic-gate #include <fcode/log.h> 34*0Sstevel@tonic-gate 35*0Sstevel@tonic-gate #define NUM_DEFAULT_ACTIONS 7 36*0Sstevel@tonic-gate 37*0Sstevel@tonic-gate /* 38*0Sstevel@tonic-gate * value_fetch and value_store are the same as "fetch" and "store", but 39*0Sstevel@tonic-gate * we'll leave them implemented here for now. 40*0Sstevel@tonic-gate */ 41*0Sstevel@tonic-gate static void 42*0Sstevel@tonic-gate value_fetch(fcode_env_t *env) 43*0Sstevel@tonic-gate { 44*0Sstevel@tonic-gate variable_t *addr; 45*0Sstevel@tonic-gate 46*0Sstevel@tonic-gate CHECK_DEPTH(env, 1, "value_fetch"); 47*0Sstevel@tonic-gate addr = (variable_t *)POP(DS); 48*0Sstevel@tonic-gate PUSH(DS, (variable_t)*addr); 49*0Sstevel@tonic-gate } 50*0Sstevel@tonic-gate 51*0Sstevel@tonic-gate static void 52*0Sstevel@tonic-gate value_store(fcode_env_t *env) 53*0Sstevel@tonic-gate { 54*0Sstevel@tonic-gate variable_t *addr; 55*0Sstevel@tonic-gate 56*0Sstevel@tonic-gate CHECK_DEPTH(env, 1, "value_store"); 57*0Sstevel@tonic-gate addr = (variable_t *)POP(DS); 58*0Sstevel@tonic-gate *addr = (variable_t)POP(DS); 59*0Sstevel@tonic-gate } 60*0Sstevel@tonic-gate 61*0Sstevel@tonic-gate void * 62*0Sstevel@tonic-gate get_internal_address(fcode_env_t *env) 63*0Sstevel@tonic-gate { 64*0Sstevel@tonic-gate int *ptr; 65*0Sstevel@tonic-gate 66*0Sstevel@tonic-gate CHECK_DEPTH(env, 1, "get_internal_address"); 67*0Sstevel@tonic-gate ptr = (int *)POP(DS); 68*0Sstevel@tonic-gate if (*ptr > 0) 69*0Sstevel@tonic-gate return ((uchar_t *)env + *ptr); 70*0Sstevel@tonic-gate return ((uchar_t *)MYSELF - *ptr); 71*0Sstevel@tonic-gate } 72*0Sstevel@tonic-gate 73*0Sstevel@tonic-gate void 74*0Sstevel@tonic-gate internal_env_fetch(fcode_env_t *env) 75*0Sstevel@tonic-gate { 76*0Sstevel@tonic-gate instance_t **iptr; 77*0Sstevel@tonic-gate 78*0Sstevel@tonic-gate CHECK_DEPTH(env, 1, "internal_env_fetch"); 79*0Sstevel@tonic-gate iptr = (instance_t **)get_internal_address(env); 80*0Sstevel@tonic-gate PUSH(DS, (fstack_t)(*iptr)); 81*0Sstevel@tonic-gate } 82*0Sstevel@tonic-gate 83*0Sstevel@tonic-gate void 84*0Sstevel@tonic-gate internal_env_store(fcode_env_t *env) 85*0Sstevel@tonic-gate { 86*0Sstevel@tonic-gate instance_t **iptr; 87*0Sstevel@tonic-gate 88*0Sstevel@tonic-gate CHECK_DEPTH(env, 2, "internal_env_store"); 89*0Sstevel@tonic-gate iptr = (instance_t **)get_internal_address(env); 90*0Sstevel@tonic-gate *iptr = (instance_t *)POP(DS); 91*0Sstevel@tonic-gate } 92*0Sstevel@tonic-gate 93*0Sstevel@tonic-gate void 94*0Sstevel@tonic-gate internal_env_addr(fcode_env_t *env) 95*0Sstevel@tonic-gate { 96*0Sstevel@tonic-gate fstack_t d; 97*0Sstevel@tonic-gate 98*0Sstevel@tonic-gate CHECK_DEPTH(env, 1, "internal_env_addr"); 99*0Sstevel@tonic-gate d = (fstack_t)get_internal_address(env); 100*0Sstevel@tonic-gate PUSH(DS, d); 101*0Sstevel@tonic-gate } 102*0Sstevel@tonic-gate 103*0Sstevel@tonic-gate void 104*0Sstevel@tonic-gate do_buffer_data(fcode_env_t *env, token_t *d, int instance) 105*0Sstevel@tonic-gate { 106*0Sstevel@tonic-gate if (!*d) { /* check if buffer not alloc'ed yet */ 107*0Sstevel@tonic-gate token_t *buf; 108*0Sstevel@tonic-gate 109*0Sstevel@tonic-gate if (instance) { 110*0Sstevel@tonic-gate int n, off; 111*0Sstevel@tonic-gate 112*0Sstevel@tonic-gate n = TOKEN_ROUNDUP(d[1]); 113*0Sstevel@tonic-gate buf = alloc_instance_data(env, UINIT_DATA, n, &off); 114*0Sstevel@tonic-gate memset(buf, 0, d[1]); 115*0Sstevel@tonic-gate } else { 116*0Sstevel@tonic-gate buf = (token_t *)HERE; 117*0Sstevel@tonic-gate set_here(env, HERE + d[1], "do_buffer_data"); 118*0Sstevel@tonic-gate } 119*0Sstevel@tonic-gate *d = (token_t)buf; 120*0Sstevel@tonic-gate } 121*0Sstevel@tonic-gate PUSH(DS, *d); 122*0Sstevel@tonic-gate } 123*0Sstevel@tonic-gate 124*0Sstevel@tonic-gate void 125*0Sstevel@tonic-gate ibuffer_init(fcode_env_t *env) 126*0Sstevel@tonic-gate { 127*0Sstevel@tonic-gate token_t *d; 128*0Sstevel@tonic-gate 129*0Sstevel@tonic-gate d = get_instance_address(env); 130*0Sstevel@tonic-gate do_buffer_data(env, d, 1); 131*0Sstevel@tonic-gate } 132*0Sstevel@tonic-gate 133*0Sstevel@tonic-gate void 134*0Sstevel@tonic-gate buffer_init(fcode_env_t *env) 135*0Sstevel@tonic-gate { 136*0Sstevel@tonic-gate token_t *d; 137*0Sstevel@tonic-gate 138*0Sstevel@tonic-gate CHECK_DEPTH(env, 1, "buffer_init"); 139*0Sstevel@tonic-gate d = (token_t *)POP(DS); 140*0Sstevel@tonic-gate do_buffer_data(env, d, 0); 141*0Sstevel@tonic-gate } 142*0Sstevel@tonic-gate 143*0Sstevel@tonic-gate void 144*0Sstevel@tonic-gate do_defer(fcode_env_t *env) 145*0Sstevel@tonic-gate { 146*0Sstevel@tonic-gate fetch(env); 147*0Sstevel@tonic-gate execute(env); 148*0Sstevel@tonic-gate } 149*0Sstevel@tonic-gate 150*0Sstevel@tonic-gate token_t *value_actions[NUM_DEFAULT_ACTIONS]; 151*0Sstevel@tonic-gate token_t value_defines[NUM_DEFAULT_ACTIONS][3] = { 152*0Sstevel@tonic-gate { (token_t)&value_fetch, (token_t)&value_store, (token_t)&noop }, 153*0Sstevel@tonic-gate { (token_t)&fetch_instance_data, (token_t)&set_instance_data, 154*0Sstevel@tonic-gate (token_t)&address_instance_data }, 155*0Sstevel@tonic-gate { (token_t)&internal_env_fetch, (token_t)&internal_env_store, 156*0Sstevel@tonic-gate (token_t)&internal_env_addr }, 157*0Sstevel@tonic-gate { (token_t)&do_defer, (token_t)&store, (token_t)&noop }, 158*0Sstevel@tonic-gate { (token_t)&idefer_exec, (token_t)&set_instance_data, 159*0Sstevel@tonic-gate (token_t)&address_instance_data }, 160*0Sstevel@tonic-gate { (token_t)&buffer_init, (token_t)&two_drop, (token_t)&noop, }, 161*0Sstevel@tonic-gate { (token_t)&ibuffer_init, (token_t)&two_drop, 162*0Sstevel@tonic-gate (token_t)&address_instance_data } 163*0Sstevel@tonic-gate }; 164*0Sstevel@tonic-gate 165*0Sstevel@tonic-gate int 166*0Sstevel@tonic-gate run_action(fcode_env_t *env, acf_t acf, int action) 167*0Sstevel@tonic-gate { 168*0Sstevel@tonic-gate token_t *p = (token_t *)acf; 169*0Sstevel@tonic-gate 170*0Sstevel@tonic-gate if ((p[0] & 1) == 0) { 171*0Sstevel@tonic-gate log_message(MSG_WARN, "run_action: acf: %p @acf: %p not" 172*0Sstevel@tonic-gate " indirect\n", acf, p[0]); 173*0Sstevel@tonic-gate return (1); 174*0Sstevel@tonic-gate } 175*0Sstevel@tonic-gate 176*0Sstevel@tonic-gate p = (token_t *)(p[0] & ~1); 177*0Sstevel@tonic-gate 178*0Sstevel@tonic-gate if (action >= p[1] || action < 0) { 179*0Sstevel@tonic-gate log_message(MSG_WARN, "run_action: acf: %p action: %d" 180*0Sstevel@tonic-gate " out of range: 0-%d\n", acf, action, (int)p[1]); 181*0Sstevel@tonic-gate return (1); 182*0Sstevel@tonic-gate } 183*0Sstevel@tonic-gate 184*0Sstevel@tonic-gate if (p[0] == (token_t)&do_default_action) { 185*0Sstevel@tonic-gate fstack_t d; 186*0Sstevel@tonic-gate 187*0Sstevel@tonic-gate d = (fstack_t)p[action+2]; 188*0Sstevel@tonic-gate PUSH(DS, d); 189*0Sstevel@tonic-gate execute(env); 190*0Sstevel@tonic-gate return (0); 191*0Sstevel@tonic-gate } 192*0Sstevel@tonic-gate log_message(MSG_WARN, "run_action: acf: %p/%p not default action\n", 193*0Sstevel@tonic-gate acf, p[0]); 194*0Sstevel@tonic-gate return (1); 195*0Sstevel@tonic-gate } 196*0Sstevel@tonic-gate 197*0Sstevel@tonic-gate void 198*0Sstevel@tonic-gate do_default_action(fcode_env_t *env) 199*0Sstevel@tonic-gate { 200*0Sstevel@tonic-gate acf_t a; 201*0Sstevel@tonic-gate 202*0Sstevel@tonic-gate CHECK_DEPTH(env, 1, "do_default_action"); 203*0Sstevel@tonic-gate a = (acf_t)TOS; 204*0Sstevel@tonic-gate (void) run_action(env, (a-1), 0); 205*0Sstevel@tonic-gate } 206*0Sstevel@tonic-gate 207*0Sstevel@tonic-gate void 208*0Sstevel@tonic-gate do_set_action(fcode_env_t *env) 209*0Sstevel@tonic-gate { 210*0Sstevel@tonic-gate acf_t a = (acf_t)TOS; 211*0Sstevel@tonic-gate 212*0Sstevel@tonic-gate CHECK_DEPTH(env, 1, "do_set_action"); 213*0Sstevel@tonic-gate TOS += sizeof (acf_t); 214*0Sstevel@tonic-gate (void) run_action(env, a, 1); 215*0Sstevel@tonic-gate } 216*0Sstevel@tonic-gate 217*0Sstevel@tonic-gate void 218*0Sstevel@tonic-gate action_colon(fcode_env_t *env) 219*0Sstevel@tonic-gate { 220*0Sstevel@tonic-gate token_roundup(env, "action_colon"); 221*0Sstevel@tonic-gate env->action_ptr[env->action_count] = (token_t)HERE; 222*0Sstevel@tonic-gate COMPILE_TOKEN(&do_colon); 223*0Sstevel@tonic-gate env->action_count++; 224*0Sstevel@tonic-gate env->state |= 1; 225*0Sstevel@tonic-gate } 226*0Sstevel@tonic-gate 227*0Sstevel@tonic-gate void 228*0Sstevel@tonic-gate actions(fcode_env_t *env) 229*0Sstevel@tonic-gate { 230*0Sstevel@tonic-gate int n; 231*0Sstevel@tonic-gate token_t *d; 232*0Sstevel@tonic-gate 233*0Sstevel@tonic-gate token_roundup(env, "actions"); 234*0Sstevel@tonic-gate d = (token_t *)HERE; 235*0Sstevel@tonic-gate *d++ = (token_t)&do_default_action; 236*0Sstevel@tonic-gate n = (int)POP(DS); 237*0Sstevel@tonic-gate *d++ = n; 238*0Sstevel@tonic-gate env->num_actions = n; 239*0Sstevel@tonic-gate env->action_count = 0; 240*0Sstevel@tonic-gate env->action_ptr = d; 241*0Sstevel@tonic-gate d += n; 242*0Sstevel@tonic-gate set_here(env, (uchar_t *)d, "actions"); 243*0Sstevel@tonic-gate } 244*0Sstevel@tonic-gate 245*0Sstevel@tonic-gate void 246*0Sstevel@tonic-gate install_actions(fcode_env_t *env, token_t *table) 247*0Sstevel@tonic-gate { 248*0Sstevel@tonic-gate acf_t *dptr; 249*0Sstevel@tonic-gate token_t p; 250*0Sstevel@tonic-gate 251*0Sstevel@tonic-gate dptr = (acf_t *)LINK_TO_ACF(env->lastlink); 252*0Sstevel@tonic-gate p = (token_t)table; 253*0Sstevel@tonic-gate p -= (sizeof (token_t) + sizeof (acf_t)); 254*0Sstevel@tonic-gate *dptr = (acf_t)(p | 1); 255*0Sstevel@tonic-gate } 256*0Sstevel@tonic-gate 257*0Sstevel@tonic-gate void 258*0Sstevel@tonic-gate use_actions(fcode_env_t *env) 259*0Sstevel@tonic-gate { 260*0Sstevel@tonic-gate if (env->state) { 261*0Sstevel@tonic-gate TODO; /* use-actions in compile state. */ 262*0Sstevel@tonic-gate } else { 263*0Sstevel@tonic-gate install_actions(env, env->action_ptr); 264*0Sstevel@tonic-gate } 265*0Sstevel@tonic-gate } 266*0Sstevel@tonic-gate 267*0Sstevel@tonic-gate void 268*0Sstevel@tonic-gate perform_action(fcode_env_t *env) 269*0Sstevel@tonic-gate { 270*0Sstevel@tonic-gate int n; 271*0Sstevel@tonic-gate acf_t a; 272*0Sstevel@tonic-gate 273*0Sstevel@tonic-gate CHECK_DEPTH(env, 2, "perform_action"); 274*0Sstevel@tonic-gate n = POP(DS); 275*0Sstevel@tonic-gate a = (acf_t)POP(DS); 276*0Sstevel@tonic-gate PUSH(DS, (fstack_t)ACF_TO_BODY(a)); 277*0Sstevel@tonic-gate 278*0Sstevel@tonic-gate if (run_action(env, a, n)) { 279*0Sstevel@tonic-gate system_message(env, "Bad Object action"); 280*0Sstevel@tonic-gate } 281*0Sstevel@tonic-gate } 282*0Sstevel@tonic-gate 283*0Sstevel@tonic-gate void 284*0Sstevel@tonic-gate define_actions(fcode_env_t *env, int n, token_t *array) 285*0Sstevel@tonic-gate { 286*0Sstevel@tonic-gate int a; 287*0Sstevel@tonic-gate 288*0Sstevel@tonic-gate PUSH(DS, (fstack_t)n); 289*0Sstevel@tonic-gate actions(env); 290*0Sstevel@tonic-gate 291*0Sstevel@tonic-gate a = 0; 292*0Sstevel@tonic-gate while (n--) { 293*0Sstevel@tonic-gate action_colon(env); 294*0Sstevel@tonic-gate COMPILE_TOKEN(&array[a]); 295*0Sstevel@tonic-gate env->state |= 8; 296*0Sstevel@tonic-gate semi(env); 297*0Sstevel@tonic-gate a++; 298*0Sstevel@tonic-gate } 299*0Sstevel@tonic-gate } 300*0Sstevel@tonic-gate 301*0Sstevel@tonic-gate /* 302*0Sstevel@tonic-gate * This is for things like my-self which have meaning to the 303*0Sstevel@tonic-gate * forth engine but I don't want to turn them into standard forth values 304*0Sstevel@tonic-gate * that would make the 'C' variables hard to understand, instead these 305*0Sstevel@tonic-gate * 'global' state variables will act directly upon the native 'C' structures. 306*0Sstevel@tonic-gate */ 307*0Sstevel@tonic-gate 308*0Sstevel@tonic-gate void 309*0Sstevel@tonic-gate set_internal_value_actions(fcode_env_t *env) 310*0Sstevel@tonic-gate { 311*0Sstevel@tonic-gate ASSERT(value_actions[2]); 312*0Sstevel@tonic-gate install_actions(env, value_actions[2]); 313*0Sstevel@tonic-gate } 314*0Sstevel@tonic-gate 315*0Sstevel@tonic-gate void 316*0Sstevel@tonic-gate set_value_actions(fcode_env_t *env, int which) 317*0Sstevel@tonic-gate { 318*0Sstevel@tonic-gate ASSERT((which == 0) || (which == 1)); 319*0Sstevel@tonic-gate ASSERT(value_actions[which]); 320*0Sstevel@tonic-gate install_actions(env, value_actions[which]); 321*0Sstevel@tonic-gate } 322*0Sstevel@tonic-gate 323*0Sstevel@tonic-gate void 324*0Sstevel@tonic-gate set_defer_actions(fcode_env_t *env, int which) 325*0Sstevel@tonic-gate { 326*0Sstevel@tonic-gate ASSERT((which == 0) || (which == 1)); 327*0Sstevel@tonic-gate ASSERT(value_actions[which+3]); 328*0Sstevel@tonic-gate install_actions(env, value_actions[which+3]); 329*0Sstevel@tonic-gate } 330*0Sstevel@tonic-gate 331*0Sstevel@tonic-gate void 332*0Sstevel@tonic-gate set_buffer_actions(fcode_env_t *env, int which) 333*0Sstevel@tonic-gate { 334*0Sstevel@tonic-gate ASSERT((which == 0) || (which == 1)); 335*0Sstevel@tonic-gate ASSERT(value_actions[which+5]); 336*0Sstevel@tonic-gate install_actions(env, value_actions[which+5]); 337*0Sstevel@tonic-gate } 338*0Sstevel@tonic-gate 339*0Sstevel@tonic-gate #if defined(DEBUG) 340*0Sstevel@tonic-gate 341*0Sstevel@tonic-gate void 342*0Sstevel@tonic-gate do_get(fcode_env_t *env) 343*0Sstevel@tonic-gate { 344*0Sstevel@tonic-gate PUSH(DS, 0); 345*0Sstevel@tonic-gate perform_action(env); 346*0Sstevel@tonic-gate } 347*0Sstevel@tonic-gate 348*0Sstevel@tonic-gate void 349*0Sstevel@tonic-gate do_set(fcode_env_t *env) 350*0Sstevel@tonic-gate { 351*0Sstevel@tonic-gate PUSH(DS, 1); 352*0Sstevel@tonic-gate perform_action(env); 353*0Sstevel@tonic-gate } 354*0Sstevel@tonic-gate 355*0Sstevel@tonic-gate void 356*0Sstevel@tonic-gate do_addr(fcode_env_t *env) 357*0Sstevel@tonic-gate { 358*0Sstevel@tonic-gate PUSH(DS, 2); 359*0Sstevel@tonic-gate perform_action(env); 360*0Sstevel@tonic-gate } 361*0Sstevel@tonic-gate 362*0Sstevel@tonic-gate void 363*0Sstevel@tonic-gate dump_actions(fcode_env_t *env) 364*0Sstevel@tonic-gate { 365*0Sstevel@tonic-gate int i; 366*0Sstevel@tonic-gate for (i = 0; i < NUM_DEFAULT_ACTIONS; i++) { 367*0Sstevel@tonic-gate log_message(MSG_INFO, "Action Set: %d = %p\n", i, 368*0Sstevel@tonic-gate value_actions[i]); 369*0Sstevel@tonic-gate } 370*0Sstevel@tonic-gate } 371*0Sstevel@tonic-gate #endif /* DEBUG */ 372*0Sstevel@tonic-gate 373*0Sstevel@tonic-gate #pragma init(_init) 374*0Sstevel@tonic-gate 375*0Sstevel@tonic-gate static void 376*0Sstevel@tonic-gate _init(void) 377*0Sstevel@tonic-gate { 378*0Sstevel@tonic-gate fcode_env_t *env = initial_env; 379*0Sstevel@tonic-gate int i; 380*0Sstevel@tonic-gate 381*0Sstevel@tonic-gate ASSERT(env); 382*0Sstevel@tonic-gate NOTICE; 383*0Sstevel@tonic-gate 384*0Sstevel@tonic-gate for (i = 0; i < NUM_DEFAULT_ACTIONS; i++) { 385*0Sstevel@tonic-gate define_actions(env, 3, value_defines[i]); 386*0Sstevel@tonic-gate value_actions[i] = env->action_ptr; 387*0Sstevel@tonic-gate } 388*0Sstevel@tonic-gate 389*0Sstevel@tonic-gate #if defined(DEBUG) 390*0Sstevel@tonic-gate FORTH(0, "get", do_get); 391*0Sstevel@tonic-gate FORTH(0, "set", do_set); 392*0Sstevel@tonic-gate FORTH(0, "addr", do_addr); 393*0Sstevel@tonic-gate FORTH(0, "dump-actions", dump_actions); 394*0Sstevel@tonic-gate FORTH(IMMEDIATE, "actions", actions); 395*0Sstevel@tonic-gate FORTH(IMMEDIATE, "use-actions", use_actions); 396*0Sstevel@tonic-gate FORTH(IMMEDIATE, "action:", action_colon); 397*0Sstevel@tonic-gate FORTH(0, "perform-action", perform_action); 398*0Sstevel@tonic-gate #endif /* DEBUG */ 399*0Sstevel@tonic-gate } 400