示例#1
0
/*
 *   get the runtime symbol table 
 */
void CVmBifT3::get_global_symtab(VMG_ uint argc)
{
    /* check arguments */
    check_argc_range(vmg_ argc, 0, 1);

    /* if there's an argument, it specifies which table to retrieve */
    int which = 1;
    if (argc >= 1)
        which = pop_int_val(vmg0_);

    /* return the desired table */
    switch (which)
    {
    case 1:
        /* return the loader's symbol table object, if any */
        retval_obj(vmg_ G_image_loader->get_reflection_symtab());
        break;

    case 2:
        /* return the macro table, if any */
        retval_obj(vmg_ G_image_loader->get_reflection_macros());
        break;

    case 3:
        /* other values are allowed but simply return nil */
        retval_nil(vmg0_);
        break;
    }
}
示例#2
0
void CVmBifT3::get_stack_trace(VMG_ uint argc)
{
    int single_level = 0;
    int level;
    vm_val_t *fp;
    vm_val_t lst_val;
    CVmObjList *lst;
    const uchar *entry_addr;
    ulong method_ofs;
    vm_val_t stack_info_cls;
    int want_named_args = FALSE;
    int want_locals = FALSE;
    int want_frefs = FALSE;
    int flags = 0;
    const vm_rcdesc *rc;

    /* check arguments */
    check_argc_range(vmg_ argc, 0, 2);

    /* get the imported stack information class */
    stack_info_cls.set_obj(G_predef->stack_info_cls);
    if (stack_info_cls.val.obj == VM_INVALID_OBJ)
    {
        /* 
         *   there's no stack information class - we can't return any
         *   meaningful information, so just return nil 
         */
        retval_nil(vmg0_);
        return;
    }

    /* 
     *   look up T3StackInfo.construct() to determine how many arguments it
     *   wants 
     */
    {
        int min_args, opt_args, varargs;
        if (vm_objp(vmg_ stack_info_cls.val.obj)->get_prop_interface(
            vmg_ stack_info_cls.val.obj, G_predef->obj_construct,
            min_args, opt_args, varargs))
        {
            /* check to see how many extra arguments they want */
            want_named_args = (min_args + opt_args >= 7 || varargs);
            want_locals = (min_args + opt_args >= 8 || varargs);
            want_frefs = (min_args + opt_args >= 9 || varargs);
        }
    }

    /* check to see if we're fetching a single level or the full trace */
    if (argc >= 1)
    {
        /* 
         *   Get the single level, and adjust to a 0 base.  If the level is
         *   nil, we're still getting all levels. 
         */
        if (G_stk->get(0)->typ == VM_NIL)
        {
            /* it's nil - get all levels */
            G_stk->discard();
        }
        else
        {
            /* get the level number */
            single_level = pop_int_val(vmg0_);

            /* make sure it's in range */
            if (single_level <= 0)
                err_throw(VMERR_BAD_VAL_BIF);
            
            /* we won't need a return list */
            lst_val.set_obj_or_nil(VM_INVALID_OBJ);
            lst = 0;
        }
    }

    /* get the flags argument, if present */
    if (argc >= 2)
        flags = pop_int_val(vmg0_);

    /* if we're not doing a single level, we need a list for the result */
    if (!single_level)
    {
        /* 
         *   We're returning a full list, so we need to allocate the list for
         *   the return value.  First, count stack levels to see how big a
         *   list we'll need.  
         */
        fp = G_interpreter->get_frame_ptr();
        entry_addr = G_interpreter->get_entry_ptr();
        method_ofs = G_interpreter->get_method_ofs();
        for (level = 0 ; fp != 0 ;
             fp = G_interpreter->get_enclosing_frame_ptr(vmg_ fp), ++level)
        {
            /* add an extra level for each system call */
            if (method_ofs == 0 && entry_addr != 0)
                ++level;

            /* get the return address */
            entry_addr =
                G_interpreter->get_enclosing_entry_ptr_from_frame(vmg_ fp);
            method_ofs = G_interpreter->get_return_ofs_from_frame(vmg_ fp);
        }

        /* create the list */
        lst_val.set_obj(CVmObjList::create(vmg_ FALSE, level));
        lst = (CVmObjList *)vm_objp(vmg_ lst_val.val.obj);

        /* 
         *   we create other objects while building this list, so the gc
         *   could run - clear the list to ensure it contains valid data 
         */
        lst->cons_clear();
        
        /* protect the list from garbage collection while we work */
        G_stk->push(&lst_val);

        /* flag that we're doing the whole stack */
        single_level = -1;
    }
    else
    {
        /* adjust the level to a 0-based index */
        single_level -= 1;
    }

    /* set up at the current function */
    fp = G_interpreter->get_frame_ptr();
    entry_addr = G_interpreter->get_entry_ptr();
    method_ofs = G_interpreter->get_method_ofs();
    rc = 0;

    /* traverse the frames */
    for (level = 0 ; fp != 0 ; ++level)
    {
        int fr_argc;
        int i;
        vm_obj_id_t def_obj;
        vm_val_t info_self;
        vm_val_t info_func;
        vm_val_t info_obj;
        vm_val_t info_prop;
        vm_val_t info_args;
        vm_val_t info_locals;
        vm_val_t info_srcloc;
        vm_val_t info_frameref;
        CVmObjList *arglst;
        vm_val_t ele;
        CVmFuncPtr func_ptr;
        int gc_cnt = 0;
        int info_argc = 0;

        /* if we're looking for a single level, and this isn't it, skip it */
        if (single_level >= 0 && level != single_level)
            goto done_with_level;
       
        /* 
         *   start with the information values to nil - we'll set the
         *   appropriate ones when we find out what we have 
         */
        info_func.set_nil();
        info_obj.set_nil();
        info_prop.set_nil();
        info_self.set_nil();
        info_locals.set_nil();
        info_frameref.set_nil();

        /* get the number of arguments to the function in this frame */
        fr_argc = G_interpreter->get_argc_from_frame(vmg_ fp);

        /* set up a function pointer for the method's entry address */
        func_ptr.set(entry_addr);

        /* get the current frame's defining object */
        def_obj = G_interpreter->get_defining_obj_from_frame(vmg_ fp);

        /* check for special method offsets */
        switch (method_ofs)
        {
        case VMRUN_RET_OP:
            /* the real return address is one past the last argument */
            method_ofs = G_interpreter->get_param_from_frame(vmg_ fp, argc)
                         ->val.intval;
            break;

        case VMRUN_RET_OP_ASILCL:
            /* the real return address is two past the last argument */
            method_ofs = G_interpreter->get_param_from_frame(vmg_ fp, argc+1)
                         ->val.intval;
            break;
        }

        /* determine whether it's an object.prop or a function call */
        if (method_ofs == 0)
        {
            /* 
             *   A zero method offset indicates a recursive VM invocation
             *   from a native function.  Presume we have no information on
             *   the caller.  
             */
            info_self.set_nil();
            fr_argc = 0;

            /* check for a native caller context */
            if (rc != 0)
            {
                /* check which kind of native caller we have */
                if (rc->bifptr.typ != VM_NIL)
                {
                    /* we have a built-in function at this level */
                    info_func = rc->bifptr;
                }
                else if (rc->self.typ != VM_NIL)
                {
                    /* it's an intrinsic class method - get the 'self' */
                    info_obj = info_self = rc->self;

                    /* get the metaclass */
                    CVmMetaclass *mc;
                    switch (info_obj.typ)
                    {
                    case VM_OBJ:
                        /* get the metaclass from the object */
                        mc = vm_objp(vmg_ info_obj.val.obj)
                             ->get_metaclass_reg();
                        break;

                    case VM_LIST:
                        /* list constant - use the List metaclass */
                        mc = CVmObjList::metaclass_reg_;
                        break;

                    case VM_SSTRING:
                        /* string constant - use the String metaclass */
                        mc = CVmObjString::metaclass_reg_;
                        break;

                    default:
                        /* other types don't have metaclasses */
                        mc = 0;
                        break;
                    }

                    /* get the registration table entry */
                    vm_meta_entry_t *me =
                        mc == 0 ? 0 :
                        G_meta_table->get_entry_from_reg(mc->get_reg_idx());

                    /* get the metaclass and property from the entry */
                    if (me != 0)
                    {
                        /* set 'obj' to the IntrinsicClass object */
                        info_obj.set_obj(me->class_obj_);

                        /* get the property ID */
                        info_prop.set_propid(me->xlat_func(rc->method_idx));
                    }
                }
            }
        }
        else if (def_obj == VM_INVALID_OBJ)
        {
            /* there's no defining object, so this is a function call */
            func_ptr.get_fnptr(vmg_ &info_func);
        }
        else
        {
            /* it's an object.prop invocation */
            info_obj.set_obj(def_obj); // $$$ walk up to base modified obj?
            info_prop.set_propid(
                G_interpreter->get_target_prop_from_frame(vmg_ fp));

            /* get the 'self' in this frame */
            info_self.set_obj(G_interpreter->get_self_from_frame(vmg_ fp));
        }

        /* 
         *   build the argument list and source location, except for system
         *   routines 
         */
        if (method_ofs != 0 || rc != 0)
        {
            /* allocate a list object to store the argument list */
            int ac = (rc != 0 ? rc->argc : fr_argc);
            info_args.set_obj(CVmObjList::create(vmg_ FALSE, ac));
            arglst = (CVmObjList *)vm_objp(vmg_ info_args.val.obj);
            
            /* push the argument list for gc protection */
            G_stk->push(&info_args);
            ++gc_cnt;
            
            /* build the argument list */
            for (i = 0 ; i < ac ; ++i)
            {
                /* add this element to the argument list */
                const vm_val_t *v =
                    (rc != 0
                     ? rc->argp - i
                     : G_interpreter->get_param_from_frame(vmg_ fp, i));
                arglst->cons_set_element(i, v);
            }

            /* get the source location */
            get_source_info(vmg_ entry_addr, method_ofs, &info_srcloc);

            /* 
             *   if they want locals, and this isn't a recursive native
             *   caller, retrieve them 
             */
            if (rc == 0
                && (((flags & T3_GST_LOCALS) != 0 && want_locals)
                    || ((flags & T3_GST_FREFS) != 0 && want_frefs)))
            {
                /* get the locals */
                get_stack_locals(vmg_ fp, entry_addr, method_ofs,
                                 (flags & T3_GST_LOCALS) != 0 && want_locals
                                 ? &info_locals : 0,
                                 (flags & T3_GST_FREFS) != 0 && want_frefs
                                 ? &info_frameref : 0);

                /* 
                 *   that leaves the LookupTable and StackFrameDesc on the
                 *   stack, so note that we need to discard the stack level
                 *   when we're done with it 
                 */
                if (info_locals.typ == VM_OBJ)
                    ++gc_cnt;
                if (info_frameref.typ == VM_OBJ)
                    ++gc_cnt;
            }
        }
        else
        {
            /* 
             *   it's a system routine - no argument information is
             *   available, so return nil rather than an empty list to to
             *   indicate the absence 
             */
            info_args.set_nil();

            /* there's obviously no source location for system code */
            info_srcloc.set_nil();
        }

        /* 
         *   We have all of the information on this level now, so create the
         *   information object for the level.  This is an object of the
         *   exported stack-info class, which is a TadsObject type.  
         */

        /* start with the original complement of arguments */
        info_argc = 7;

        /* 
         *   if we have a modern T3StackInfo object, push the locals,
         *   named argument elements, and frame reference object
         */
        if (want_frefs)
        {
            G_stk->push(&info_frameref);
            ++info_argc;
        }
        if (want_named_args)
        {
            /* 
             *   the constructor has a slot for named arguments - push either
             *   a table or nil, depending...
             */
            vm_val_t *argp;
            const uchar *t = 0;

            /* if the flags request locals, retrieve the named arguments */
            if ((flags & T3_GST_LOCALS) != 0)
                t = CVmRun::get_named_args_from_frame(vmg_ fp, &argp);

            /* 
             *   if we do in fact have named arguments, build a lookup table
             *   copy and push it; otherwise just push nil 
             */
            if (t != 0)
            {
                /* get the number of table entries */
                int n = osrp2(t);
                t += 2;
                
                /* create a lookup table for the arguments */
                G_stk->push()->set_obj(CVmObjLookupTable::create(
                    vmg_ FALSE, n <= 8 ? 8 : n <= 32 ? 32 : 64, n));
                CVmObjLookupTable *lt = (CVmObjLookupTable *)vm_objp(
                    vmg_ G_stk->get(0)->val.obj);
                
                /* 
                 *   Populate the lookup table with the named arguments.  The
                 *   compiler builds the table in the order pushed, which is
                 *   right to left.  Lookup tables preserve the order in
                 *   which elements are added, and reflect this order in key
                 *   lists, so to that extent the order of building the
                 *   lookup table matters.  For readability of the generated
                 *   list, in case it's presented to the user, build the
                 *   table in left-to-right order, which is the reverse of
                 *   the table order in the bytecode table.  
                 */
                argp += n - 1;
                for (int i = (n-1)*2 ; i >= 0 ; i -= 2, --argp)
                {
                    /* get the name pointer and length from the index */
                    uint ofs = osrp2(t + i), nxtofs = osrp2(t + i + 2);
                    const char *name = (const char *)t + ofs;
                    size_t len = nxtofs - ofs;
                    
                    /* create a string from the name */
                    vm_val_t str;
                    str.set_obj(CVmObjString::create(vmg_ FALSE, name, len));
                    
                    /* add it to the table */
                    lt->add_entry(vmg_ &str, argp);
                }
            }
            else
            {
                /* there are no named arguments - push nil */
                G_stk->push()->set_nil();
            }

            /* count the argument */
            ++info_argc;
        }
        if (want_locals)
        {
            G_stk->push(&info_locals);
            ++info_argc;
        }

        /* push the rest of the arguments */
        G_stk->push(&info_srcloc);
        G_stk->push(&info_args);
        G_stk->push(&info_self);
        G_stk->push(&info_prop);
        G_stk->push(&info_obj);
        G_stk->push(&info_func);
        G_stk->push(&stack_info_cls);
        ele.set_obj(CVmObjTads::create_from_stack(vmg_ 0, info_argc));

        /* discard the gc protection items */
        G_stk->discard(gc_cnt);

        /* 
         *   if we're fetching a single level, this is it - return the new
         *   stack info object and we're done
         */
        if (single_level >= 0)
        {
            /* return the single level object */
            retval_obj(vmg_ ele.val.obj);

            /* we're done */
            return;
        }

        /* add the new element to our list */
        lst->cons_set_element(level, &ele);

    done_with_level:
        /*
         *   If this is a system call level, and we're not in debug mode,
         *   this recursive frame contains the entry address for the caller,
         *   but not the calling byte-code address.  Stay on the current
         *   level in this case.  
         */
        if (method_ofs == 0 && entry_addr != 0)
        {
            /* 
             *   This is a recursive caller, and we have a valid entry
             *   address for the prior frame.  Stay in the current frame, and
             *   retrieve the actual return address from the calling frame.  
             */
            if (rc != 0)
            {
                /* get the actual return address from the recursive context */
                method_ofs = rc->return_addr - entry_addr;

                /* 
                 *   we're now in the bytecode part of the frame, so forget
                 *   the recursive context 
                 */
                rc = 0;
            }
            else
            {
                /* no recursive context - use a fake return address */
                method_ofs = G_interpreter->get_funchdr_size();
            }
        }
        else
        {
            /* move up to the enclosing frame */
            entry_addr =
                G_interpreter->get_enclosing_entry_ptr_from_frame(vmg_ fp);
            method_ofs = G_interpreter->get_return_ofs_from_frame(vmg_ fp);
            rc = G_interpreter->get_rcdesc_from_frame(vmg_ fp);
            fp = G_interpreter->get_enclosing_frame_ptr(vmg_ fp);
        }
    }

    /* return the list */
    retval_obj(vmg_ lst_val.val.obj);

    /* discard our gc protection */
    G_stk->discard();
}
示例#3
0
/*
 *   Show a popup menu 
 */
