*/ 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_Get_Value: C // // Get a value from a block. // // Returns: // Datatype of value or zero if index is past tail. // Arguments: // series - block series pointer // index - index of the value in the block (zero based) // result - set to the value of the field // RL_API int RL_Get_Value(REBARR *array, u32 index, RXIARG *result) { REBVAL *value; if (index >= ARR_LEN(array)) return 0; value = ARR_AT(array, index); Value_To_RXI(result, value); return Reb_To_RXT[VAL_TYPE_0(value)]; }
// // RL_Get_Field: C // // Get a field value (context variable) of an object. // // Returns: // Datatype of value or zero if word is not found in the object. // Arguments: // obj - object pointer (e.g. from RXA_OBJECT) // word - global word identifier (integer) // result - gets set to the value of the field // RL_API int RL_Get_Field(REBSER *obj, u32 word, RXIARG *result) { REBCTX *context = AS_CONTEXT(obj); REBVAL *value; if (!(word = Find_Word_In_Context(context, word, FALSE))) return 0; value = CTX_VAR(context, word); Value_To_RXI(result, value); return Reb_To_RXT[VAL_TYPE_0(value)]; }
*/ RL_API int RL_Do_Binary(REBYTE *bin, REBINT length, REBCNT flags, REBCNT key, RXIARG *result) /* ** Evaluate an encoded binary script such as compressed text. ** ** Returns: ** The datatype of the result or zero if error in the encoding. ** Arguments: ** bin - by default, a REBOL compressed UTF-8 (or ASCII) script. ** length - the length of the data. ** flags - special flags (set to zero at this time). ** key - encoding, encryption, or signature key. ** result - value returned from evaluation. ** Notes: ** As of A104, only compressed scripts are supported, however, ** rebin, cloaked, signed, and encrypted formats will be supported. ** ***********************************************************************/ { REBSER spec = {0}; REBSER *text; REBVAL *val; #ifdef DUMP_INIT_SCRIPT int f; #endif //Cloak(TRUE, code, NAT_SPEC_SIZE, &key[0], 20, TRUE); spec.data = bin; spec.tail = length; text = Decompress(&spec, 0, -1, 10000000, 0); if (!text) return FALSE; Append_Byte(text, 0); #ifdef DUMP_INIT_SCRIPT f = _open("host-boot.r", _O_CREAT | _O_RDWR, _S_IREAD | _S_IWRITE ); _write(f, STR_HEAD(text), LEN_BYTES(STR_HEAD(text))); _close(f); #endif SAVE_SERIES(text); val = Do_String(text->data, flags); UNSAVE_SERIES(text); if (IS_ERROR(val)) // && (VAL_ERR_NUM(val) != RE_QUIT)) { Print_Value(val, 1000, FALSE); if (result) { *result = Value_To_RXI(val); return Reb_To_RXT[VAL_TYPE(val)]; } return 0; }
RL_API int RL_Get_Field(REBSER *obj, u32 word, RXIARG *result) /* ** Get a field value (context variable) of an object. ** ** Returns: ** Datatype of value or zero if word is not found in the object. ** Arguments: ** obj - object pointer (e.g. from RXA_OBJECT) ** word - global word identifier (integer) ** result - gets set to the value of the field */ { REBVAL *value; if (!(word = Find_Word_Index(obj, word, FALSE))) return 0; value = BLK_SKIP(obj, word); *result = Value_To_RXI(value); return Reb_To_RXT[VAL_TYPE(value)]; }
RL_API int RL_Get_Value(REBSER *series, u32 index, RXIARG *result) /* ** Get a value from a block. ** ** Returns: ** Datatype of value or zero if index is past tail. ** Arguments: ** series - block series pointer ** index - index of the value in the block (zero based) ** result - set to the value of the field */ { REBVAL *value; if (index >= series->tail) return 0; value = BLK_SKIP(series, index); *result = Value_To_RXI(value); return Reb_To_RXT[VAL_TYPE(value)]; }
*/ RL_API int RL_Do_String(REBYTE *text, REBCNT flags, RXIARG *result) /* ** Load a string and evaluate the resulting block. ** ** Returns: ** The datatype of the result. ** Arguments: ** text - A null terminated UTF-8 (or ASCII) string to transcode ** into a block and evaluate. ** flags - set to zero for now ** result - value returned from evaluation. ** ***********************************************************************/ { REBVAL *val; val = Do_String(text, 0); if (result) { *result = Value_To_RXI(val); return Reb_To_RXT[VAL_TYPE(val)]; } return 0; }
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)]; }
*/ RL_API int RL_Do_String(int *exit_status, const REBYTE *text, REBCNT flags, RXIARG *result) /* ** Load a string and evaluate the resulting block. ** ** Returns: ** The datatype of the result if a positive number (or 0 if the ** type has no representation in the "RXT" API). An error code ** if it's a negative number. Two negative numbers are reserved ** for non-error conditions: -1 for halting (e.g. Escape), and ** -2 is reserved for exiting with exit_status set. ** ** Arguments: ** text - A null terminated UTF-8 (or ASCII) string to transcode ** into a block and evaluate. ** flags - set to zero for now ** result - value returned from evaluation, if NULL then result ** will be returned on the top of the stack ** ** Notes: ** This API was from before Rebol's open sourcing and had little ** vetting and few clients. The one client it did have was the ** "sample" console code (which wound up being the "only" ** console code for quite some time). ** ***********************************************************************/ { REBSER *code; REBVAL out; REBOL_STATE state; const REBVAL *error; // assumes it can only be run at the topmost level where // the data stack is completely empty. assert(DSP == -1); PUSH_UNHALTABLE_TRAP(&error, &state); // The first time through the following code 'error' will be NULL, but... // `raise Error` can longjmp here, so 'error' won't be NULL *if* that happens! if (error) { if (VAL_ERR_NUM(error) == RE_HALT) return -1; // !!! Revisit hardcoded # // Save error for WHY? *Get_System(SYS_STATE, STATE_LAST_ERROR) = *error; if (result) *result = Value_To_RXI(error); else DS_PUSH(error); return -VAL_ERR_NUM(error); } code = Scan_Source(text, LEN_BYTES(text)); PUSH_GUARD_SERIES(code); // Bind into lib or user spaces? if (flags) { // Top words will be added to lib: Bind_Values_Set_Forward_Shallow(BLK_HEAD(code), Lib_Context); Bind_Values_Deep(BLK_HEAD(code), Lib_Context); } else { REBCNT len; REBVAL vali; REBSER *user = VAL_OBJ_FRAME(Get_System(SYS_CONTEXTS, CTX_USER)); len = user->tail; Bind_Values_All_Deep(BLK_HEAD(code), user); SET_INTEGER(&vali, len); Resolve_Context(user, Lib_Context, &vali, FALSE, 0); } if (Do_At_Throws(&out, code, 0)) { DROP_GUARD_SERIES(code); if ( IS_NATIVE(&out) && ( VAL_FUNC_CODE(&out) == VAL_FUNC_CODE(ROOT_QUIT_NATIVE) || VAL_FUNC_CODE(&out) == VAL_FUNC_CODE(ROOT_EXIT_NATIVE) ) ) { CATCH_THROWN(&out, &out); DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state); *exit_status = Exit_Status_From_Value(&out); return -2; // Revisit hardcoded # } raise Error_No_Catch_For_Throw(&out); } DROP_GUARD_SERIES(code); DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state); if (result) *result = Value_To_RXI(&out); else DS_PUSH(&out); return Reb_To_RXT[VAL_TYPE(&out)]; }
// // RL_Do_String: C // // Load a string and evaluate the resulting block. // // Returns: // The datatype of the result if a positive number (or 0 if the // type has no representation in the "RXT" API). An error code // if it's a negative number. Two negative numbers are reserved // for non-error conditions: -1 for halting (e.g. Escape), and // -2 is reserved for exiting with exit_status set. // // Arguments: // text - A null terminated UTF-8 (or ASCII) string to transcode // into a block and evaluate. // flags - set to zero for now // result - value returned from evaluation, if NULL then result // will be returned on the top of the stack // // Notes: // This API was from before Rebol's open sourcing and had little // vetting and few clients. The one client it did have was the // "sample" console code (which wound up being the "only" // console code for quite some time). // RL_API int RL_Do_String( int *exit_status, const REBYTE *text, REBCNT flags, RXIARG *out ) { REBARR *code; struct Reb_State state; REBCTX *error; REBVAL result; VAL_INIT_WRITABLE_DEBUG(&result); // assumes it can only be run at the topmost level where // the data stack is completely empty. // assert(DSP == 0); PUSH_UNHALTABLE_TRAP(&error, &state); // The first time through the following code 'error' will be NULL, but... // `fail` can longjmp here, so 'error' won't be NULL *if* that happens! if (error) { // Save error for WHY? REBVAL *last = Get_System(SYS_STATE, STATE_LAST_ERROR); Val_Init_Error(last, error); if (ERR_NUM(error) == RE_HALT) return -1; // !!! Revisit hardcoded # if (out) Value_To_RXI(out, last); else DS_PUSH(last); return -ERR_NUM(error); } code = Scan_Source(text, LEN_BYTES(text)); PUSH_GUARD_ARRAY(code); // Bind into lib or user spaces? if (flags) { // Top words will be added to lib: Bind_Values_Set_Midstream_Shallow(ARR_HEAD(code), Lib_Context); Bind_Values_Deep(ARR_HEAD(code), Lib_Context); } else { REBCTX *user = VAL_CONTEXT(Get_System(SYS_CONTEXTS, CTX_USER)); REBVAL vali; VAL_INIT_WRITABLE_DEBUG(&vali); SET_INTEGER(&vali, CTX_LEN(user) + 1); Bind_Values_All_Deep(ARR_HEAD(code), user); Resolve_Context(user, Lib_Context, &vali, FALSE, FALSE); } if (Do_At_Throws(&result, code, 0)) { DROP_GUARD_ARRAY(code); if ( IS_FUNCTION_AND(&result, FUNC_CLASS_NATIVE) && ( VAL_FUNC_CODE(&result) == &N_quit || VAL_FUNC_CODE(&result) == &N_exit ) ) { CATCH_THROWN(&result, &result); DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state); *exit_status = Exit_Status_From_Value(&result); return -2; // Revisit hardcoded # } fail (Error_No_Catch_For_Throw(&result)); } DROP_GUARD_ARRAY(code); DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state); if (out) Value_To_RXI(out, &result); else DS_PUSH(&result); return Reb_To_RXT[VAL_TYPE_0(&result)]; }
*/ 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))]; }