x*/ REBRXT Do_Callback(REBSER *obj, u32 name, RXIARG *rxis, 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;
struct Reb_Call *call;
REBCNT len;
REBCNT n;
REBVAL label;
REBVAL out;
// 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;
}
// Create stack frame (use prior stack frame for location info):
SET_TRASH_SAFE(&out); // OUT slot for function eval result
Val_Init_Word_Unbound(&label, REB_WORD, name);
call = Make_Call(
&out,
VAL_SERIES(DSF_WHERE(PRIOR_DSF(DSF))),
VAL_INDEX(DSF_WHERE(PRIOR_DSF(DSF))),
&label,
val
);
obj = VAL_FUNC_PARAMLIST(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++) {
REBVAL *arg = DSF_ARG(call, n);
if (n <= RXI_COUNT(rxis))
RXI_To_Value(arg, rxis[n], RXI_TYPE(rxis, n));
else
SET_NONE(arg);
// Check type for word at the given offset:
if (!TYPE_CHECK(BLK_SKIP(obj, n), VAL_TYPE(arg))) {
result->i2.int32b = n;
SET_EXT_ERROR(result, RXE_BAD_ARGS);
Free_Call(call);
return 0;
}
}
// Evaluate the function:
if (Dispatch_Call_Throws(call)) {
// !!! Does this need handling such that there is a way for the thrown
// value to "bubble up" out of the callback, or is an error sufficient?
fail (Error_No_Catch_For_Throw(DSF_OUT(call)));
}
// Return resulting value from output
*result = Value_To_RXI(&out);
return Reb_To_RXT[VAL_TYPE(&out)];
}
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))];
}