void CVmBifTIOExt::show_popup_menu(VMG_ uint argc)
{
    int x, y, default_pos;
    char *txt;
    os_event_info_t evt;
    int ret;
    int elecnt;
    vm_obj_id_t lst_obj;
    CVmObjList *lst;
    vm_val_t val;
    
    /* check arguments */
    check_argc(vmg_ argc, 3);

    /* get the x,y coordinates */
    if (G_stk->get(0)->typ == VM_NIL)
    {
        /* nil x,y - use default position */
        default_pos = TRUE;
        x = y = 0;

        /* discard the nil x,y values */
        G_stk->discard(2);
    }
    else
    {
        /* pop the x,y positions */
        x = pop_int_val(vmg0_);
        y = pop_int_val(vmg0_);
    }

    /* get the HTML text for the contents of the window */
    txt = pop_str_val_ui(vmg_ 0, 0);

    /* flush the console display output */
    G_console->flush_all(vmg_ VM_NL_NONE);

    /* show the window */
    ret = os_show_popup_menu(default_pos, x, y, txt, strlen(txt), &evt);

    /* free the HTML text buffer we allocated */
    t3free(txt);

    /* see what we have */
    switch (ret)
    {
    case OSPOP_FAIL:
    case OSPOP_CANCEL:
    case OSPOP_EOF:
    default:
        elecnt = 1;
        break;

    case OSPOP_HREF:
        elecnt = 2;
        break;
    }

    /* allocate the return list */
    lst_obj = CVmObjList::create(vmg_ FALSE, elecnt);
    lst = (CVmObjList *)vm_objp(vmg_ lst_obj);
    lst->cons_clear();

    /* protect the list from garbage collection */
    val.set_obj(lst_obj);
    G_stk->push(&val);

    /* set the first element to the main return code */
    val.set_int(ret);
    lst->cons_set_element(0, &val);

    /* set additional elements according to the return code */
    switch (ret)
    {
    case OSPOP_HREF:
        /* add the HREF element */
        val.set_obj(str_from_ui_str(vmg_ evt.href));
        lst->cons_set_element(1, &val);
        break;

    default:
        /* there aren't any other elements for other return codes */
        break;
    }

    /* return the list */
    retval_obj(vmg_ lst_obj);

    /* discard the GC protection */
    G_stk->discard();
}
示例#4
0
/*
 *   Get a network event
 */
