*/ void Do_Command(REBVAL *value) /* ** Evaluates the arguments for a command function and creates ** a resulting stack frame (struct or object) for command processing. ** ** A command value consists of: ** args - same as other funcs ** spec - same as other funcs ** body - [ext-obj func-index] ** ***********************************************************************/ { REBVAL *val = BLK_HEAD(VAL_FUNC_BODY(value)); REBEXT *ext; REBCNT cmd; REBCNT argc; REBCNT n; RXIFRM frm; // args stored here // All of these were checked above on definition: val = BLK_HEAD(VAL_FUNC_BODY(value)); cmd = (int)VAL_INT64(val+1); ext = &Ext_List[VAL_I32(VAL_OBJ_VALUE(val, 1))]; // Handler // Copy args to command frame (array of args): RXA_COUNT(&frm) = argc = SERIES_TAIL(VAL_FUNC_ARGS(value))-1; // not self if (argc > 7) Trap0(RE_BAD_COMMAND); val = DS_ARG(1); for (n = 1; n <= argc; n++, val++) { RXA_TYPE(&frm, n) = Reb_To_RXT[VAL_TYPE(val)]; frm.args[n] = Value_To_RXI(val); } // Call the command: n = ext->call(cmd, &frm, 0); 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); } }
// // RL_Set_Field: C // // Set a field (context variable) of an object. // // Returns: // The type arg, or zero if word not found in object or if field is protected. // Arguments: // obj - object pointer (e.g. from RXA_OBJECT) // word_id - global word identifier (integer) // val - new value for field // type - datatype of value // RL_API int RL_Set_Field(REBSER *obj, u32 word_id, RXIARG val, int type) { REBCTX *context = AS_CONTEXT(obj); word_id = Find_Word_In_Context(context, word_id, FALSE); if (word_id == 0) return 0; if (GET_VAL_FLAG(CTX_KEY(context, word_id), TYPESET_FLAG_LOCKED)) return 0; RXI_To_Value(CTX_VAR(context, word_id), &val, type); return type; }
x*/ void RXI_To_Block(RXIFRM *frm, REBVAL *out) { /* ***********************************************************************/ REBCNT n; REBSER *blk; REBVAL *val; REBCNT len; blk = Make_Array(len = RXA_COUNT(frm)); for (n = 1; n <= len; n++) { val = Alloc_Tail_Array(blk); RXI_To_Value(val, frm->args[n], RXA_TYPE(frm, n)); } Val_Init_Block(out, blk); }
// // RL_Set_Value: C // // Set a value in a block. // // Returns: // TRUE if index past end and value was appended to tail of block. // Arguments: // series - block series pointer // index - index of the value in the block (zero based) // val - new value for field // type - datatype of value // RL_API REBOOL RL_Set_Value(REBARR *array, u32 index, RXIARG val, int type) { REBVAL value; VAL_INIT_WRITABLE_DEBUG(&value); RXI_To_Value(&value, &val, type); if (index >= ARR_LEN(array)) { Append_Value(array, &value); return TRUE; } *ARR_AT(array, index) = value; return FALSE; }
RL_API int RL_Set_Field(REBSER *obj, u32 word, RXIARG val, int type) /* ** Set a field (context variable) of an object. ** ** Returns: ** The type arg, or zero if word not found in object or if field is protected. ** Arguments: ** obj - object pointer (e.g. from RXA_OBJECT) ** word - global word identifier (integer) ** val - new value for field ** type - datatype of value */ { REBVAL value = {0}; if (!(word = Find_Word_Index(obj, word, FALSE))) return 0; if (VAL_PROTECTED(FRM_WORDS(obj)+word)) return 0; // Trap1(RE_LOCKED_WORD, word); RXI_To_Value(FRM_VALUES(obj)+word, val, type); return type; }
RL_API int RL_Set_Value(REBSER *series, u32 index, RXIARG val, int type) /* ** Set a value in a block. ** ** Returns: ** TRUE if index past end and value was appended to tail of block. ** Arguments: ** series - block series pointer ** index - index of the value in the block (zero based) ** val - new value for field ** type - datatype of value */ { REBVAL value = {0}; RXI_To_Value(&value, val, type); if (index >= series->tail) { Append_Val(series, &value); return TRUE; } *BLK_SKIP(series, index) = value; return FALSE; }
x*/ REBRXT Do_Callback(REBSER *obj, u32 name, RXIARG *rxis, 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; struct Reb_Call *call; REBCNT len; REBCNT n; REBVAL label; REBVAL out; // 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; } // Create stack frame (use prior stack frame for location info): SET_TRASH_SAFE(&out); // OUT slot for function eval result Val_Init_Word_Unbound(&label, REB_WORD, name); call = Make_Call( &out, VAL_SERIES(DSF_WHERE(PRIOR_DSF(DSF))), VAL_INDEX(DSF_WHERE(PRIOR_DSF(DSF))), &label, val ); obj = VAL_FUNC_PARAMLIST(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++) { REBVAL *arg = DSF_ARG(call, n); if (n <= RXI_COUNT(rxis)) RXI_To_Value(arg, rxis[n], RXI_TYPE(rxis, n)); else SET_NONE(arg); // Check type for word at the given offset: if (!TYPE_CHECK(BLK_SKIP(obj, n), VAL_TYPE(arg))) { result->i2.int32b = n; SET_EXT_ERROR(result, RXE_BAD_ARGS); Free_Call(call); return 0; } } // Evaluate the function: if (Dispatch_Call_Throws(call)) { // !!! Does this need handling such that there is a way for the thrown // value to "bubble up" out of the callback, or is an error sufficient? fail (Error_No_Catch_For_Throw(DSF_OUT(call))); } // Return resulting value from output *result = Value_To_RXI(&out); return Reb_To_RXT[VAL_TYPE(&out)]; }
*/ 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))]; }