*/ 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;
}
//
// RL_Start: C
//
// 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.
//
RL_API int RL_Start(REBYTE *bin, REBINT len, REBYTE *script, REBINT script_len, REBCNT flags)
{
REBVAL *val;
REBSER *ser;
struct Reb_State state;
REBCTX *error;
int error_num;
REBVAL result;
VAL_INIT_WRITABLE_DEBUG(&result);
if (bin) {
ser = Decompress(bin, len, -1, FALSE, FALSE);
if (!ser) return 1;
val = CTX_VAR(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 = CTX_VAR(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...
// `fail` can longjmp here, so 'error' won't be NULL *if* that happens!
if (error) {
//
// !!! We are not allowed to ask for a print operation that can take
// arbitrarily long without allowing for cancellation via Ctrl-C,
// but here we are wanting to print an error. If you're printing
// out an error and get a halt, it won't print the halt.
//
REBCTX *halt_error;
// Save error for WHY?
//
REBVAL *last = Get_System(SYS_STATE, STATE_LAST_ERROR);
Val_Init_Error(last, error);
PUSH_UNHALTABLE_TRAP(&halt_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 (halt_error) {
assert(ERR_NUM(halt_error) == RE_HALT);
return ERR_NUM(halt_error);
}
Print_Value(last, 1024, FALSE);
DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);
// !!! When running in a script, whether or not the Rebol interpreter
// just exits 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 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 ERR_NUM(error);
}
if (Apply_Only_Throws(
&result, Sys_Func(SYS_CTX_FINISH_RL_START), END_VALUE
)) {
#if !defined(NDEBUG)
if (LEGACY(OPTIONS_EXIT_FUNCTIONS_ONLY))
fail (Error_No_Catch_For_Throw(&result));
#endif
if (
IS_FUNCTION_AND(&result, FUNC_CLASS_NATIVE) && (
VAL_FUNC_CODE(&result) == &N_quit
|| VAL_FUNC_CODE(&result) == &N_exit
)
) {
int status;
CATCH_THROWN(&result, &result);
status = Exit_Status_From_Value(&result);
DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);
Shutdown_Core();
OS_EXIT(status);
DEAD_END;
}
fail (Error_No_Catch_For_Throw(&result));
}
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(&result))
error_num = 0; // no error
else {
assert(FALSE); // should not happen (raise an error instead)
Debug_Fmt("** finish-rl-start returned non-NONE!:");
Debug_Fmt("%r", &result);
error_num = RE_MISC;
}
return error_num;
}
//
// 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)];
}
//
// Do_String()
//
// This is a version of a routine that was offered by the RL_Api, which has
// been expanded here in order to permit the necessary customizations for
// interesting REPL behavior w.r.t. binding, error handling, and response
// to throws.
//
// !!! Now that this code has been moved into the host, the convoluted
// integer-return-scheme can be eliminated and the code integrated more
// clearly into the surrounding calls.
//
int Do_String(
int *exit_status,
REBVAL *out,
const REBYTE *text,
REBOOL at_breakpoint
) {
struct Reb_State state;
REBCTX *error;
// Breakpoint REPLs are nested, and we may wish to jump out of them to
// the topmost level via a HALT. However, all other errors need to be
// confined, so that if one is doing evaluations during the pause of
// a breakpoint an error doesn't "accidentally resume" by virtue of
// jumping the stack out of the REPL.
//
// The topmost layer REPL, however, needs to catch halts in order to
// keep control and not crash out.
//
if (at_breakpoint)
PUSH_TRAP(&error, &state);
else
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);
if (ERR_NUM(error) == RE_HALT) {
assert(!at_breakpoint);
return -1; // !!! Revisit hardcoded #
}
Val_Init_Error(out, error);
*last = *out;
return -cast(REBINT, ERR_NUM(error));
}
REBARR *code = Scan_UTF8_Managed(text, LEN_BYTES(text));
// Where code ends up being bound when loaded at the REPL prompt should
// be more generally configurable. (It may be, for instance, that one
// wants to run something with it not bound at all.) Such choices
// must come from this REPL host...not from the interpreter itself.
{
// First the scanned code is bound into the user context with a
// fallback to the lib context.
//
// !!! This code is very old, and is how the REPL has bound since
// R3-Alpha. It comes from RL_Do_String, but should receive a modern
// review of why it's written exactly this way.
//
REBCTX *user_ctx = VAL_CONTEXT(Get_System(SYS_CONTEXTS, CTX_USER));
REBVAL vali;
SET_INTEGER(&vali, CTX_LEN(user_ctx) + 1);
Bind_Values_All_Deep(ARR_HEAD(code), user_ctx);
Resolve_Context(user_ctx, Lib_Context, &vali, FALSE, FALSE);
// If we're stopped at a breakpoint, the REPL should have a concept
// of what stack level it is inspecting (conveyed by the |#|>> in the
// prompt). This does a binding pass using the function for that
// stack level, just the way a body is bound during Make_Function()
//
if (at_breakpoint) {
REBVAL level;
SET_INTEGER(&level, HG_Stack_Level);
REBFRM *frame = Frame_For_Stack_Level(NULL, &level, FALSE);
assert(frame);
// Need to manage because it may be no words get bound into it,
// and we're not putting it into a FRAME! value, so it might leak
// otherwise if it's reified.
//
REBCTX *frame_ctx = Context_For_Frame_May_Reify_Managed(frame);
Bind_Values_Deep(ARR_HEAD(code), frame_ctx);
}
// !!! This was unused code that used to be in Do_String from
// RL_Api. It was an alternative path under `flags` which said
// "Bind into lib or user spaces?" and then "Top words will be
// added to lib". Is it relevant in any way?
//
/* Bind_Values_Set_Midstream_Shallow(ARR_HEAD(code), Lib_Context);
Bind_Values_Deep(ARR_HEAD(code), Lib_Context); */
}
if (Do_At_Throws(out, code, 0, SPECIFIED)) { // `code` will be GC protected
if (at_breakpoint) {
if (
IS_FUNCTION(out)
&& VAL_FUNC_DISPATCHER(out) == &N_resume
) {
//
// This means we're done with the embedded REPL. We want to
// resume and may be returning a piece of code that will be
// run by the finishing BREAKPOINT command in the target
// environment.
//
// We'll never return a halt, so we reuse -1 (in this very
// temporary scheme built on the very clunky historical REPL,
// which will not last much longer...fingers crossed.)
//
DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);
CATCH_THROWN(out, out);
*exit_status = -1;
return -1;
}
if (
IS_FUNCTION(out)
&& VAL_FUNC_DISPATCHER(out) == &N_quit
) {
//
// It would be frustrating if the system did not respond to
// a QUIT and forced you to do `resume/with [quit]`. So
// this is *not* caught, rather passed back up with the
// special -2 status code.
//
DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);
CATCH_THROWN(out, out);
*exit_status = -2;
return -2;
}
}
else {
// We are at the top level REPL, where we catch QUIT and for
// now, also EXIT as meaning you want to leave.
//
if (
IS_FUNCTION(out)
&& (
VAL_FUNC_DISPATCHER(out) == &N_quit
|| VAL_FUNC_DISPATCHER(out) == &N_exit
)
) {
DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);
CATCH_THROWN(out, out);
*exit_status = Exit_Status_From_Value(out);
return -2; // Revisit hardcoded #
}
}
fail (Error_No_Catch_For_Throw(out));
}
DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);
return 0;
}