*/ int main(int argc, char **argv)
/*
***********************************************************************/
{
char *cmd;
// Parse command line arguments. Done early. May affect REBOL boot.
Parse_Args(argc, argv, &Main_Args);
Print_Str("REBOL 3.0\n");
REBOL_Init(&Main_Args);
// Evaluate user input:
while (TRUE) {
cmd = Prompt_User();
REBOL_Do_String(cmd);
if (!IS_UNSET(DS_TOP)) {
//if (DSP > 0) {
if (!IS_ERROR(DS_TOP)) {
Prin("== ");
Print_Value(DS_TOP, 0, TRUE);
} else
Print_Value(DS_TOP, 0, FALSE);
//}
}
//DS_DROP; // result
}
return 0;
}
*/ void Out_Value(const REBVAL *value, REBCNT limit, REBOOL mold, REBINT lines)
/*
***********************************************************************/
{
Print_Value(value, limit, mold); // higher level!
for (; lines > 0; lines--) Print_OS_Line();
}
*/ void Init_Errors(REBVAL *errors)
/*
***********************************************************************/
{
REBSER *errs;
REBVAL *val;
// Create error objects and error type objects:
*ROOT_ERROBJ = *Get_System(SYS_STANDARD, STD_ERROR);
errs = Construct_Object(0, VAL_BLK(errors), 0);
Set_Object(Get_System(SYS_CATALOG, CAT_ERRORS), errs);
Set_Root_Series(TASK_ERR_TEMPS, Make_Block(3));
// Create objects for all error types:
for (val = BLK_SKIP(errs, 1); NOT_END(val); val++) {
errs = Construct_Object(0, VAL_BLK(val), 0);
SET_OBJECT(val, errs);
}
// Catch top level errors, to provide decent output:
PUSH_STATE(Top_State, Saved_State);
if (SET_JUMP(Top_State)) {
POP_STATE(Top_State, Saved_State);
DSP++; // Room for return value
Catch_Error(DS_TOP); // Stores error value here
Print_Value(DS_TOP, 0, FALSE);
Crash(RP_NO_CATCH);
}
SET_STATE(Top_State, Saved_State);
}
*/ 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_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;
}
