*/ REBSER *List_Func_Types(REBVAL *func) /* ** Return a block of function arg types. ** Note: skips 0th entry. ** ***********************************************************************/ { REBSER *block; REBSER *words = VAL_FUNC_WORDS(func); REBCNT n; REBVAL *value; REBVAL *word; block = Make_Block(SERIES_TAIL(words)); word = BLK_SKIP(words, 1); for (n = 1; n < SERIES_TAIL(words); word++, n++) { value = Alloc_Tail_Blk(block); VAL_SET(value, VAL_TYPE(word)); VAL_WORD_SYM(value) = VAL_BIND_SYM(word); UNBIND(value); } return block; }
static REBOOL Same_Func(REBVAL *val, REBVAL *arg) { if (VAL_TYPE(val) == VAL_TYPE(arg) && VAL_FUNC_SPEC(val) == VAL_FUNC_SPEC(arg) && VAL_FUNC_WORDS(val) == VAL_FUNC_WORDS(arg) && VAL_FUNC_CODE(val) == VAL_FUNC_CODE(arg)) return TRUE; return FALSE; }
*/ void Get_Var_Into_Core(REBVAL *out, const REBVAL *word) /* ** Variant of Get_Var_Core that always traps and never returns a ** direct pointer into a frame. It is thus able to give back ** `self` lookups, and doesn't have to check the word's protection ** status before returning. ** ** See comments in Get_Var_Core for what it's actually doing. ** ***********************************************************************/ { REBSER *context = VAL_WORD_FRAME(word); if (context) { REBINT index = VAL_WORD_INDEX(word); if (index > 0) { *out = *(FRM_VALUES(context) + index); assert(!IS_TRASH(out)); assert(!THROWN(out)); return; } if (index < 0) { struct Reb_Call *call = DSF; while (call) { if ( call->args_ready && context == VAL_FUNC_WORDS(DSF_FUNC(call)) ) { assert(!IS_CLOSURE(DSF_FUNC(call))); *out = *DSF_ARG(call, -index); assert(!IS_TRASH(out)); assert(!THROWN(out)); return; } call = PRIOR_DSF(call); } raise Error_1(RE_NO_RELATIVE, word); } // Key difference between Get_Var_Into and Get_Var...fabricating // an object REBVAL. // !!! Could fake function frames stow the function value itself // so 'binding-of' can return it and use for binding (vs. TRUE)? assert(!IS_SELFLESS(context)); Val_Init_Object(out, context); return; } raise Error_1(RE_NOT_DEFINED, word); }
*/ void Do_Commands(REBSER *cmds, void *context) /* ** Evaluate a block of commands as efficiently as possible. ** The arguments to each command must already be reduced or ** use only variable lookup. ** ** Returns the last evaluated value, if provided. ** ***********************************************************************/ { REBVAL *blk; REBCNT index = 0; REBVAL *set_word = 0; REBVAL *cmd_word; REBSER *words; REBVAL *args; REBVAL *val; REBVAL *func; RXIFRM frm; // args stored here REBCNT n; REBEXT *ext; REBCEC *ctx; if ((ctx = context)) ctx->block = cmds; blk = BLK_HEAD(cmds); while (NOT_END(blk)) { // var: command result if IS_SET_WORD(blk) { set_word = blk++; index++; }; // get command function if (IS_WORD(cmd_word = blk)) { // Optimized var fetch: n = VAL_WORD_INDEX(blk); if (n > 0) func = FRM_VALUES(VAL_WORD_FRAME(blk)) + n; else func = Get_Var(blk); // fallback } else func = blk; if (!IS_COMMAND(func)) Trap2(RE_EXPECT_VAL, Get_Type_Word(REB_COMMAND), blk); // Advance to next value blk++; if (ctx) ctx->index = index; // position of function index++; // get command arguments and body words = VAL_FUNC_WORDS(func); RXA_COUNT(&frm) = SERIES_TAIL(VAL_FUNC_ARGS(func))-1; // not self // collect each argument (arg list already validated on MAKE) n = 0; for (args = BLK_SKIP(words, 1); NOT_END(args); args++) { //Debug_Type(args); val = blk++; index++; if (IS_END(val)) Trap2(RE_NO_ARG, cmd_word, args); //Debug_Type(val); // actual arg is a word, lookup? if (VAL_TYPE(val) >= REB_WORD) { if (IS_WORD(val)) { if (IS_WORD(args)) val = Get_Var(val); } else if (IS_PATH(val)) { if (IS_WORD(args)) val = Get_Any_Var(val); // volatile value! } else if (IS_PAREN(val)) { val = Do_Blk(VAL_SERIES(val), 0); // volatile value! } // all others fall through } // check datatype if (!TYPE_CHECK(args, VAL_TYPE(val))) Trap3(RE_EXPECT_ARG, cmd_word, args, Of_Type(val)); // put arg into command frame n++; RXA_TYPE(&frm, n) = Reb_To_RXT[VAL_TYPE(val)]; frm.args[n] = Value_To_RXI(val); } // Call the command (also supports different extension modules): func = BLK_HEAD(VAL_FUNC_BODY(func)); n = (REBCNT)VAL_INT64(func + 1); ext = &Ext_List[VAL_I32(VAL_OBJ_VALUE(func, 1))]; // Handler n = ext->call(n, &frm, context); val = DS_RETURN; switch (n) { case RXR_VALUE: RXI_To_Value(val, frm.args[1], RXA_TYPE(&frm, 1)); break; case RXR_BLOCK: RXI_To_Block(&frm, val); break; case RXR_UNSET: SET_UNSET(val); break; case RXR_NONE: SET_NONE(val); break; case RXR_TRUE: SET_TRUE(val); break; case RXR_FALSE: SET_FALSE(val); break; case RXR_ERROR: default: SET_UNSET(val); } if (set_word) { Set_Var(set_word, val); set_word = 0; } } }
x*/ int Do_Callback(REBSER *obj, u32 name, RXIARG *args, RXIARG *result) /* ** Given an object and a word id, call a REBOL function. ** The arguments are converted from extension format directly ** to the data stack. The result is passed back in ext format, ** with the datatype returned or zero if there was a problem. ** ***********************************************************************/ { REBVAL *val; REBCNT dsf; REBCNT len; REBCNT n; REBCNT dsp = DSP; // to restore stack on errors // Find word in object, verify it is a function. if (!(val = Find_Word_Value(obj, name))) { SET_EXT_ERROR(result, RXE_NO_WORD); return 0; } if (!ANY_FUNC(val)) { SET_EXT_ERROR(result, RXE_NOT_FUNC); return 0; } // Get block and index from prior function stack frame: dsf = PRIOR_DSF(DSF); // Create stack frame (use prior stack frame for location info): dsf = Push_Func(0, VAL_SERIES(DSF_BACK(dsf)), VAL_INDEX(DSF_BACK(dsf)), name, val); val = DSF_FUNC(dsf); // for safety from GC obj = VAL_FUNC_WORDS(val); // func words len = SERIES_TAIL(obj)-1; // number of args (may include locals) // Push args. Too short or too long arg frames are handled W/O error. // Note that refinements args can be set to anything. for (n = 1; n <= len && n <= RXI_COUNT(args); n++) { DS_SKIP; RXI_To_Value(DS_TOP, args[n], RXI_TYPE(args, n)); // Check type for word at the given offset: if (!TYPE_CHECK(BLK_SKIP(obj, n), VAL_TYPE(DS_TOP))) { result->int32b = n; SET_EXT_ERROR(result, RXE_BAD_ARGS); DSP = dsp; return 0; } } // Fill with NONE if necessary: for (; n <= len; n++) { DS_SKIP; SET_NONE(DS_TOP); if (!TYPE_CHECK(BLK_SKIP(obj, n), VAL_TYPE(DS_TOP))) { result->int32b = n; SET_EXT_ERROR(result, RXE_BAD_ARGS); DSP = dsp; return 0; } } // Evaluate the function: DSF = dsf; Func_Dispatch[VAL_TYPE(val) - REB_NATIVE](val); DSF = PRIOR_DSF(dsf); DSP = dsf-1; // Return resulting value from TOS1 (volatile location): *result = Value_To_RXI(DS_VALUE(dsf)); return Reb_To_RXT[VAL_TYPE(DS_VALUE(dsf))]; }
*/ REBVAL *Get_Var_Core(const REBVAL *word, REBOOL trap, REBOOL writable) /* ** Get the word--variable--value. (Generally, use the macros like ** GET_VAR or GET_MUTABLE_VAR instead of this). This routine is ** called quite a lot and so attention to performance is important. ** ** Coded assuming most common case is trap=TRUE and writable=FALSE ** ***********************************************************************/ { REBSER *context = VAL_WORD_FRAME(word); if (context) { REBINT index = VAL_WORD_INDEX(word); // POSITIVE INDEX: The word is bound directly to a value inside // a frame, and represents the zero-based offset into that series. // This is how values would be picked out of object-like things... // (Including looking up 'append' in the user context.) if (index > 0) { REBVAL *value; if ( writable && VAL_GET_EXT(FRM_WORDS(context) + index, EXT_WORD_LOCK) ) { if (trap) raise Error_1(RE_LOCKED_WORD, word); return NULL; } value = FRM_VALUES(context) + index; assert(!THROWN(value)); return value; } // NEGATIVE INDEX: Word is stack-relative bound to a function with // no persistent frame held by the GC. The value *might* be found // on the stack (or not, if all instances of the function on the // call stack have finished executing). We walk backward in the call // stack to see if we can find the function's "identifying series" // in a call frame...and take the first instance we see (even if // multiple invocations are on the stack, most recent wins) if (index < 0) { struct Reb_Call *call = DSF; // Get_Var could theoretically be called with no evaluation on // the stack, so check for no DSF first... while (call) { if ( call->args_ready && context == VAL_FUNC_WORDS(DSF_FUNC(call)) ) { REBVAL *value; assert(!IS_CLOSURE(DSF_FUNC(call))); if ( writable && VAL_GET_EXT( VAL_FUNC_PARAM(DSF_FUNC(call), -index), EXT_WORD_LOCK ) ) { if (trap) raise Error_1(RE_LOCKED_WORD, word); return NULL; } value = DSF_ARG(call, -index); assert(!THROWN(value)); return value; } call = PRIOR_DSF(call); } if (trap) raise Error_1(RE_NO_RELATIVE, word); return NULL; } // ZERO INDEX: The word is SELF. Although the information needed // to produce an OBJECT!-style REBVAL lives in the zero offset // of the frame, it's not a value that we can return a direct // pointer to. Use GET_VAR_INTO instead for that. assert(!IS_SELFLESS(context)); if (trap) raise Error_0(RE_SELF_PROTECTED); return NULL; // is this a case where we should *always* trap? } if (trap) raise Error_1(RE_NOT_DEFINED, word); return NULL; }