Method* rvmAddMethod(Env* env, Class* clazz, const char* name, const char* desc, jint access, jint size, void* impl, void* synchronizedImpl, void* attributes) { Method* method = rvmAllocateMemory(env, IS_NATIVE(access) ? sizeof(NativeMethod) : sizeof(Method)); if (!method) return NULL; method->clazz = clazz; method->name = name; method->desc = desc; method->access = access; method->size = size; method->impl = impl; method->synchronizedImpl = synchronizedImpl; method->attributes = attributes; if (clazz->_methods == &METHODS_NOT_LOADED) { clazz->_methods = NULL; } method->next = clazz->_methods; clazz->_methods = method; return method; }
*/ int Do_Port_Action(struct Reb_Call *call_, REBSER *port, REBCNT action) /* ** Call a PORT actor (action) value. Search PORT actor ** first. If not found, search the PORT scheme actor. ** ** NOTE: stack must already be setup correctly for action, and ** the caller must cleanup the stack. ** ***********************************************************************/ { REBVAL *actor; REBCNT n = 0; assert(action < A_MAX_ACTION); // Verify valid port (all of these must be false): if ( // Must be = or larger than std port: (SERIES_TAIL(port) < STD_PORT_MAX) || // Must be an object series: !IS_FRAME(BLK_HEAD(port)) || // Must have a spec object: !IS_OBJECT(BLK_SKIP(port, STD_PORT_SPEC)) ) { raise Error_0(RE_INVALID_PORT); } // Get actor for port, if it has one: actor = BLK_SKIP(port, STD_PORT_ACTOR); if (IS_NONE(actor)) return R_NONE; // If actor is a native function: if (IS_NATIVE(actor)) return cast(REBPAF, VAL_FUNC_CODE(actor))(call_, port, action); // actor must be an object: if (!IS_OBJECT(actor)) raise Error_0(RE_INVALID_ACTOR); // Dispatch object function: n = Find_Action(actor, action); actor = Obj_Value(actor, n); if (!n || !actor || !ANY_FUNC(actor)) raise Error_1(RE_NO_PORT_ACTION, Get_Action_Word(action)); if (Redo_Func_Throws(actor)) { // No special handling needed, as we are just going to return // the output value in D_OUT anyway. } return R_OUT; // If not in PORT actor, use the SCHEME actor: #ifdef no_longer_used if (n == 0) { actor = Obj_Value(scheme, STD_SCHEME_actor); if (!actor) goto err; if (IS_NATIVE(actor)) goto fun; if (!IS_OBJECT(actor)) goto err; //vTrap_Expect(value, STD_PORT_actor, REB_OBJECT); n = Find_Action(actor, action); if (n == 0) goto err; } #endif }
*/ 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_API int RL_Start(REBYTE *bin, REBINT len, REBYTE *script, REBINT script_len, REBCNT flags) /* ** Evaluate the default boot function. ** ** Returns: ** Zero on success, otherwise indicates an error occurred. ** Arguments: ** bin - optional startup code (compressed), can be null ** len - length of above bin ** flags - special flags ** Notes: ** This function completes the startup sequence by calling ** the sys/start function. ** ***********************************************************************/ { REBVAL *val; REBSER *ser; REBOL_STATE state; const REBVAL *error; REBVAL start_result; int result; REBVAL out; if (bin) { ser = Decompress(bin, len, -1, FALSE, FALSE); if (!ser) return 1; val = BLK_SKIP(Sys_Context, SYS_CTX_BOOT_HOST); Val_Init_Binary(val, ser); } if (script && script_len > 4) { /* a 4-byte long payload type at the beginning */ i32 ptype = 0; REBYTE *data = script + sizeof(ptype); script_len -= sizeof(ptype); memcpy(&ptype, script, sizeof(ptype)); if (ptype == 1) {/* COMPRESSed data */ ser = Decompress(data, script_len, -1, FALSE, FALSE); } else { ser = Make_Binary(script_len); if (ser == NULL) { OS_FREE(script); return 1; } memcpy(BIN_HEAD(ser), data, script_len); } OS_FREE(script); val = BLK_SKIP(Sys_Context, SYS_CTX_BOOT_EMBEDDED); Val_Init_Binary(val, ser); } 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) { // Save error for EXPLAIN and return it *Get_System(SYS_STATE, STATE_LAST_ERROR) = *error; Print_Value(error, 1024, FALSE); // !!! Whether or not the Rebol interpreter just throws and quits // in an error case with a bad error code or breaks you into the // console to debug the environment should be controlled by // a command line option. Defaulting to returning an error code // seems better, because kicking into an interactive session can // cause logging systems to hang. For now we throw instead of // just quietly returning a code if the script fails, but add // that option! // For RE_HALT and all other errors we return the error // number. Error numbers are not set in stone (currently), but // are never zero...which is why we can use 0 for success. return VAL_ERR_NUM(error); } if (Do_Sys_Func_Throws(&out, SYS_CTX_FINISH_RL_START, 0)) { #if !defined(NDEBUG) if (LEGACY(OPTIONS_EXIT_FUNCTIONS_ONLY)) raise Error_No_Catch_For_Throw(&out); #endif if ( IS_NATIVE(&out) && ( VAL_FUNC_CODE(&out) == VAL_FUNC_CODE(ROOT_QUIT_NATIVE) || VAL_FUNC_CODE(&out) == VAL_FUNC_CODE(ROOT_EXIT_NATIVE) ) ) { int status; CATCH_THROWN(&out, &out); status = Exit_Status_From_Value(&out); DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state); Shutdown_Core(); OS_EXIT(status); DEAD_END; } raise Error_No_Catch_For_Throw(&out); } DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state); // The convention in the API was to return 0 for success. We use the // convention (as for FINISH_INIT_CORE) that any non-UNSET! result from // FINISH_RL_START indicates something went wrong. if (IS_UNSET(&out)) result = 0; else { assert(FALSE); // should not happen (raise an error instead) Debug_Fmt("** finish-rl-start returned non-NONE!:"); Debug_Fmt("%r", &out); result = RE_MISC; } return result; }