void CVmBifNet::get_event(VMG_ uint oargc)
{
    /* check arguments */
    check_argc_range(vmg_ oargc, 0, 1);

    /* get the timeout, if present */
    long timeout = OS_FOREVER;
    if (oargc >= 1)
    {
        if (G_stk->get(0)->typ == VM_NIL)
            G_stk->discard();
        else
            timeout = pop_int_val(vmg0_);
    }

    /* we don't know the NetEvent subclass yet, so presume the base class */
    vm_obj_id_t ev_cl = G_predef->net_event;
    int argc;

    /* get the next message */
    TadsMessage *msg = 0;
    int wret = G_net_queue->wait(vmg_ timeout, &msg);

    /* cast the message */
    TadsEventMessage *evtmsg = cast_tads_message(TadsEventMessage, msg);

    /* make sure we release the message before exiting */
    err_try
    {
        /* check the wait result */
        const char *err;
        switch (wret)
        {
        case OSWAIT_EVENT + 0:
            /* we got a message */
            if (evtmsg != 0)
            {
                /* ask the message to set up a new NetRequestEvent */
                int evt_code;
                ev_cl = evtmsg->prep_event_obj(vmg_ &argc, &evt_code);
            
                /* add the event type argument */
                G_interpreter->push_int(vmg_ evt_code);
                ++argc;
            }
            else
            {
                /* unrecognized message type */
                err = "getNetEvent(): unexpected message type in queue";
                goto evt_error;
            }
            break;

        case OSWAIT_EVENT + 1:
            /* 'quit' event - return an error */
            err = "getNetEvent(): queue terminated";
            goto evt_error;

        case OSWAIT_EVENT + 2:
            /* debug break - return a NetEvent with the interrupt code */
            argc = 1;
            G_interpreter->push_int(vmg_ VMBN_EVT_DBGBRK);
            break;
            
        case OSWAIT_TIMEOUT:
            /* the timeout expired - return a NetTimeoutEvent */
            ev_cl = G_predef->net_timeout_event;
            argc = 1;
            G_interpreter->push_int(vmg_ VMBN_EVT_TIMEOUT);
            break;

        case OSWAIT_ERROR:
        default:
            /* the wait failed */
            err = "getNetEvent(): error waiting for request message";

        evt_error:
            /* on error, throw a NetException describing the problem */
            G_interpreter->push_string(vmg_ err);
            G_interpreter->throw_new_class(
                vmg_ G_predef->net_exception, 1, err);
            AFTER_ERR_THROW(break;)
        }
        
        /* 
         *   if the specific event type subclass isn't defined, fall back on
         *   the base NetEvent class 
         */
        if (ev_cl == VM_INVALID_OBJ)
            ev_cl = G_predef->net_event;

        /* 
         *   construct the NetEvent subclass, or a generic list if we don't
         *   even have the NetEvent class defined 
         */
        if (ev_cl != VM_INVALID_OBJ)
            vm_objp(vmg_ ev_cl)->create_instance(vmg_ ev_cl, 0, argc);
        else
            retval_obj(vmg_ CVmObjList::create_from_stack(vmg_ 0, argc));
    }
    err_finally
    {
        /* we're done with the message object */
        if (msg != 0)
            msg->release_ref();
    }
    err_end;
}
示例#5
0
/*
 *   readText() - read text from the keyboard and return it as a string.
 */
