Error handling overhaul, includes CC#1743

This is a major rewrite of the setjmp/longjmp-based error handling,
and it's not really that reasonable or feasible to break it up much
more than this.  These things are all inter-related.

From a userspace point of view, in a scripted context (such as --do
or running a script by filename on the command line) the interpreter
will exit on error by default.  Previously it would break into the
CLI.  More sophisticated handling is suggested in CC#2215.

Another difference is that QUIT no longer has a /NOW refinement, and
only accepts integer arguments.  (When definitionally-scoped return
is implemented, then EXIT may be repurposed to be the "catchable"
form, while QUIT is always assumed to mean "now" and end the process)

From a developer point of view, the central ideas are that there
aren't two separate saved states to worry about (Halt_State is
integrated into Saved_State) and the PUSH_CATCH/DROP_CATCH macros are
clearer and simpler, with less chance for making mistakes in usage.

The mechanism for including a REBVAL associated with an error
has been simplified and formalized a little more.  Though simpler,
an attempt to further tighten the grip on this "sneaky" way of having
one error-per-task turned out to complicate the code a bit too much,
and so it could still be improved with some better asserts.

src/boot/errors.r

@@ -17,8 +17,11 @@ REBOL [
 Throw: [
 	code: 0
 	type: "throw error"
+	null:				{invalid error code zero}
 	break:              {no loop to break}
+	parse-break:		{parse BREAK not in PARSE (impossible!)}
 	return:             {return or exit not in function}
+	parse-return:		{parse RETURN not in PARSE (impossible!)}
 	throw:              [{no catch for throw:} :arg1]
 	continue:           {no loop to continue}
 	halt:               [{halted by user or script}]

src/boot/task.r

@@ -19,9 +19,8 @@ self
 stack			; data stack
 ballast			; current memory ballast (used for GC)
 max-ballast		; ballast reset value
-this-error		; current error
-this-value		; for holding an error argument during throw back
-stack-error		; special stack error object
+thrown-arg		; for holding an error argument during throw back
+stack-error		; special stack overlow error object
 this-context	; current context
 buf-emit		; temporary emit output block
 buf-words		; temporary word cache
@@ -30,5 +29,4 @@ buf-print		; temporary print output - used by raw print
 buf-form		; temporary form buffer - used by raw print
 buf-mold		; temporary mold buffer - used by mold
 mold-loop		; mold loop detection
-err-temps		; error temporaries
 

src/core/a-lib.c

@@ -152,8 +152,12 @@ extern int Do_Callback(REBSER *obj, u32 name, RXIARG *args, RXIARG *result);
 	REBVAL *val;
 	REBSER *ser;
 
-	REBSER spec;
-	CLEARS(&spec);
+	REBOL_STATE state;
+	const REBVAL *error;
+
+	REBVAL start_result;
+
+	int result;
 
 	if (bin) {
 		ser = Decompress(bin, len, 10000000, 0);
@@ -187,7 +191,63 @@ extern int Do_Callback(REBSER *obj, u32 name, RXIARG *args, RXIARG *result);
 		Set_Binary(val, ser);
 	}
 
-	return Init_Mezz(0);
+	PUSH_CATCH_ANY(&error, &state);
+
+// The first time through the following code 'error' will be NULL, but...
+// Throw() can longjmp here, so 'error' won't be NULL *if* that happens!
+
+	if (error) {
+		if (VAL_ERR_NUM(error) == RE_QUIT) {
+			int status = VAL_ERR_STATUS(error);
+			Shutdown_Core();
+			OS_EXIT(status);
+			DEAD_END;
+		}
+
+		// Save error for EXPLAIN and return it
+		*Get_System(SYS_STATE, STATE_LAST_ERROR) = *error;
+
+		// Error codes of zero should not be possible, and if we returned
+		// zero that would mean success.
+		assert(VAL_ERR_NUM(error) != 0);
+
+		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 can be unstable.
+		return VAL_ERR_NUM(error);
+	}
+
+	Do_Sys_Func(SYS_CTX_FINISH_RL_START, 0);
+
+	DROP_CATCH_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-none! result from
+	// FINISH_RL_START indicates something went wrong.
+
+	if (IS_NONE(DS_TOP))
+		result = 0;
+	else {
+		assert(FALSE); // should not happen (raise an error instead)
+		Debug_Fmt("** finish-rl-start returned non-NONE!:");
+		Debug_Fmt("%r", DS_TOP);
+		result = RE_MISC;
+	}
+
+	// Drop the result of the Do_Sys_Func call
+	DS_DROP;
+
+	return result;
 }
 
 
@@ -206,7 +266,7 @@ extern int Do_Callback(REBSER *obj, u32 name, RXIARG *args, RXIARG *result);
 **
 ***********************************************************************/
 {
-	DS_RESET;
+	Panic(RP_NA);
 }
 
 
@@ -288,14 +348,121 @@ extern int Do_Callback(REBSER *obj, u32 name, RXIARG *args, RXIARG *result);
 **
 ***********************************************************************/
 {
-	REBVAL *val;
+	REBSER *code;
+	REBCNT len;
+	REBVAL vali;
 
-	val = Do_String(text, 0);
+	REBVAL temp;
+
+	REBOL_STATE state;
+	const REBVAL *error;
+
+	assert(DSP == 0);
+
+	PUSH_CATCH_ANY(&error, &state);
+
+// The first time through the following code 'error' will be NULL, but...
+// Throw() can longjmp here, so 'error' won't be NULL *if* that happens!
+
+	if (error) {
+		if (VAL_ERR_NUM(error) == RE_QUIT) {
+			int status = VAL_ERR_STATUS(error);
+			Shutdown_Core();
+			OS_EXIT(status);
+			DEAD_END;
+		}
+
+		// !!! Through this interface we have no way to distinguish an error
+		// returned as a value from one that was thrown.  Yet by contract
+		// we must return some sort of value--we try and patch over this
+		// by printing out the error and returning an UNSET!.  RenC has
+		// a stronger answer of offering the actual error catching interface
+		// to clients directly.
+
+		DS_PUSH_UNSET;
+
+		// !!! If the user halted during a Do_String what should we return?
+		// For now, assume the halt printed a message and don't do it again.
+		// Otherwise, we should print the FORMed error
+		if (VAL_ERR_NUM(error) != RE_HALT) {
+			// !!! statics are not safe for multithreading.
+			static REBOOL why_alert = TRUE;
+
+			Out_Value(error, 640, FALSE, 0);
+
+			// Save error for WHY?
+			*Get_System(SYS_STATE, STATE_LAST_ERROR) = *error;
+
+			// Tell them about why on the first error only
+			if (why_alert) {
+				Out_Str(
+					cb_cast("** Note: use WHY? for more error information"), 2
+				);
+				why_alert = FALSE;
+			}
+		}
+
+		if (result) {
+			REBRXT type = Reb_To_RXT[VAL_TYPE(DS_TOP)];
+			*result = Value_To_RXI(DS_TOP);
+
+			SET_TRASH(DS_TOP);
+			DS_DROP;
+
+			return type;
+		}
+
+		return -VAL_ERR_NUM(error);
+	}
+
+	code = Scan_Source(text, LEN_BYTES(text));
+	SAVE_SERIES(code);
+
+	// Bind into lib or user spaces?
+	if (flags) {
+		// Top words will be added to lib:
+		Bind_Block(Lib_Context, BLK_HEAD(code), BIND_SET);
+		Bind_Block(Lib_Context, BLK_HEAD(code), BIND_DEEP);
+	} else {
+		REBSER *user = VAL_OBJ_FRAME(Get_System(SYS_CONTEXTS, CTX_USER));
+		len = user->tail;
+		Bind_Block(user, BLK_HEAD(code), BIND_ALL | BIND_DEEP);
+		SET_INTEGER(&vali, len);
+		Resolve_Context(user, Lib_Context, &vali, FALSE, 0);
+	}
+
+	Do_Blk(code, 0);
+	DSP++; // shift to use TOS semantics (not TOS1)
+
+	UNSAVE_SERIES(code);
+
+	if (THROWN(DS_TOP)) {
+		assert(IS_ERROR(DS_TOP));
+		Throw(DS_TOP, NULL);
+		DEAD_END;
+	}
+
+	DROP_CATCH_SAME_STACKLEVEL_AS_PUSH(&state);
 
 	if (result) {
-		*result = Value_To_RXI(val);
-		return Reb_To_RXT[VAL_TYPE(val)];
+		// Grab the result off the top of the stack and convert it to RXT
+		// and RXI if that was requested.
+
+		REBRXT type = Reb_To_RXT[VAL_TYPE(DS_TOP)];
+		*result = Value_To_RXI(DS_TOP);
+
+		// Protocol was we do not leave TOS value if result requested
+		// Overwrite with trash to ensure TOS1 semantics not used
+		SET_TRASH(DS_TOP);
+		DS_DROP;
+
+		return type;
 	}
+
+	// Value is just left on top of stack if no result parameter.  :-/
+	// (The RL API was written with ideas like "print the top of stack"
+	// while not exposing ways to analyze it unless converted to RXT/RXI)
+
 	return 0;
 }
 
@@ -336,7 +503,9 @@ extern int Do_Callback(REBSER *obj, u32 name, RXIARG *args, RXIARG *result);
 	_close(f);
 #endif
 
+	SAVE_SERIES(text);
 	rxt = RL_Do_String(text->data, flags, result);
+	UNSAVE_SERIES(text);
 
 	Free_Series(text);
 	return rxt;
@@ -418,7 +587,7 @@ extern int Do_Callback(REBSER *obj, u32 name, RXIARG *args, RXIARG *result);
 **
 */	RL_API void RL_Print_TOS(REBCNT flags, const REBYTE *marker)
 /*
-**	Print top REBOL stack value to the console. (pending changes)
+**	Print top REBOL stack value to the console and drop it.
 **
 **	Returns:
 **		Nothing
@@ -431,52 +600,24 @@ extern int Do_Callback(REBSER *obj, u32 name, RXIARG *args, RXIARG *result);
 **		The REBOL data stack is an abstract structure that can
 **		change between releases. This function allows the host
 **		to print the result of processed functions.
-**		Note that what is printed is actually TOS+1.
 **		Marker is usually "==" to show output.
 **		The system/options/result-types determine which values
 **		are automatically printed.
 **
 ***********************************************************************/
 {
-	REBINT dsp = DSP;
-	REBVAL *top = DS_VALUE(dsp+1);
-	REBOL_STATE state;
-	REBVAL *types;
+	if (DSP != 1)
+		Debug_Fmt(Str_Stack_Misaligned, DSP);
 
-	if (dsp != 0) Debug_Fmt(Str_Stack_Misaligned, dsp);
+	// We shouldn't get any THROWN() errors exposed to the user
+	assert(!IS_ERROR(DS_TOP) || !THROWN(DS_TOP));
 
-	PUSH_STATE(state, Saved_State);
-	if (SET_JUMP(state)) {
-		POP_STATE(state, Saved_State);
-		Catch_Error(DS_NEXT); // Stores error value here
-		Out_Value(DS_NEXT, 0, FALSE, 0); // error
-		DSP = 0;
-		return;
-	}
-	SET_STATE(state, Saved_State);
-
-	if (!IS_UNSET(top)) {
-		if (!IS_ERROR(top)) {
-			types = Get_System(SYS_OPTIONS, OPTIONS_RESULT_TYPES);
-			if (IS_TYPESET(types) && TYPE_CHECK(types, VAL_TYPE(top))) {
-				if (marker) Out_Str(marker, 0);
-				Out_Value(top, 500, TRUE, 1); // limit, molded
-			}
-//			else {
-//				Out_Str(Get_Type_Name(top), 1);
-//			}
-		} else {
-			if (VAL_ERR_NUM(top) != RE_HALT) {
-				Out_Value(top, 640, FALSE, 0); // error FORMed
-//				if (VAL_ERR_NUM(top) > RE_THROW_MAX) {
-//					Out_Str("** Note: use WHY? for more about this error", 1);
-//				}
-			}
-		}
+	if (!IS_UNSET(DS_TOP)) {
+		if (marker) Out_Str(marker, 0);
+		Out_Value(DS_TOP, 500, TRUE, 1); // limit, molded
 	}
 
-	POP_STATE(state, Saved_State);
-	DSP = 0;
+	DS_DROP;
 }