//
// Val_Init_Context: C
//
// Common routine for initializing OBJECT, MODULE!, PORT!, and ERROR!
//
// A fully constructed context can reconstitute the ANY-CONTEXT! REBVAL that
// is its canon form from a single pointer...the REBVAL sitting in the 0 slot
// of the context's varlist.
//
void Val_Init_Context(REBVAL *out, enum Reb_Kind kind, REBCTX *context) {
//
// In a debug build we check to make sure the type of the embedded value
// matches the type of what is intended (so someone who thinks they are
// initializing a REB_OBJECT from a CONTEXT does not accidentally get a
// REB_ERROR, for instance.) It's a point for several other integrity
// checks as well.
//
#if !defined(NDEBUG)
REBVAL *value = CTX_VALUE(context);
assert(ANY_CONTEXT(value));
assert(CTX_TYPE(context) == kind);
assert(VAL_CONTEXT(value) == context);
if (!CTX_KEYLIST(context)) {
Debug_Fmt("Context found with no keylist set");
Panic_Context(context);
}
assert(GET_ARR_FLAG(CTX_VARLIST(context), ARRAY_FLAG_CONTEXT_VARLIST));
// !!! Historically spec is a frame of an object for a "module spec",
// may want to use another word of that and make a block "spec"
//
if (IS_FRAME(CTX_VALUE(context))) {
assert(IS_FUNCTION(FUNC_VALUE(CTX_FRAME_FUNC(context))));
}
else
assert(
NOT(CTX_SPEC(context))
|| ANY_CONTEXT(CTX_VALUE(CTX_SPEC(context)))
);
#endif
// Some contexts (stack frames in particular) start out unmanaged, and
// then check to see if an operation like Val_Init_Context set them to
// managed. If not, they will free the context. This avoids the need
// for the garbage collector to have to deal with the series if there's
// no reason too.
//
// Here is a case of where we mark the context as having an extant usage,
// so that at minimum this value must become unreachable from the root GC
// set before they are GC'd. For another case, see INIT_WORD_CONTEXT(),
// where an ANY-WORD! can mark a context as in use.
//
ENSURE_ARRAY_MANAGED(CTX_VARLIST(context));
// Keylists are different, because they may-or-may-not-be-reused by some
// operations. There needs to be a uniform policy on their management,
// or certain routines would return "sometimes managed, sometimes not"
// keylist series...a bad invariant.
//
ASSERT_ARRAY_MANAGED(CTX_KEYLIST(context));
*out = *CTX_VALUE(context);
}
*/ REBVAL *Get_Object(REBVAL *objval, REBCNT index)
/*
** Get an instance variable from an object value.
**
***********************************************************************/
{
REBSER *obj = VAL_OBJ_FRAME(objval);
ASSERT1(IS_FRAME(BLK_HEAD(obj)), RP_BAD_OBJ_FRAME);
ASSERT1(index < SERIES_TAIL(obj), RP_BAD_OBJ_INDEX);
return FRM_VALUES(obj) + index;
}
//
// Specializer_Dispatcher: C
//
// The evaluator does not do any special "running" of a specialized frame.
// All of the contribution that the specialization had to make was taken care
// of when Eval_Core() used f->special to fill from the exemplar. So all this
// does is change the phase and binding to match the function this layer wa
// specializing.
//
REB_R Specializer_Dispatcher(REBFRM *f)
{
REBARR *details = ACT_DETAILS(FRM_PHASE(f));
REBVAL *exemplar = KNOWN(ARR_HEAD(details));
assert(IS_FRAME(exemplar));
INIT_FRM_PHASE(f, VAL_PHASE(exemplar));
FRM_BINDING(f) = VAL_BINDING(exemplar);
return R_REDO_UNCHECKED; // redo uses the updated phase and binding
}
*/ void Validate_Port(REBSER *port, REBCNT action)
/*
** Because port actors are exposed to the user level, we must
** prevent them from being called with invalid values.
**
***********************************************************************/
{
if (
action >= A_MAX_ACTION
|| port->tail > 50
|| SERIES_WIDE(port) != sizeof(REBVAL)
|| !IS_FRAME(BLK_HEAD(port))
|| !IS_OBJECT(BLK_SKIP(port, STD_PORT_SPEC))
) {
raise Error_0(RE_INVALID_PORT);
}
}
REB_R N_debug(REBFRM *frame_) {
PARAM(1, value);
REBVAL *value = ARG(value);
if (IS_VOID(value)) {
//
// e.g. just `>> debug` and [enter] in the console. Ideally this
// would shift the REPL into a mode where all commands issued were
// assumed to be in the debug dialect, similar to Ren Garden's
// modalities like `debug>>`.
//
Debug_Fmt("Sorry, there is no debug>> 'mode' yet in the console.");
goto modify_with_confidence;
}
if (IS_INTEGER(value) || IS_FRAME(value) || IS_FUNCTION(value)) {
REBFRM *frame;
// We pass TRUE here to account for an extra stack level... the one
// added by DEBUG itself, which presumably should not count.
//
if (!(frame = Frame_For_Stack_Level(&HG_Stack_Level, value, TRUE)))
fail (Error_Invalid_Arg(value));
Val_Init_Block(D_OUT, Make_Where_For_Frame(frame));
return R_OUT;
}
assert(IS_BLOCK(value));
Debug_Fmt(
"Sorry, but the `debug [...]` dialect is not defined yet.\n"
"Change the stack level (integer!, frame!, function!)\n"
"Or try out these commands:\n"
"\n"
" BREAKPOINT, RESUME, BACKTRACE\n"
);
modify_with_confidence:
Debug_Fmt(
"(Note: Ren-C is 'modify-with-confidence'...so just because a debug\n"
"feature you want isn't implemented doesn't mean you can't add it!)\n"
);
return R_BLANK;
}
//
// Do_Breakpoint_Throws: C
//
// A call to Do_Breakpoint_Throws does delegation to a hook in the host, which
// (if registered) will generally start an interactive session for probing the
// environment at the break. The `resume` native cooperates by being able to
// give back a value (or give back code to run to produce a value) that the
// call to breakpoint returns.
//
// RESUME has another feature, which is to be able to actually unwind and
// simulate a return /AT a function *further up the stack*. (This may be
// switched to a feature of a "STEP OUT" command at some point.)
//
REBOOL Do_Breakpoint_Throws(
REBVAL *out,
REBOOL interrupted, // Ctrl-C (as opposed to a BREAKPOINT)
const REBVAL *default_value,
REBOOL do_default
) {
REBVAL *target = NONE_VALUE;
REBVAL temp;
VAL_INIT_WRITABLE_DEBUG(&temp);
if (!PG_Breakpoint_Quitting_Hook) {
//
// Host did not register any breakpoint handler, so raise an error
// about this as early as possible.
//
fail (Error(RE_HOST_NO_BREAKPOINT));
}
// We call the breakpoint hook in a loop, in order to keep running if any
// inadvertent FAILs or THROWs occur during the interactive session.
// Only a conscious call of RESUME speaks the protocol to break the loop.
//
while (TRUE) {
struct Reb_State state;
REBCTX *error;
push_trap:
PUSH_TRAP(&error, &state);
// The host may return a block of code to execute, but cannot
// while evaluating do a THROW or a FAIL that causes an effective
// "resumption". Halt is the exception, hence we PUSH_TRAP and
// not PUSH_UNHALTABLE_TRAP. QUIT is also an exception, but a
// desire to quit is indicated by the return value of the breakpoint
// hook (which may or may not decide to request a quit based on the
// QUIT command being run).
//
// The core doesn't want to get involved in presenting UI, so if
// an error makes it here and wasn't trapped by the host first that
// is a bug in the host. It should have done its own PUSH_TRAP.
//
if (error) {
#if !defined(NDEBUG)
REBVAL error_value;
VAL_INIT_WRITABLE_DEBUG(&error_value);
Val_Init_Error(&error_value, error);
PROBE_MSG(&error_value, "Error not trapped during breakpoint:");
Panic_Array(CTX_VARLIST(error));
#endif
// In release builds, if an error managed to leak out of the
// host's breakpoint hook somehow...just re-push the trap state
// and try it again.
//
goto push_trap;
}
// Call the host's breakpoint hook.
//
if (PG_Breakpoint_Quitting_Hook(&temp, interrupted)) {
//
// If a breakpoint hook returns TRUE that means it wants to quit.
// The value should be the /WITH value (as in QUIT/WITH)
//
assert(!THROWN(&temp));
*out = *ROOT_QUIT_NATIVE;
CONVERT_NAME_TO_THROWN(out, &temp, FALSE);
return TRUE; // TRUE = threw
}
// If a breakpoint handler returns FALSE, then it should have passed
// back a "resume instruction" triggered by a call like:
//
// resume/do [fail "This is how to fail from a breakpoint"]
//
// So now that the handler is done, we will allow any code handed back
// to do whatever FAIL it likes vs. trapping that here in a loop.
//
DROP_TRAP_SAME_STACKLEVEL_AS_PUSH(&state);
// Decode and process the "resume instruction"
{
struct Reb_Frame *frame;
REBVAL *mode;
REBVAL *payload;
assert(IS_GROUP(&temp));
assert(VAL_LEN_HEAD(&temp) == RESUME_INST_MAX);
mode = VAL_ARRAY_AT_HEAD(&temp, RESUME_INST_MODE);
payload = VAL_ARRAY_AT_HEAD(&temp, RESUME_INST_PAYLOAD);
target = VAL_ARRAY_AT_HEAD(&temp, RESUME_INST_TARGET);
// The first thing we need to do is determine if the target we
// want to return to has another breakpoint sandbox blocking
// us. If so, what we need to do is actually retransmit the
// resume instruction so it can break that wall, vs. transform
// it into an EXIT/FROM that would just get intercepted.
//
if (!IS_NONE(target)) {
#if !defined(NDEBUG)
REBOOL found = FALSE;
#endif
for (frame = FS_TOP; frame != NULL; frame = frame->prior) {
if (frame->mode != CALL_MODE_FUNCTION)
continue;
if (
frame != FS_TOP
&& FUNC_CLASS(frame->func) == FUNC_CLASS_NATIVE
&& (
FUNC_CODE(frame->func) == &N_pause
|| FUNC_CODE(frame->func) == &N_breakpoint
)
) {
// We hit a breakpoint (that wasn't this call to
// breakpoint, at the current FS_TOP) before finding
// the sought after target. Retransmit the resume
// instruction so that level will get it instead.
//
*out = *ROOT_RESUME_NATIVE;
CONVERT_NAME_TO_THROWN(out, &temp, FALSE);
return TRUE; // TRUE = thrown
}
if (IS_FRAME(target)) {
if (NOT(frame->flags & DO_FLAG_FRAME_CONTEXT))
continue;
if (
VAL_CONTEXT(target)
== AS_CONTEXT(frame->data.context)
) {
// Found a closure matching the target before we
// reached a breakpoint, no need to retransmit.
//
#if !defined(NDEBUG)
found = TRUE;
#endif
break;
}
}
else {
assert(IS_FUNCTION(target));
if (frame->flags & DO_FLAG_FRAME_CONTEXT)
continue;
if (VAL_FUNC(target) == frame->func) {
//
// Found a function matching the target before we
// reached a breakpoint, no need to retransmit.
//
#if !defined(NDEBUG)
found = TRUE;
#endif
break;
}
}
}
// RESUME should not have been willing to use a target that
// is not on the stack.
//
#if !defined(NDEBUG)
assert(found);
#endif
}
if (IS_NONE(mode)) {
//
// If the resume instruction had no /DO or /WITH of its own,
// then it doesn't override whatever the breakpoint provided
// as a default. (If neither the breakpoint nor the resume
// provided a /DO or a /WITH, result will be UNSET.)
//
goto return_default; // heeds `target`
}
assert(IS_LOGIC(mode));
if (VAL_LOGIC(mode)) {
if (DO_VAL_ARRAY_AT_THROWS(&temp, payload)) {
//
// Throwing is not compatible with /AT currently.
//
if (!IS_NONE(target))
fail (Error_No_Catch_For_Throw(&temp));
// Just act as if the BREAKPOINT call itself threw
//
*out = temp;
return TRUE; // TRUE = thrown
}
// Ordinary evaluation result...
}
else
temp = *payload;
}
// The resume instruction will be GC'd.
//
goto return_temp;
}
DEAD_END;
return_default:
if (do_default) {
if (DO_VAL_ARRAY_AT_THROWS(&temp, default_value)) {
//
// If the code throws, we're no longer in the sandbox...so we
// bubble it up. Note that breakpoint runs this code at its
// level... so even if you request a higher target, any throws
// will be processed as if they originated at the BREAKPOINT
// frame. To do otherwise would require the EXIT/FROM protocol
// to add support for DO-ing at the receiving point.
//
*out = temp;
return TRUE; // TRUE = thrown
}
}
else
temp = *default_value; // generally UNSET! if no /WITH
return_temp:
// The easy case is that we just want to return from breakpoint
// directly, signaled by the target being NONE!.
//
if (IS_NONE(target)) {
*out = temp;
return FALSE; // FALSE = not thrown
}
// If the target is a function, then we're looking to simulate a return
// from something up the stack. This uses the same mechanic as
// definitional returns--a throw named by the function or closure frame.
//
// !!! There is a weak spot in definitional returns for FUNCTION! that
// they can only return to the most recent invocation; which is a weak
// spot of FUNCTION! in general with stack relative variables. Also,
// natives do not currently respond to definitional returns...though
// they can do so just as well as FUNCTION! can.
//
*out = *target;
CONVERT_NAME_TO_THROWN(out, &temp, TRUE);
return TRUE; // TRUE = thrown
}
//
// Frame_For_Stack_Level: C
//
// Level can be an UNSET!, an INTEGER!, an ANY-FUNCTION!, or a FRAME!. If
// level is UNSET! then it means give whatever the first call found is.
//
// Returns NULL if the given level number does not correspond to a running
// function on the stack.
//
// Can optionally give back the index number of the stack level (counting
// where the most recently pushed stack level is the lowest #)
//
// !!! Unfortunate repetition of logic inside of BACKTRACE; find a way to
// unify the logic for omitting things like breakpoint frames, or either
// considering pending frames or not...
//
struct Reb_Frame *Frame_For_Stack_Level(
REBCNT *number_out,
const REBVAL *level,
REBOOL skip_current
) {
struct Reb_Frame *frame = FS_TOP;
REBOOL first = TRUE;
REBINT num = 0;
if (IS_INTEGER(level)) {
if (VAL_INT32(level) < 0) {
//
// !!! fail() here, or just return NULL?
//
return NULL;
}
}
// We may need to skip some number of frames, if there have been stack
// levels added since the numeric reference point that "level" was
// supposed to refer to has changed. For now that's only allowed to
// be one level, because it's rather fuzzy which stack levels to
// omit otherwise (pending? parens?)
//
if (skip_current)
frame = frame->prior;
for (; frame != NULL; frame = frame->prior) {
if (frame->mode != CALL_MODE_FUNCTION) {
//
// Don't consider pending calls, or GROUP!, or any non-invoked
// function as a candidate to target.
//
// !!! The inability to target a GROUP! by number is an artifact
// of implementation, in that there's no hook in Do_Core() at
// the point of group evaluation to process the return. The
// matter is different with a pending function call, because its
// arguments are only partially processed--hence something
// like a RESUME/AT or an EXIT/FROM would not know which array
// index to pick up running from.
//
continue;
}
if (first) {
if (
IS_FUNCTION_AND(FUNC_VALUE(frame->func), FUNC_CLASS_NATIVE)
&& (
FUNC_CODE(frame->func) == &N_pause
|| FUNC_CODE(frame->func) == N_breakpoint
)
) {
// this is considered the "0". Return it only if 0 was requested
// specifically (you don't "count down to it");
//
if (IS_INTEGER(level) && num == VAL_INT32(level))
goto return_maybe_set_number_out;
else {
first = FALSE;
continue;
}
}
else {
++num; // bump up from 0
}
}
if (IS_INTEGER(level) && num == VAL_INT32(level))
goto return_maybe_set_number_out;
first = FALSE;
if (frame->mode != CALL_MODE_FUNCTION) {
//
// Pending frames don't get numbered
//
continue;
}
if (IS_UNSET(level) || IS_NONE(level)) {
//
// Take first actual frame if unset or none
//
goto return_maybe_set_number_out;
}
else if (IS_INTEGER(level)) {
++num;
if (num == VAL_INT32(level))
goto return_maybe_set_number_out;
}
else if (IS_FRAME(level)) {
if (
(frame->flags & DO_FLAG_FRAME_CONTEXT)
&& frame->data.context == VAL_CONTEXT(level)
) {
goto return_maybe_set_number_out;
}
}
else {
assert(IS_FUNCTION(level));
if (VAL_FUNC(level) == frame->func)
goto return_maybe_set_number_out;
}
}
// Didn't find it...
//
return NULL;
return_maybe_set_number_out:
if (number_out)
*number_out = num;
return frame;
}
*/ 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
}
*/ void Assert_Frame_Core(REBSER *frame)
/*
***********************************************************************/
{
REBINT n;
REBVAL *value;
REBSER *words;
REBVAL *word;
REBINT tail;
REBVAL *frame_value; // "FRAME!-typed value" at head of "frame" series
frame_value = BLK_HEAD(frame);
if (!IS_FRAME(frame_value)) Panic_Series(frame);
if ((frame == VAL_SERIES(ROOT_ROOT)) || (frame == Task_Series)) {
// !!! Currently it is allowed that the root frames not
// have a wordlist. This distinct behavior accomodation is
// not worth having the variance of behavior, but since
// it's there for now... allow it for just those two.
if(!FRM_WORD_SERIES(frame))
return;
}
value = FRM_VALUES(frame);
words = FRM_WORD_SERIES(frame);
word = FRM_WORDS(frame);
tail = SERIES_TAIL(frame);
for (n = 0; n < tail; n++, value++, word++) {
if (n == 0) {
if (
VAL_WORD_SYM(word) != SYM_SELF
&& VAL_WORD_SYM(word) != SYM_NOT_USED
) {
Debug_Fmt("** First slot in frame is not SELF or null symbol");
Panic_Series(frame);
}
}
if (IS_END(word) || IS_END(value)) {
Debug_Fmt(
"** Early %s end at index: %d",
IS_END(word) ? "word" : "value",
n
);
Panic_Series(frame);
}
if (!ANY_WORD(word)) {
Debug_Fmt("** Non-word in word list, type: %d\n", VAL_TYPE(word));
Panic_Series(words);
}
if (!VAL_GET_EXT(word, EXT_WORD_TYPED)) {
Debug_Fmt("** Frame words contains non-'typed'-word");
Panic_Series(words);
}
}
if (NOT_END(word) || NOT_END(value)) {
Debug_Fmt(
"** Missing %s end at index: %d type: %d",
NOT_END(word) ? "word" : "value",
n,
VAL_TYPE(word)
);
Panic_Series(frame);
}
}