void CVmBifSample::read_text(VMG_ uint argc)
{
    char buf[128];
    size_t len;
    vm_obj_id_t str_id;
    CVmObjString *str_obj;

    /* check to make sure we have the right number of arguments */
    check_argc(vmg_ argc, 0);

    /*
     *   Read a string from the keyboard.  Use fgets() rather than plain
     *   gets(), because fgets() lets us limit the buffer size and thus avoid
     *   any chance of a buffer overflow.  (Someone should tell the people at
     *   Microsoft about this - it would probably cut out about eighty
     *   percent of those emergency internet security alerts that require
     *   everyone to download an IE patch every couple of weeks. :)
     */
    fgets(buf, sizeof(buf), stdin);

    /*
     *   One small detail about fgets: if the input ended with a newline,
     *   there will be a newline in the buffer.  Remove it if it's there.
     */
    if ((len = strlen(buf)) != 0 && buf[len - 1] == '\n')
        buf[len-1] = '\0';

    /*
     *   As in display_text(), we have to deal with character set mapping
     *   before we can send the string back to the TADS program.  This time,
     *   we want to perform the conversion from the local character set to
     *   Unicode.  Again, T3 provides a handy conversion object for our
     *   convenience - this time, it's called G_cmap_from_ui.
     *
     *   In order to return a string to the TADS program, we have to allocate
     *   a new string object.  First, let's see how big a string we need to
     *   allocate, by calling the character mapper with no buffer space at
     *   all - the mapper will run through the string and check to see how
     *   big it will be after conversion, but it won't actually store
     *   anything.
     */
    len = G_cmap_from_ui->map_str(0, 0, buf);

    /*
     *   Allocate a new string to contain the return value.  This gives us
     *   back an "object ID" value, which we can convert into an internal C++
     *   string object pointer using the vm_objp() formula shown.
     */
    str_id = CVmObjString::create(vmg_ FALSE, len);
    str_obj = (CVmObjString *)vm_objp(vmg_ str_id);

    /*
     *   The string object has a buffer of the size we requested, which is
     *   the size we already know we need to contain the mapped string.  So,
     *   we can call the mapper again to have it perform the actual mapping
     *   into our string buffer.
     */
    G_cmap_from_ui->map_str(str_obj->cons_get_buf(), len, buf);

    /*
     *   One last step: we must return the string object to the caller.  To
     *   do this, use the retval_obj() function to return the ID of the
     *   string object.
     */
    retval_obj(vmg_ str_id);
}