*/ void Dump_Stack(REBINT dsf, REBINT dsp)
/*
***********************************************************************/
{
REBINT n;
REBINT m;
REBVAL *args;
if (dsf == 0) {
dsf = DSF;
dsp = DSP;
}
m = dsp - dsf - DSF_SIZE;
Debug_Fmt(BOOT_STR(RS_STACK, 1), dsp, Get_Word_Name(DSF_WORD(dsf)), m, Get_Type_Name(DSF_FUNC(dsf)));
if (dsf > 0) {
if (ANY_FUNC(DSF_FUNC(dsf))) {
args = BLK_HEAD(VAL_FUNC_ARGS(DSF_FUNC(dsf)));
m = SERIES_TAIL(VAL_FUNC_ARGS(DSF_FUNC(dsf)));
for (n = 1; n < m; n++)
Debug_Fmt("\t%s: %72r", Get_Word_Name(args+n), DSF_ARGS(dsf, n));
}
//Debug_Fmt(Str_Stack[2], PRIOR_DSF(dsf));
if (PRIOR_DSF(dsf) > 0) Dump_Stack(PRIOR_DSF(dsf), dsf-1);
}
//for (n = 1; n <= 2; n++) {
// Debug_Fmt(" ARG%d: %s %r", n, Get_Type_Name(DSF_ARGS(dsf, n)), DSF_ARGS(dsf, n));
//}
}
*/ void Get_Var_Into_Core(REBVAL *out, const REBVAL *word)
/*
** Variant of Get_Var_Core that always traps and never returns a
** direct pointer into a frame. It is thus able to give back
** `self` lookups, and doesn't have to check the word's protection
** status before returning.
**
** See comments in Get_Var_Core for what it's actually doing.
**
***********************************************************************/
{
REBSER *context = VAL_WORD_FRAME(word);
if (context) {
REBINT index = VAL_WORD_INDEX(word);
if (index > 0) {
*out = *(FRM_VALUES(context) + index);
assert(!IS_TRASH(out));
assert(!THROWN(out));
return;
}
if (index < 0) {
struct Reb_Call *call = DSF;
while (call) {
if (
call->args_ready
&& context == VAL_FUNC_WORDS(DSF_FUNC(call))
) {
assert(!IS_CLOSURE(DSF_FUNC(call)));
*out = *DSF_ARG(call, -index);
assert(!IS_TRASH(out));
assert(!THROWN(out));
return;
}
call = PRIOR_DSF(call);
}
raise Error_1(RE_NO_RELATIVE, word);
}
// Key difference between Get_Var_Into and Get_Var...fabricating
// an object REBVAL.
// !!! Could fake function frames stow the function value itself
// so 'binding-of' can return it and use for binding (vs. TRUE)?
assert(!IS_SELFLESS(context));
Val_Init_Object(out, context);
return;
}
raise Error_1(RE_NOT_DEFINED, word);
}
*/ void Bind_Stack_Block(REBSER *body, REBSER *block)
/*
***********************************************************************/
{
REBINT dsf = DSF;
// Find body (frame) on stack:
while (body != VAL_WORD_FRAME(DSF_WORD(dsf))) {
dsf = PRIOR_DSF(dsf);
if (dsf <= 0) Trap0(RE_NOT_DEFINED); // better message !!!!
}
if (IS_FUNCTION(DSF_FUNC(dsf))) {
Bind_Relative(VAL_FUNC_ARGS(DSF_FUNC(dsf)), body, block);
}
}
*/ void Bind_Stack_Word(REBSER *body, REBVAL *word)
/*
***********************************************************************/
{
REBINT dsf = DSF;
REBINT index;
// Find body (frame) on stack:
while (body != VAL_WORD_FRAME(DSF_WORD(dsf))) {
dsf = PRIOR_DSF(dsf);
if (dsf <= 0) Trap1(RE_NOT_IN_CONTEXT, word);
}
if (IS_FUNCTION(DSF_FUNC(dsf))) {
index = Find_Arg_Index(VAL_FUNC_ARGS(DSF_FUNC(dsf)), VAL_WORD_SYM(word));
if (!index) Trap1(RE_NOT_IN_CONTEXT, word);
VAL_WORD_FRAME(word) = body;
VAL_WORD_INDEX(word) = -index;
} else
Crash(9100); // !!! function is not there!
}
x*/ int Do_Callback(REBSER *obj, u32 name, RXIARG *args, RXIARG *result)
/*
** Given an object and a word id, call a REBOL function.
** The arguments are converted from extension format directly
** to the data stack. The result is passed back in ext format,
** with the datatype returned or zero if there was a problem.
**
***********************************************************************/
{
REBVAL *val;
REBCNT dsf;
REBCNT len;
REBCNT n;
REBCNT dsp = DSP; // to restore stack on errors
// Find word in object, verify it is a function.
if (!(val = Find_Word_Value(obj, name))) {
SET_EXT_ERROR(result, RXE_NO_WORD);
return 0;
}
if (!ANY_FUNC(val)) {
SET_EXT_ERROR(result, RXE_NOT_FUNC);
return 0;
}
// Get block and index from prior function stack frame:
dsf = PRIOR_DSF(DSF);
// Create stack frame (use prior stack frame for location info):
dsf = Push_Func(0, VAL_SERIES(DSF_BACK(dsf)), VAL_INDEX(DSF_BACK(dsf)), name, val);
val = DSF_FUNC(dsf); // for safety from GC
obj = VAL_FUNC_WORDS(val); // func words
len = SERIES_TAIL(obj)-1; // number of args (may include locals)
// Push args. Too short or too long arg frames are handled W/O error.
// Note that refinements args can be set to anything.
for (n = 1; n <= len && n <= RXI_COUNT(args); n++) {
DS_SKIP;
RXI_To_Value(DS_TOP, args[n], RXI_TYPE(args, n));
// Check type for word at the given offset:
if (!TYPE_CHECK(BLK_SKIP(obj, n), VAL_TYPE(DS_TOP))) {
result->int32b = n;
SET_EXT_ERROR(result, RXE_BAD_ARGS);
DSP = dsp;
return 0;
}
}
// Fill with NONE if necessary:
for (; n <= len; n++) {
DS_SKIP;
SET_NONE(DS_TOP);
if (!TYPE_CHECK(BLK_SKIP(obj, n), VAL_TYPE(DS_TOP))) {
result->int32b = n;
SET_EXT_ERROR(result, RXE_BAD_ARGS);
DSP = dsp;
return 0;
}
}
// Evaluate the function:
DSF = dsf;
Func_Dispatch[VAL_TYPE(val) - REB_NATIVE](val);
DSF = PRIOR_DSF(dsf);
DSP = dsf-1;
// Return resulting value from TOS1 (volatile location):
*result = Value_To_RXI(DS_VALUE(dsf));
return Reb_To_RXT[VAL_TYPE(DS_VALUE(dsf))];
}
*/ REBVAL *Get_Var_Core(const REBVAL *word, REBOOL trap, REBOOL writable)
/*
** Get the word--variable--value. (Generally, use the macros like
** GET_VAR or GET_MUTABLE_VAR instead of this). This routine is
** called quite a lot and so attention to performance is important.
**
** Coded assuming most common case is trap=TRUE and writable=FALSE
**
***********************************************************************/
{
REBSER *context = VAL_WORD_FRAME(word);
if (context) {
REBINT index = VAL_WORD_INDEX(word);
// POSITIVE INDEX: The word is bound directly to a value inside
// a frame, and represents the zero-based offset into that series.
// This is how values would be picked out of object-like things...
// (Including looking up 'append' in the user context.)
if (index > 0) {
REBVAL *value;
if (
writable &&
VAL_GET_EXT(FRM_WORDS(context) + index, EXT_WORD_LOCK)
) {
if (trap) raise Error_1(RE_LOCKED_WORD, word);
return NULL;
}
value = FRM_VALUES(context) + index;
assert(!THROWN(value));
return value;
}
// NEGATIVE INDEX: Word is stack-relative bound to a function with
// no persistent frame held by the GC. The value *might* be found
// on the stack (or not, if all instances of the function on the
// call stack have finished executing). We walk backward in the call
// stack to see if we can find the function's "identifying series"
// in a call frame...and take the first instance we see (even if
// multiple invocations are on the stack, most recent wins)
if (index < 0) {
struct Reb_Call *call = DSF;
// Get_Var could theoretically be called with no evaluation on
// the stack, so check for no DSF first...
while (call) {
if (
call->args_ready
&& context == VAL_FUNC_WORDS(DSF_FUNC(call))
) {
REBVAL *value;
assert(!IS_CLOSURE(DSF_FUNC(call)));
if (
writable &&
VAL_GET_EXT(
VAL_FUNC_PARAM(DSF_FUNC(call), -index),
EXT_WORD_LOCK
)
) {
if (trap) raise Error_1(RE_LOCKED_WORD, word);
return NULL;
}
value = DSF_ARG(call, -index);
assert(!THROWN(value));
return value;
}
call = PRIOR_DSF(call);
}
if (trap) raise Error_1(RE_NO_RELATIVE, word);
return NULL;
}
// ZERO INDEX: The word is SELF. Although the information needed
// to produce an OBJECT!-style REBVAL lives in the zero offset
// of the frame, it's not a value that we can return a direct
// pointer to. Use GET_VAR_INTO instead for that.
assert(!IS_SELFLESS(context));
if (trap) raise Error_0(RE_SELF_PROTECTED);
return NULL; // is this a case where we should *always* trap?
}
if (trap) raise Error_1(RE_NOT_DEFINED, word);
return NULL;
}
