//
// Destroy_External_Storage: C
//
// Destroy the external storage pointed by `->data` by calling the routine
// `free_func` if it's not NULL
//
// out Result
// ser The series
// free_func A routine to free the storage, if it's NULL, only mark the
// external storage non-accessible
//
REB_R Destroy_External_Storage(REBVAL *out,
REBSER *ser,
REBVAL *free_func)
{
SET_VOID(out);
if (!GET_SER_FLAG(ser, SERIES_FLAG_EXTERNAL)) {
fail (Error(RE_NO_EXTERNAL_STORAGE));
}
if (!GET_SER_FLAG(ser, SERIES_FLAG_ACCESSIBLE)) {
REBVAL i;
SET_INTEGER(&i, cast(REBUPT, SER_DATA_RAW(ser)));
fail (Error(RE_ALREADY_DESTROYED, &i));
}
CLEAR_SER_FLAG(ser, SERIES_FLAG_ACCESSIBLE);
if (free_func) {
REBVAL safe;
REBARR *array;
REBVAL *elem;
REBOOL threw;
array = Make_Array(2);
MANAGE_ARRAY(array);
PUSH_GUARD_ARRAY(array);
elem = Alloc_Tail_Array(array);
*elem = *free_func;
elem = Alloc_Tail_Array(array);
SET_INTEGER(elem, cast(REBUPT, SER_DATA_RAW(ser)));
threw = Do_At_Throws(&safe, array, 0, SPECIFIED); // 2 non-relative val
DROP_GUARD_ARRAY(array);
if (threw) return R_OUT_IS_THROWN;
}
return R_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)];
}
