/*
* allocate a new page
*/
void CTcDataStream::alloc_page()
{
/*
* if we're coming back to a page that was previously allocated, we
* need merely re-establish the existing page
*/
if (page_cur_ + 1 < page_cnt_)
{
/* move to the next page */
++page_cur_;
/* start writing at the start of the page */
wp_ = pages_[page_cur_];
rem_ = TCCS_PAGE_SIZE;
/* we're done */
return;
}
/*
* if we don't have room for a new page in the page array, expand
* the page array
*/
if (page_cnt_ >= page_slots_)
{
/* increase the page slot count */
page_slots_ += 100;
/* allocate or reallocate the page array */
if (pages_ == 0)
pages_ = (char **)t3malloc(page_slots_ * sizeof(pages_[0]));
else
pages_ = (char **)t3realloc(pages_,
page_slots_ * sizeof(pages_[0]));
/* if that failed, throw an error */
if (pages_ == 0)
err_throw(TCERR_CODEGEN_NO_MEM);
}
/* allocate the new page */
pages_[page_cnt_] = (char *)t3malloc(TCCS_PAGE_SIZE);
/* throw an error if we couldn't allocate the page */
if (pages_[page_cnt_] == 0)
err_throw(TCERR_CODEGEN_NO_MEM);
/* start writing at the start of the new page */
wp_ = pages_[page_cnt_];
/* the entire page is free */
rem_ = TCCS_PAGE_SIZE;
/* make the new page the current page */
page_cur_ = page_cnt_;
/* count the new page */
++page_cnt_;
}
/*
* assign an indexed value: this sets a variable's value by index
*/
int CVmObjFrameRef::set_index_val_q(VMG_ vm_val_t *new_container,
vm_obj_id_t self,
const vm_val_t *index_val,
const vm_val_t *new_val)
{
/* get our extension */
vm_frameref_ext *ext = get_ext();
/* check the type */
if (index_val->typ == VM_INT)
{
/*
* It's a direct index into the frame. Make sure the value is in
* range.
*/
int n = index_val->val.intval;
if (n < 0 || n >= ext->nlocals + ext->nparams)
err_throw(VMERR_INDEX_OUT_OF_RANGE);
/*
* If we have an active stack frame, read the value from the stack;
* otherwise read it from the snapshot array.
*/
if (ext->fp != 0)
{
/* get it from the stack frame */
if (n < ext->nlocals)
{
/* it's in the local variable range */
*G_interpreter->get_local_from_frame(vmg_ ext->fp, n) =
*new_val;
}
else
{
/* it's in the parameter range */
*G_interpreter->get_param_from_frame(
vmg_ ext->fp, n - ext->nlocals) = *new_val;
}
}
else
{
/* there's no frame - get it from the snapshot array */
ext->vars[n] = *new_val;
}
}
else
{
/* invalid index type */
err_throw(VMERR_INDEX_OUT_OF_RANGE);
}
/* the container doesn't change */
new_container->set_obj(self);
/* handled */
return TRUE;
}
/*
* Empty a local directory
*/
static void empty_dir(VMG_ const char *dir)
{
/* open the directory search */
osdirhdl_t dirhdl;
if (os_open_dir(dir, &dirhdl))
{
err_try
{
/* keep going until we're out of files */
char fname[OSFNMAX];
while (os_read_dir(dirhdl, fname, sizeof(fname)))
{
/* get the full path */
char path[OSFNMAX];
os_build_full_path(path, sizeof(path), dir, fname);
/* get the mode */
unsigned long fmode;
unsigned long fattr;
if (osfmode(path, FALSE, &fmode, &fattr))
{
/* check whether it's a directory or an ordinary file */
if ((fmode & OSFMODE_DIR) != 0)
{
/*
* directory - skip the special '.' and '..' links,
* since they'd get us stuck in a loop
*/
os_specfile_t st = os_is_special_file(fname);
if (st != OS_SPECFILE_SELF && st != OS_SPECFILE_PARENT)
{
/* recursively empty the directory */
empty_dir(vmg_ path);
/* remove this directory */
if (!os_rmdir(path))
err_throw(VMERR_DELETE_FILE);
}
}
else
{
/* ordinary file - delete it */
if (osfdel(path))
err_throw(VMERR_DELETE_FILE);
}
}
}
}
err_finally
{
/* close the directory search handle */
os_close_dir(dirhdl);
}
err_end;
}
/*
* create from stack arguments
*/
vm_obj_id_t CVmObjAnonFn::create_from_stack(VMG_ const uchar **pc_ptr,
uint argc)
{
vm_obj_id_t id;
vm_val_t funcptr;
CVmObjAnonFn *new_obj;
uint idx;
/* at least one argument is required (the function pointer) */
if (argc < 1)
err_throw(VMERR_WRONG_NUM_OF_ARGS);
/* retrieve our function pointer argument */
G_stk->pop(&funcptr);
if (funcptr.typ == VM_FUNCPTR)
{
/* it's a regular function pointer - accept it */
}
else if (funcptr.typ == VM_OBJ
&& vm_objp(vmg_ funcptr.val.obj)->get_invoker(vmg_ 0))
{
/* it's a pointer to an invokable object - accept it */
}
else
{
/* it's not a valid function pointer */
err_throw(VMERR_FUNCPTR_VAL_REQD);
}
/* create the new object */
id = vm_new_id(vmg_ FALSE, TRUE, FALSE);
/* create the new object, giving it one slot per constructor argument */
new_obj = new (vmg_ id) CVmObjAnonFn(vmg_ argc);
/* set the first element to our function pointer */
new_obj->set_element(0, &funcptr);
/* set the remaining elements to the context objects */
for (idx = 1 ; idx < argc ; ++idx)
{
vm_val_t val;
/* pop this value */
G_stk->pop(&val);
/* set the element */
new_obj->set_element(idx, &val);
}
/* return the new object ID */
return id;
}
/**
* execute a procedure
*/
int sblmgr_procexec(int lib_id, int index) {
#if defined(LNX_EXTLIB) || defined(WIN_EXTLIB)
slib_t *lib;
var_t ret;
slib_par_t *ptable = NULL;
int (*pexec) (int, int, slib_par_t *, var_t *);
int pcount = 0;
int success = 0;
if (lib_id < 0 || lib_id >= slib_count) {
return 0;
}
lib = &slib_table[lib_id];
pexec = slib_getoptptr(lib, "sblib_proc_exec");
if (pexec == NULL) {
return 0;
}
// build parameter table
ptable = malloc(sizeof(slib_par_t) * MAX_PARAM);
pcount = slib_build_ptable(ptable);
if (prog_error) {
slib_free_ptable(ptable, pcount);
free(ptable);
return 0;
}
// exec
v_init(&ret);
success = pexec(index - lib->first_proc, pcount, ptable, &ret);
// error
if (!success) {
if (ret.type == V_STR) {
err_throw("lib:%s: %s\n", lib->name, ret.v.p.ptr);
} else {
err_throw("lib:%s: Unspecified error\n", lib->name);
}
}
// clean-up
if (ptable) {
slib_free_ptable(ptable, pcount);
free(ptable);
}
v_free(&ret);
return success;
#else
return 0;
#endif
}
/*
* Rename a file
*/
void CVmNetFile::rename_to_local(VMG_ CVmNetFile *newname)
{
/* if the new name isn't local, this isn't supported */
if (newname->is_net_file())
err_throw(VMERR_RENAME_FILE);
/* if the destination file already exists, it's an error */
if (!osfacc(newname->lclfname))
err_throw(VMERR_RENAME_FILE);
/* do the rename */
if (!os_rename_file(lclfname, newname->lclfname))
err_throw(VMERR_RENAME_FILE);
}
/*
* Allocate a new label object
*/
CTcCodeLabel *CTcCodeStream::alloc_label()
{
CTcCodeLabel *ret;
/* if there's anything in the free list, use it */
if (free_lbl_ != 0)
{
/* take the first one off the free list */
ret = free_lbl_;
/* unlink it from the list */
free_lbl_ = free_lbl_->nxt;
}
else
{
/* allocate a new label */
ret = new (allocator_) CTcCodeLabel;
/* throw an error if allocation failed */
if (ret == 0)
err_throw(TCERR_CODEGEN_NO_MEM);
}
/* add the label to the active list */
ret->nxt = active_lbl_;
active_lbl_ = ret;
/* return the allocated label */
return ret;
}
/*
* create dynamically using stack arguments
*/
vm_obj_id_t CVmObjClass::create_from_stack(VMG_ const uchar **pc_ptr,
uint argc)
{
/* it is illegal to create this type of object dynamically */
err_throw(VMERR_ILLEGAL_NEW);
AFTER_ERR_THROW(return VM_INVALID_OBJ;)
}
/* load image data */
void CVmObjClass::load_image_data(VMG_ vm_obj_id_t self,
const char *ptr, size_t siz)
{
/* make sure the length is valid */
if (siz < 8)
err_throw(VMERR_INVAL_METACLASS_DATA);
/* allocate or reallocate the extension */
vm_intcls_ext *ext = alloc_ext(vmg0_);
/*
* read the metaclass index and modifier object ID; note that modifier
* objects are always root set objects, so there's no need to worry
* about fixups
*/
ext->meta_idx = osrp2(ptr+2);
ext->mod_obj = (vm_obj_id_t)t3rp4u(ptr+4);
/* if we have a class state value, read it */
ext->class_state.set_nil();
if (siz >= 2+4+VMB_DATAHOLDER)
vmb_get_dh(ptr+8, &ext->class_state);
/* register myself */
register_meta(vmg_ self);
}
/*
* Debug Trace
*/
void CVmBifT3::debug_trace(VMG_ uint argc)
{
/* make sure we have at least one argument */
if (argc < 1)
err_throw(VMERR_WRONG_NUM_OF_ARGS);
/* pop the flags and see what we're being asked to do */
switch(pop_int_val(vmg0_))
{
case T3DBG_CHECK:
/* check arguments */
check_argc(vmg_ argc, 1);
/* we're just being asked if the debugger is present - it is */
retval_true(vmg0_);
break;
case T3DBG_BREAK:
/* check arguments */
check_argc(vmg_ argc, 1);
/* tell the debugger to activate debug-trace mode */
G_debugger->set_debug_trace();
/* tell the caller we were successful */
retval_true(vmg0_);
break;
default:
/* anything else just returns nil, to allow for future expansion */
G_stk->discard(argc - 1);
retval_nil(vmg0_);
break;
}
}
/*
* set a property
*/
void CVmObjHTTPServer::set_prop(VMG_ class CVmUndo *undo,
vm_obj_id_t self, vm_prop_id_t prop,
const vm_val_t *val)
{
/* no settable properties - throw an error */
err_throw(VMERR_INVALID_SETPROP);
}
/*
* Allocate a new fixup object
*/
CTcLabelFixup *CTcCodeStream::alloc_fixup()
{
CTcLabelFixup *ret;
/* if there's anything in the free list, use it */
if (free_fixup_ != 0)
{
/* take the first one off the free list */
ret = free_fixup_;
/* unlink it from the list */
free_fixup_ = free_fixup_->nxt;
}
else
{
/* allocate a new fixup */
ret = new (allocator_) CTcLabelFixup;
/* throw an error if allocation failed */
if (ret == 0)
err_throw(TCERR_CODEGEN_NO_MEM);
}
/* return the allocated fixup */
return ret;
}
/*
* open for reading
*/
void CVmFile::open_read(const char *fname, os_filetype_t typ)
{
/* try opening the underlying OS file for binary reading */
fp_ = osfoprb(fname, typ);
/* if that failed, throw an error */
if (fp_ == 0)
err_throw(VMERR_FILE_NOT_FOUND);
}
/*
* open for writing
*/
void CVmFile::open_write(const char *fname, os_filetype_t typ)
{
/* try opening the underlying OS file for binary writing */
fp_ = osfopwb(fname, typ);
/* if that failed, throw an error */
if (fp_ == 0)
err_throw(VMERR_CREATE_FILE);
}
/*
* Invoke the VM-stack-based constructor for the metaclass at the given
* index
*/
vm_obj_id_t CVmMetaTable::create_from_stack(VMG_ const uchar **pc_ptr,
uint idx, uint argc)
{
/* make sure the entry is defined */
if (idx >= count_)
err_throw(VMERR_BAD_METACLASS_INDEX);
/* invoke the appropriate constructor */
return table_[idx].meta_->create_from_stack(vmg_ pc_ptr, argc);
}
/*
* Call a static property in the metaclass at the given index
*/
int CVmMetaTable::call_static_prop(VMG_ vm_val_t *result,
const uchar **pc_ptr, uint idx,
uint *argc, vm_prop_id_t prop)
{
/* make sure the entry is defined */
if (idx >= count_)
err_throw(VMERR_BAD_METACLASS_INDEX);
/* invoke the appropriate static property evaluator */
return table_[idx].meta_->call_stat_prop(vmg_ result, pc_ptr, argc, prop);
}
/*
* index the frame: this looks up a variable's value by name
*/
int CVmObjFrameDesc::index_val_q(VMG_ vm_val_t *result,
vm_obj_id_t self,
const vm_val_t *index_val)
{
/* check the index type */
if (index_val->get_as_string(vmg0_))
{
/* it's a string - look up the value by name */
if (!get_local_val(vmg_ result, index_val))
err_throw(VMERR_INDEX_OUT_OF_RANGE);
}
else
{
/* invalid index type */
err_throw(VMERR_INDEX_OUT_OF_RANGE);
}
/* handled */
return TRUE;
}
size_t utf_length(str_t s, int enc) {
size_t res = 0;
str_it_t i = str_begin(s);
str_it_t e = str_end(s);
while(i<e) {
int cl = CHAR_LEN(i, enc);
res++;
i += cl;
if(i>e)
err_throw(e_utf_conversion);
}
return res;
}
/*
* Create an object of the given metaclass with the given ID, in
* preparation for restoring the object's data from saved state
* information. This doesn't fill in the object with the saved state
* data, but merely creates the object.
*
* The caller is responsible for having allocated the object ID before
* calling this function.
*/
void CVmMetaTable::create_for_restore(VMG_ uint idx, vm_obj_id_t id)
{
/* make sure the entry is defined in our table of metaclasses */
if (idx >= count_)
err_throw(VMERR_BAD_METACLASS_INDEX);
/*
* Invoke the appropriate constructor. Note that the caller must
* already have allocated the object ID, so we simply use the given ID
* without further consideration.
*/
table_[idx].meta_->create_for_restore(vmg_ id);
}
/*
* find a local variable in our frame by name, given a VM string value
*/
int CVmObjFrameDesc::find_local(VMG_ const vm_val_t *nval,
CVmDbgFrameSymPtr *symp)
{
/* make sure the name is a string */
const char *name = nval->get_as_string(vmg0_);
if (name == 0)
err_throw(VMERR_BAD_TYPE_BIF);
/* parse the length */
size_t namelen = vmb_get_len(name);
name += VMB_LEN;
/* look up the symbol */
return find_local(vmg_ name, namelen, symp);
}
/*
* assign an indexed value: this sets a variable's value by name
*/
int CVmObjFrameDesc::set_index_val_q(VMG_ vm_val_t *new_container,
vm_obj_id_t self,
const vm_val_t *index_val,
const vm_val_t *new_val)
{
/* check the index type */
if (index_val->get_as_string(vmg0_))
{
/* it's a string - look up the value by name */
if (!set_local_val(vmg_ index_val, new_val))
err_throw(VMERR_INDEX_OUT_OF_RANGE);
}
else
{
/* invalid index type */
err_throw(VMERR_INDEX_OUT_OF_RANGE);
}
/* the container doesn't change */
new_container->set_obj(self);
/* handled */
return TRUE;
}
/*
* Create an object with the given ID and load the object from the image
* file.
*/
void CVmMetaTable::create_from_image(VMG_ uint idx, vm_obj_id_t id,
const char *ptr, size_t siz)
{
/* make sure the entry is defined */
if (idx >= count_)
err_throw(VMERR_BAD_METACLASS_INDEX);
/* create the object table entry in the memory manager */
G_obj_table->alloc_obj_with_id(id, TRUE);
/* invoke the appropriate constructor */
table_[idx].meta_->create_for_image_load(vmg_ id);
/* load the object */
vm_objp(vmg_ id)->load_from_image(vmg_ id, ptr, siz);
}
/*
* Set the value of a local given the variable descriptor
*/
void CVmObjFrameRef::set_local_val(VMG_ const CVmDbgFrameSymPtr *sym,
const vm_val_t *new_val)
{
/*
* if we have an active stack frame, get the value from the frame;
* otherwise get the value from our local snapshot
*/
vm_frameref_ext *ext = get_ext();
if (ext->fp != 0)
{
/* we have a frame - get the value from the frame */
G_interpreter->set_local_in_frame(vmg_ new_val, ext->fp, sym);
}
else
{
/*
* There's no frame, so we must retrieve the value from the
* snapshot. First, get the value of the local or parameter. Our
* snapshot array consists of all of the locals followed by all of
* the parameters, so local N is at vars[N] and parameter N is at
* vars[nlocals + N].
*/
vm_val_t *v = &ext->vars[sym->get_var_num()
+ (sym->is_param() ? ext->nlocals : 0)];
/*
* If it's a context local, index the local by the context index.
* Otherwise the value is simply the value in the snapshot array.
*/
if (sym->is_ctx_local())
{
vm_val_t cont;
vm_val_t ival;
ival.set_int(sym->get_ctx_arr_idx());
if (v->typ == VM_OBJ)
vm_objp(vmg_ v->val.obj)->set_index_val_ov(
vmg_ &cont, v->val.obj, &ival, new_val);
else
err_throw(VMERR_CANNOT_INDEX_TYPE);
}
else
*v = *new_val;
}
}
/*
* compare two vm_val_t values
*/
int CVmQSortVal::compare(VMG_ size_t a, size_t b)
{
int result;
vm_val_t val_a;
vm_val_t val_b;
/* get the two values */
get_ele(vmg_ a, &val_a);
get_ele(vmg_ b, &val_b);
/* check for an explicit comparison function */
if (compare_fn_.typ != VM_NIL)
{
vm_val_t val;
/* push the values (in reverse order) */
G_stk->push(&val_b);
G_stk->push(&val_a);
/* invoke the callback */
G_interpreter->call_func_ptr(vmg_ &compare_fn_, 2, &rc, 0);
/* get the result */
val = *G_interpreter->get_r0();
/* if it's not an integer, it's a problem */
if (val.typ != VM_INT)
err_throw(VMERR_INT_VAL_REQD);
/* get the result value */
result = val.val.intval;
}
else
{
/* compare the values */
result = val_a.compare_to(vmg_ &val_b);
}
/* if we're sorting in descending order, reverse the result */
if (descending_)
result = -result;
/* return the result */
return result;
}
/* get the storage server URL */
void CVmBifNet::get_storage_url(VMG_ uint oargc)
{
/* check arguments */
check_argc(vmg_ oargc, 1);
/* set a default nil return in case we can't build the path */
retval_nil(vmg0_);
/* get the resource name */
const char *page = G_stk->get(0)->get_as_string(vmg0_);
if (page == 0)
err_throw(VMERR_STRING_VAL_REQD);
/* get the resource name length and buffer pointer */
size_t pagelen = vmb_get_len(page);
page += VMB_LEN;
/* if there's a network configuration, build the resource path */
const char *host = 0, *rootpath = 0;
if (G_net_config != 0)
{
/* get the storage server host name and root path */
host = G_net_config->get("storage.domain");
rootpath = G_net_config->get("storage.rootpath", "/");
}
/* we must have a host name to proceed */
if (host != 0)
{
/* build the full string */
G_interpreter->push_stringf(vmg_ "http://%s%s%.*s",
host, rootpath,
(int)pagelen, page);
/* pop it into R0 */
G_stk->pop(G_interpreter->get_r0());
}
/* discard arguments */
G_stk->discard();
}
/*
* Check the current error count against the maximum error limit, and throw
* a fatal error if we've reached the limit.
*/
void CTcMain::check_error_limit()
{
/* check the error count against the limit */
if (error_count_ > max_error_count_)
{
/*
* raise the maximum error count a bit so that we don't encounter
* another maximum error situation and loop on flagging the
* too-many-errors error while trying to display a too-many-errors
* error
*/
max_error_count_ = error_count_ + 100;
/* display a message explaining the problem */
log_error(G_tok->get_last_desc(), G_tok->get_last_linenum(),
TC_SEV_FATAL, TCERR_TOO_MANY_ERRORS);
/* throw the generic fatal error, since we've logged this */
err_throw(TCERR_FATAL_ERROR);
}
}
/* set a property */
void CVmObjClass::set_prop(VMG_ CVmUndo *undo,
vm_obj_id_t self, vm_prop_id_t prop,
const vm_val_t *val)
{
/* try treating the request as a static property of the metaclass */
vm_meta_entry_t *entry = get_meta_entry(vmg0_);
if (entry != 0
&& entry->meta_->set_stat_prop(
vmg_ undo, self, &get_ext()->class_state, prop, val))
return;
/* the class doesn't handle it, so check for a modifier object */
vm_obj_id_t mod_obj = get_mod_obj();
if (mod_obj != VM_INVALID_OBJ)
{
/* we have a modifier - set the property in the modifier */
vm_objp(vmg_ mod_obj)->set_prop(vmg_ undo, mod_obj, prop, val);
}
else
{
/* if we don't have a modifier, we can't set the property */
err_throw(VMERR_INVALID_SETPROP);
}
}
/*
* Execute an image file. If an exception occurs, we'll display a
* message on the console, and we'll return the error code; we'll return
* zero on success. If an error occurs, we'll fill in 'errbuf' with a
* message describing the problem.
*/
int vm_run_image(CVmMainClientIfc *clientifc,
const char *image_file_name,
class CVmHostIfc *hostifc,
const char *const *prog_argv, int prog_argc,
const char *script_file, int script_quiet,
const char *log_file, const char *cmd_log_file,
int load_from_exe, int show_banner,
const char *charset, const char *log_charset,
const char *saved_state, const char *res_dir)
{
CVmFile *fp = 0;
CVmImageLoader *volatile loader = 0;
CVmImageFile *volatile imagefp = 0;
unsigned long image_file_base = 0;
int retval;
vm_globals *vmg__;
/* presume we will return success */
retval = 0;
/* create the file object */
fp = new CVmFile();
/* initialize the VM */
vm_init_options opts(hostifc, clientifc, charset, log_charset);
vm_initialize(&vmg__, &opts);
/* tell the client system to initialize */
clientifc->client_init(VMGLOB_ADDR, script_file, script_quiet,
log_file, cmd_log_file,
show_banner ? T3VM_BANNER_STRING : 0);
/* catch any errors that occur during loading and running */
err_try
{
/* remember the name of the byte-code file */
strncpy(G_os_gamename, image_file_name, sizeof(G_os_gamename));
G_os_gamename[sizeof(G_os_gamename) - 1] = '\0';
if (load_from_exe)
{
osfildef *exe_fp;
/* find the image within the executable */
exe_fp = os_exeseek(image_file_name, "TGAM");
if (exe_fp == 0)
err_throw(VMERR_NO_IMAGE_IN_EXE);
/*
* set up to read from the executable at the location of the
* embedded image file that we just found
*/
image_file_base = osfpos(exe_fp);
fp->set_file(exe_fp, image_file_base);
}
else
{
/* reading from a normal file - open the file */
fp->open_read(image_file_name, OSFTT3IMG);
}
/* create the loader */
imagefp = new CVmImageFileExt(fp);
loader = new CVmImageLoader(imagefp, image_file_name,
image_file_base);
/* load the image */
loader->load(vmg0_);
/* if we have a resource root path, tell the host interface */
if (res_dir != 0)
hostifc->set_res_dir(res_dir);
/* let the client prepare for execution */
clientifc->pre_exec(VMGLOB_ADDR);
/* run the program from the main entrypoint */
loader->run(vmg_ prog_argv, prog_argc, 0, saved_state);
/* tell the client we're done with execution */
clientifc->post_exec(VMGLOB_ADDR);
}
err_catch(exc)
{
char errbuf[512];
/* tell the client execution failed due to an error */
clientifc->post_exec_err(VMGLOB_ADDR);
/* note the error code for returning to the caller */
retval = exc->get_error_code();
/* get the message for the error */
CVmRun::get_exc_message(vmg_ exc, errbuf, sizeof(errbuf), TRUE);
/* display the message */
clientifc->display_error(VMGLOB_ADDR, errbuf, FALSE);
}
err_end;
/* unload the image */
if (loader != 0)
loader->unload(vmg0_);
/* delete the loader and the image file object */
if (loader != 0)
delete loader;
if (imagefp != 0)
delete imagefp;
/* notify the client */
clientifc->client_terminate(VMGLOB_ADDR);
/* terminate the VM */
vm_terminate(vmg__, clientifc);
/* delete the file */
if (fp != 0)
delete fp;
/* return the status code */
return retval;
}
/*
* Look up a named argument. If 'mandatory' is set, we throw an error if
* we can't find a resolution.
*/
void CVmBifT3::get_named_arg(VMG_ uint argc)
{
/* check arguments */
check_argc_range(vmg_ argc, 1, 2);
/* get the name we're looking for */
const char *name = G_stk->get(0)->get_as_string(vmg0_);
if (name == 0)
err_throw(VMERR_STRING_VAL_REQD);
/* get the length and buffer pointer */
size_t namelen = vmb_get_len(name);
name += VMB_LEN;
/*
* Scan the stack for named parameter tables. A named parameter table
* is always in the calling frame at the stack slot just beyond the
* last argument.
*/
for (vm_val_t *fp = G_interpreter->get_frame_ptr() ; fp != 0 ;
fp = G_interpreter->get_enclosing_frame_ptr(vmg_ fp))
{
/* check for a table in this frame */
vm_val_t *argp;
const uchar *t = CVmRun::get_named_args_from_frame(vmg_ fp, &argp);
if (t != 0)
{
/* get the number of table entries */
int n = osrp2(t);
t += 2;
/* scan the table for the name */
for (int i = 0 ; n >= 0 ; --n, i += 2, ++argp)
{
/* get this element's offset, and figure its length */
uint eofs = osrp2(t + i);
uint elen = osrp2(t + i + 2) - eofs;
/* check for a match */
if (elen == namelen && memcmp(name, t + eofs, elen) == 0)
{
/* found it - return the value */
retval(vmg_ argp);
/* discard arguments and return */
G_stk->discard(argc);
return;
}
}
}
}
/*
* The argument is undefined. If a default value was supplied, simply
* return the default value. Otherwise throw an error.
*/
if (argc >= 2)
{
/* a default value was supplied - simply return it */
retval(vmg_ G_stk->get(1));
/* discard arguments */
G_stk->discard(argc);
}
else
{
/* no default value - throw an error */
err_throw_a(VMERR_MISSING_NAMED_ARG, 1, ERR_TYPE_TEXTCHAR_LEN,
name, namelen);
}
}
void CVmBifT3::set_say(VMG_ uint argc)
{
vm_val_t *arg = G_stk->get(0);
vm_val_t val;
/* one argument is required */
check_argc(vmg_ argc, 1);
/* check to see if we're setting the default display method */
if (arg->typ == VM_PROP
|| (arg->typ == VM_INT && arg->val.intval == SETSAY_NO_METHOD))
{
vm_prop_id_t prop;
/*
* the return value is the old property pointer (or
* SETSAY_NO_METHOD if there was no valid property set previously)
*/
prop = G_interpreter->get_say_method();
if (prop != VM_INVALID_PROP)
retval_prop(vmg_ prop);
else
retval_int(vmg_ SETSAY_NO_METHOD);
/* get the new value */
G_stk->pop(&val);
/* if it's SETSAY_NO_METHOD, set it to the invalid prop ID */
if (val.typ == VM_INT)
val.set_propid(VM_INVALID_PROP);
/* set the method */
G_interpreter->set_say_method(val.val.prop);
}
else if (arg->typ == VM_FUNCPTR
|| arg->typ == VM_OBJ
|| arg->typ == VM_BIFPTR
|| (arg->typ == VM_INT && arg->val.intval == SETSAY_NO_FUNC))
{
/*
* the return value is the old function (or SETSAY_NO_FUNC if the
* old function was nil)
*/
G_interpreter->get_say_func(&val);
if (val.typ != VM_NIL)
retval(vmg_ &val);
else
retval_int(vmg_ SETSAY_NO_FUNC);
/* get the new function value */
G_stk->pop(&val);
/* if it's SETSAY_NO_FUNC, set the function to nil */
if (val.typ == VM_INT)
val.set_nil();
/* set the new function */
G_interpreter->set_say_func(vmg_ &val);
}
else
{
/* invalid type */
err_throw(VMERR_BAD_TYPE_BIF);
}
}
