*/ REBVAL *Get_Var_Safe(REBVAL *word)
/*
** Get the word, but check if it will be safe to modify.
**
***********************************************************************/
{
REBINT index = VAL_WORD_INDEX(word);
REBSER *frame = VAL_WORD_FRAME(word);
REBINT dsf;
if (!frame) Trap1(RE_NOT_DEFINED, word);
if (index >= 0) {
if (VAL_PROTECTED(FRM_WORDS(frame) + index))
Trap1(RE_LOCKED_WORD, word);
return FRM_VALUES(frame) + index;
}
// A negative index indicates that the value is in a frame on
// the data stack, so now we must find it by walking back the
// stack looking for the function that the word is bound to.
dsf = DSF;
while (frame != VAL_WORD_FRAME(DSF_WORD(dsf))) {
dsf = PRIOR_DSF(dsf);
if (dsf <= 0) Trap1(RE_NOT_DEFINED, word); // change error !!!
}
// if (Trace_Level) Dump_Stack_Frame(dsf);
return DSF_ARGS(dsf, -index);
}
*/ void Set_Var(REBVAL *word, REBVAL *value)
/*
** Set the word (variable) value. (Use macro when possible).
**
***********************************************************************/
{
REBINT index = VAL_WORD_INDEX(word);
REBINT dsf;
REBSER *frm;
if (!HAS_FRAME(word)) Trap1(RE_NOT_DEFINED, word);
// ASSERT(index, RP_BAD_SET_INDEX);
ASSERT(VAL_WORD_FRAME(word), RP_BAD_SET_CONTEXT);
// Print("Set %s to %s [frame: %x idx: %d]", Get_Word_Name(word), Get_Type_Name(value), VAL_WORD_FRAME(word), VAL_WORD_INDEX(word));
if (index > 0) {
frm = VAL_WORD_FRAME(word);
if (VAL_PROTECTED(FRM_WORDS(frm)+index))
Trap1(RE_LOCKED_WORD, word);
FRM_VALUES(frm)[index] = *value;
return;
}
if (index == 0) Trap0(RE_SELF_PROTECTED);
// Find relative value:
dsf = DSF;
while (VAL_WORD_FRAME(word) != VAL_WORD_FRAME(DSF_WORD(dsf))) {
dsf = PRIOR_DSF(dsf);
if (dsf <= 0) Trap1(RE_NOT_DEFINED, word); // change error !!!
}
*DSF_ARGS(dsf, -index) = *value;
}
*/ void Set_Var(const REBVAL *word, const REBVAL *value)
/*
** Set the word (variable) value. (Use macro when possible).
**
***********************************************************************/
{
REBINT index = VAL_WORD_INDEX(word);
struct Reb_Call *call;
REBSER *frm;
assert(!THROWN(value));
if (!HAS_FRAME(word)) raise Error_1(RE_NOT_DEFINED, word);
assert(VAL_WORD_FRAME(word));
// Print("Set %s to %s [frame: %x idx: %d]", Get_Word_Name(word), Get_Type_Name(value), VAL_WORD_FRAME(word), VAL_WORD_INDEX(word));
if (index > 0) {
frm = VAL_WORD_FRAME(word);
if (VAL_GET_EXT(FRM_WORDS(frm) + index, EXT_WORD_LOCK))
raise Error_1(RE_LOCKED_WORD, word);
FRM_VALUES(frm)[index] = *value;
return;
}
if (index == 0) raise Error_0(RE_SELF_PROTECTED);
// Find relative value:
call = DSF;
while (VAL_WORD_FRAME(word) != VAL_WORD_FRAME(DSF_LABEL(call))) {
call = PRIOR_DSF(call);
if (!call) raise Error_1(RE_NOT_DEFINED, word); // change error !!!
}
*DSF_ARG(call, -index) = *value;
}
*/ static void Bind_Block_Words(REBSER *frame, REBVAL *value, REBCNT mode)
/*
** Inner loop of bind block. Modes are:
**
** BIND_ONLY Only bind the words found in the frame.
** BIND_SET Add set-words to the frame during the bind.
** BIND_ALL Add words to the frame during the bind.
** BIND_DEEP Recurse into sub-blocks.
**
** NOTE: BIND_SET must be used carefully, because it does not
** bind prior instances of the word before the set-word. That is
** forward references are not allowed.
**
***********************************************************************/
{
REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
REBCNT n;
REBFLG selfish = !IS_SELFLESS(frame);
for (; NOT_END(value); value++) {
if (ANY_WORD(value)) {
//Print("Word: %s", Get_Sym_Name(VAL_WORD_CANON(value)));
// Is the word found in this frame?
if (NZ(n = binds[VAL_WORD_CANON(value)])) {
if (n == NO_RESULT) n = 0; // SELF word
ASSERT1(n < SERIES_TAIL(frame), RP_BIND_BOUNDS);
// Word is in frame, bind it:
VAL_WORD_INDEX(value) = n;
VAL_WORD_FRAME(value) = frame;
}
else if (selfish && VAL_WORD_CANON(value) == SYM_SELF) {
VAL_WORD_INDEX(value) = 0;
VAL_WORD_FRAME(value) = frame;
}
else {
// Word is not in frame. Add it if option is specified:
if ((mode & BIND_ALL) || ((mode & BIND_SET) && (IS_SET_WORD(value)))) {
Append_Frame(frame, value, 0);
binds[VAL_WORD_CANON(value)] = VAL_WORD_INDEX(value);
}
}
}
else if (ANY_BLOCK(value) && (mode & BIND_DEEP))
Bind_Block_Words(frame, VAL_BLK_DATA(value), mode);
else if ((IS_FUNCTION(value) || IS_CLOSURE(value)) && (mode & BIND_FUNC))
Bind_Block_Words(frame, BLK_HEAD(VAL_FUNC_BODY(value)), mode);
}
}
xx*/ void Dump_Word_Value(REBVAL *word)
/*
***********************************************************************/
{
Debug_Fmt("Word: %s (Symbol %d Frame %x Index %d)", Get_Word_Name(word),
VAL_WORD_SYM(word), VAL_WORD_FRAME(word), VAL_WORD_INDEX(word));
}
*/ REBVAL *Append_Frame(REBSER *frame, REBVAL *word, REBCNT sym)
/*
** Append a word to the frame word list. Expands the list
** if necessary. Returns the value cell for the word. (Set to
** UNSET by default to avoid GC corruption.)
**
** If word is not NULL, use the word sym and bind the word value,
** otherwise use sym.
**
***********************************************************************/
{
REBSER *words = FRM_WORD_SERIES(frame);
REBVAL *value;
// Add to word list:
EXPAND_SERIES_TAIL(words, 1);
value = BLK_LAST(words);
Val_Init_Word_Typed(value, REB_WORD, word ? VAL_WORD_SYM(word) : sym, ALL_64);
BLK_TERM(words);
// Bind the word to this frame:
if (word) {
VAL_WORD_FRAME(word) = frame;
VAL_WORD_INDEX(word) = frame->tail;
}
// Add unset value to frame:
EXPAND_SERIES_TAIL(frame, 1);
word = BLK_LAST(frame);
SET_UNSET(word);
BLK_TERM(frame);
return word; // The value cell for word.
}
*/ void Rebind_Block(REBSER *frame_src, REBSER *frame_dst, REBSER *block)
/*
** Rebind all words that reference src frame to dst frame.
** Rebind is always deep.
**
***********************************************************************/
{
REBVAL *value;
for (value = BLK_HEAD(block); NOT_END(value); value++) {
if (ANY_BLOCK(value)) Rebind_Block(frame_src, frame_dst, VAL_SERIES(value));
else if (ANY_WORD(value) && VAL_WORD_FRAME(value) == frame_src) {
VAL_WORD_FRAME(value) = frame_dst;
}
}
}
*/ static void Bind_Relative_Words(REBSER *frame, REBSER *block)
/*
** Recursive function for relative function word binding.
**
** Note: frame arg points to an identifying series of the function,
** not a normal frame. This will be used to verify the word fetch.
**
***********************************************************************/
{
REBVAL *value = BLK_HEAD(block);
REBINT n;
for (; NOT_END(value); value++) {
if (ANY_WORD(value)) {
// Is the word (canon sym) found in this frame?
if (NZ(n = WORDS_HEAD(Bind_Table)[VAL_WORD_CANON(value)])) {
// Word is in frame, bind it:
VAL_WORD_INDEX(value) = n;
VAL_WORD_FRAME(value) = frame; // func body
}
}
else if (ANY_BLOCK(value))
Bind_Relative_Words(frame, VAL_SERIES(value));
}
}
*/ void Set_Word(REBVAL *value, REBINT sym, REBSER *frame, REBCNT index)
/*
***********************************************************************/
{
VAL_SET(value, REB_WORD);
VAL_WORD_SYM(value) = sym;
VAL_WORD_FRAME(value) = frame;
VAL_WORD_INDEX(value) = index;
}
*/ static void Bind_Values_Inner_Loop(REBINT *binds, REBVAL value[], REBSER *frame, REBCNT mode)
/*
** Bind_Values_Core() sets up the binding table and then calls
** this recursive routine to do the actual binding.
**
***********************************************************************/
{
REBFLG selfish = !IS_SELFLESS(frame);
for (; NOT_END(value); value++) {
if (ANY_WORD(value)) {
//Print("Word: %s", Get_Sym_Name(VAL_WORD_CANON(value)));
// Is the word found in this frame?
REBCNT n = binds[VAL_WORD_CANON(value)];
if (n != 0) {
if (n == NO_RESULT) n = 0; // SELF word
assert(n < SERIES_TAIL(frame));
// Word is in frame, bind it:
VAL_WORD_INDEX(value) = n;
VAL_WORD_FRAME(value) = frame;
}
else if (selfish && VAL_WORD_CANON(value) == SYM_SELF) {
VAL_WORD_INDEX(value) = 0;
VAL_WORD_FRAME(value) = frame;
}
else {
// Word is not in frame. Add it if option is specified:
if ((mode & BIND_ALL) || ((mode & BIND_SET) && (IS_SET_WORD(value)))) {
Expand_Frame(frame, 1, 1);
Append_Frame(frame, value, 0);
binds[VAL_WORD_CANON(value)] = VAL_WORD_INDEX(value);
}
}
}
else if (ANY_BLOCK(value) && (mode & BIND_DEEP))
Bind_Values_Inner_Loop(
binds, VAL_BLK_DATA(value), frame, mode
);
else if ((IS_FUNCTION(value) || IS_CLOSURE(value)) && (mode & BIND_FUNC))
Bind_Values_Inner_Loop(
binds, BLK_HEAD(VAL_FUNC_BODY(value)), frame, mode
);
}
}
*/ REBVAL *Get_Var_No_Trap(REBVAL *word)
/*
** Same as above, but returns 0 rather than error.
**
***********************************************************************/
{
REBINT index = VAL_WORD_INDEX(word);
REBSER *frame = VAL_WORD_FRAME(word);
REBINT dsf;
if (!frame) return 0;
if (index >= 0) return FRM_VALUES(frame)+index;
dsf = DSF;
while (frame != VAL_WORD_FRAME(DSF_WORD(dsf))) {
dsf = PRIOR_DSF(dsf);
if (dsf <= 0) return 0;
}
return DSF_ARGS(dsf, -index);
}
*/ 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 Init_Word(REBVAL *value, REBCNT sym)
/*
** Initialize a value as a word. Set frame as unbound (no context).
**
***********************************************************************/
{
VAL_SET(value, REB_WORD);
VAL_WORD_INDEX(value) = 0;
VAL_WORD_FRAME(value) = 0;
VAL_WORD_SYM(value) = sym;
}
//
// CT_Word: C
//
REBINT CT_Word(REBVAL *a, REBVAL *b, REBINT mode)
{
REBINT e;
REBINT diff;
if (mode >= 0) {
e = VAL_WORD_CANON(a) == VAL_WORD_CANON(b);
if (mode == 1) e &= VAL_WORD_INDEX(a) == VAL_WORD_INDEX(b)
&& VAL_WORD_FRAME(a) == VAL_WORD_FRAME(b);
else if (mode >= 2) {
e = (VAL_WORD_SYM(a) == VAL_WORD_SYM(b) &&
VAL_WORD_INDEX(a) == VAL_WORD_INDEX(b) &&
VAL_WORD_FRAME(a) == VAL_WORD_FRAME(b));
}
} else {
diff = Compare_Word(a, b, FALSE);
if (mode == -1) e = diff >= 0;
else e = diff > 0;
}
return e;
}
*/ void Bind_Stack_Word(REBSER *frame, REBVAL *word)
/*
***********************************************************************/
{
REBINT index;
index = Find_Arg_Index(frame, VAL_WORD_SYM(word));
if (!index) Trap1(RE_NOT_IN_CONTEXT, word);
VAL_WORD_FRAME(word) = frame;
VAL_WORD_INDEX(word) = -index;
}
*/ 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!
}
*/ static int Find_Command(REBSER *dialect, REBVAL *word)
/*
** Given a word, check to see if it is in the dialect object.
** If so, return its index. If not, return 0.
**
***********************************************************************/
{
REBINT n;
if (dialect == VAL_WORD_FRAME(word)) n = VAL_WORD_INDEX(word);
else {
if (NZ(n = Find_Word_Index(dialect, VAL_WORD_SYM(word), FALSE))) {
VAL_WORD_FRAME(word) = dialect;
VAL_WORD_INDEX(word) = n;
}
else return 0;
}
// If keyword (not command) return negated index:
if (IS_NONE(FRM_VALUES(dialect) + n)) return -n;
return n;
}
*/ REBVAL *Get_Var(REBVAL *word)
/*
** Get the word (variable) value. (Use macro when possible).
**
***********************************************************************/
{
REBINT index = VAL_WORD_INDEX(word);
REBSER *frame = VAL_WORD_FRAME(word);
REBINT dsf;
if (!frame) Trap1(RE_NOT_DEFINED, word);
if (index >= 0) return FRM_VALUES(frame)+index;
// A negative index indicates that the value is in a frame on
// the data stack, so now we must find it by walking back the
// stack looking for the function that the word is bound to.
dsf = DSF;
while (frame != VAL_WORD_FRAME(DSF_WORD(dsf))) {
dsf = PRIOR_DSF(dsf);
if (dsf <= 0) Trap1(RE_NOT_DEFINED, word); // change error !!!
}
// if (Trace_Level) Dump_Stack_Frame(dsf);
return DSF_ARGS(dsf, -index);
}
*/ void Rebind_Block(REBSER *src_frame, REBSER *dst_frame, REBVAL *data, REBFLG modes)
/*
** Rebind all words that reference src frame to dst frame.
** Rebind is always deep.
**
** There are two types of frames: relative frames and normal frames.
** When frame_src type and frame_dst type differ,
** modes must have REBIND_TYPE.
**
***********************************************************************/
{
REBINT *binds = WORDS_HEAD(Bind_Table);
for (; NOT_END(data); data++) {
if (ANY_BLOCK(data))
Rebind_Block(src_frame, dst_frame, VAL_BLK_DATA(data), modes);
else if (ANY_WORD(data) && VAL_WORD_FRAME(data) == src_frame) {
VAL_WORD_FRAME(data) = dst_frame;
if (modes & REBIND_TABLE) VAL_WORD_INDEX(data) = binds[VAL_WORD_CANON(data)];
if (modes & REBIND_TYPE) VAL_WORD_INDEX(data) = - VAL_WORD_INDEX(data);
} else if ((modes & REBIND_FUNC) && (IS_FUNCTION(data) || IS_CLOSURE(data)))
Rebind_Block(src_frame, dst_frame, BLK_HEAD(VAL_FUNC_BODY(data)), modes);
}
}
*/ REBCNT Bind_Word(REBSER *frame, REBVAL *word)
/*
** Binds a word to a frame. If word is not part of the
** frame, ignore it.
**
***********************************************************************/
{
REBCNT n;
n = Find_Word_Index(frame, VAL_WORD_SYM(word), FALSE);
if (n) {
VAL_WORD_FRAME(word) = frame;
VAL_WORD_INDEX(word) = n;
}
return n;
}
*/ void Unbind_Values_Core(REBVAL value[], REBSER *frame, REBOOL deep)
/*
** Unbind words in a block, optionally unbinding those which are
** bound to a particular frame (if frame is NULL, then all
** words will be unbound regardless of their VAL_WORD_FRAME).
**
***********************************************************************/
{
for (; NOT_END(value); value++) {
if (ANY_WORD(value) && (!frame || VAL_WORD_FRAME(value) == frame))
UNBIND_WORD(value);
if (ANY_BLOCK(value) && deep)
Unbind_Values_Core(VAL_BLK_DATA(value), frame, TRUE);
}
}
*/ 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 Protected(REBVAL *word)
/*
** Throw an error if word is protected.
**
***********************************************************************/
{
REBSER *frm;
REBINT index = VAL_WORD_INDEX(word);
if (index > 0) {
frm = VAL_WORD_FRAME(word);
if (VAL_PROTECTED(FRM_WORDS(frm)+index))
Trap1(RE_LOCKED_WORD, word);
}
else if (index == 0) Trap0(RE_SELF_PROTECTED);
}
*/ REBSER *Make_Object_Block(REBSER *frame, REBINT mode)
/*
** Return a block containing words, values, or set-word: value
** pairs for the given object. Note: words are bound to original
** object.
**
** Modes:
** 1 for word
** 2 for value
** 3 for words and values
**
***********************************************************************/
{
REBVAL *words = FRM_WORDS(frame);
REBVAL *values = FRM_VALUES(frame);
REBSER *block;
REBVAL *value;
REBCNT n;
n = (mode & 4) ? 0 : 1;
block = Make_Block(SERIES_TAIL(frame) * (n + 1));
for (; n < SERIES_TAIL(frame); n++) {
if (!VAL_GET_OPT(words+n, OPTS_HIDE)) {
if (mode & 1) {
value = Append_Value(block);
if (mode & 2) {
VAL_SET(value, REB_SET_WORD);
VAL_SET_LINE(value);
}
else VAL_SET(value, REB_WORD); //VAL_TYPE(words+n));
VAL_WORD_SYM(value) = VAL_BIND_SYM(words+n);
VAL_WORD_INDEX(value) = n;
VAL_WORD_FRAME(value) = frame;
}
if (mode & 2) {
Append_Val(block, values+n);
}
}
}
return block;
}
x*/ void RXI_To_Value(REBVAL *val, RXIARG arg, REBCNT type)
/*
***********************************************************************/
{
VAL_SET(val, RXT_To_Reb[type]);
switch (RXT_Eval_Class[type]) {
case RXX_64:
VAL_INT64(val) = arg.int64;
break;
case RXX_SER:
VAL_SERIES(val) = cast(REBSER*, arg.sri.series);
VAL_INDEX(val) = arg.sri.index;
break;
case RXX_PTR:
VAL_HANDLE_DATA(val) = arg.addr;
break;
case RXX_32:
VAL_I32(val) = arg.i2.int32a;
break;
case RXX_DATE:
VAL_TIME(val) = NO_TIME;
VAL_ALL_BITS(val)[2] = arg.i2.int32a;
break;
case RXX_SYM:
VAL_WORD_SYM(val) = arg.i2.int32a;
VAL_WORD_FRAME(val) = 0;
VAL_WORD_INDEX(val) = 0;
break;
case RXX_IMAGE:
VAL_SERIES(val) = cast(REBSER*, arg.iwh.image);
VAL_IMAGE_WIDE(val) = arg.iwh.width;
VAL_IMAGE_HIGH(val) = arg.iwh.height;
break;
case RXX_NULL:
VAL_INT64(val) = 0;
break;
default:
SET_NONE(val);
}
}
*/ REBFLG Make_Typeset(REBVAL *block, REBVAL *value, REBFLG load)
/*
** block - block of datatypes (datatype words ok too)
** value - value to hold result (can be word-spec type too)
**
***********************************************************************/
{
const REBVAL *val;
REBCNT sym;
REBSER *types = VAL_SERIES(ROOT_TYPESETS);
VAL_TYPESET(value) = 0;
for (; NOT_END(block); block++) {
val = NULL;
if (IS_WORD(block)) {
//Print("word: %s", Get_Word_Name(block));
sym = VAL_WORD_SYM(block);
if (VAL_WORD_FRAME(block)) { // Get word value
val = GET_VAR(block);
} else if (sym < REB_MAX) { // Accept datatype word
TYPE_SET(value, VAL_WORD_SYM(block)-1);
continue;
} // Special typeset symbols:
else if (sym >= SYM_ANY_TYPEX && sym <= SYM_ANY_BLOCKX)
val = BLK_SKIP(types, sym - SYM_ANY_TYPEX + 1);
}
if (!val) val = block;
if (IS_DATATYPE(val)) {
TYPE_SET(value, VAL_DATATYPE(val));
} else if (IS_TYPESET(val)) {
VAL_TYPESET(value) |= VAL_TYPESET(val);
} else {
if (load) return FALSE;
Trap_Arg_DEAD_END(block);
}
}
return TRUE;
}
*/ REBVAL *Append_Frame(REBSER *frame, REBVAL *word, REBCNT sym)
/*
** Append a word to the frame word list. Expands the list
** if necessary. Returns the value cell for the word. (Set to
** UNSET by default to avoid GC corruption.)
**
** If word is not NULL, use the word sym and bind the word value,
** otherwise use sym.
**
** WARNING: Invalidates pointers to values within the frame
** because the frame block may get expanded. (Use indexes.)
**
***********************************************************************/
{
REBSER *words = FRM_WORD_SERIES(frame);
REBVAL *value;
// Add to word list:
EXPAND_SERIES_TAIL(words, 1);
value = BLK_LAST(words);
if (word) Init_Frame_Word(value, VAL_WORD_SYM(word));
else Init_Frame_Word(value, sym);
BLK_TERM(words);
// Bind the word to this frame:
if (word) {
VAL_WORD_FRAME(word) = frame;
VAL_WORD_INDEX(word) = frame->tail;
}
// Add unset value to frame:
EXPAND_SERIES_TAIL(frame, 1);
word = BLK_LAST(frame);
SET_UNSET(word);
BLK_TERM(frame);
return word; // The value cell for word.
}
xx*/ REBSER *Dump_Value(REBVAL *block, REBSER *series)
/*
** Dump a values's contents for debugging purposes.
**
***********************************************************************/
{
REB_MOLD mo = {0};
mo.digits = 17; // max digits
if (VAL_TYPE(block) >= REB_MAX) Crash(RP_DATATYPE+7, VAL_TYPE(block));
ASSERT2(series, 9997);
mo.series = series;
Emit(&mo, "T: ", block);
Mold_Value(&mo, block, TRUE);
if (ANY_WORD(block)) {
if (!VAL_WORD_FRAME(block)) Append_Bytes(series, " - unbound");
else if (VAL_WORD_INDEX(block) < 0) Append_Bytes(series, " - relative");
else Append_Bytes(series, " - absolute");
}
return series;
}
*/ 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;
}
*/ void Do_Commands(REBSER *cmds, void *context)
/*
** Evaluate a block of commands as efficiently as possible.
** The arguments to each command must already be reduced or
** use only variable lookup.
**
** Returns the last evaluated value, if provided.
**
***********************************************************************/
{
REBVAL *blk;
REBCNT index = 0;
REBVAL *set_word = 0;
REBVAL *cmd_word;
REBSER *words;
REBVAL *args;
REBVAL *val;
REBVAL *func;
RXIFRM frm; // args stored here
REBCNT n;
REBEXT *ext;
REBCEC *ctx;
if ((ctx = context)) ctx->block = cmds;
blk = BLK_HEAD(cmds);
while (NOT_END(blk)) {
// var: command result
if IS_SET_WORD(blk) {
set_word = blk++;
index++;
};
// get command function
if (IS_WORD(cmd_word = blk)) {
// Optimized var fetch:
n = VAL_WORD_INDEX(blk);
if (n > 0) func = FRM_VALUES(VAL_WORD_FRAME(blk)) + n;
else func = Get_Var(blk); // fallback
} else func = blk;
if (!IS_COMMAND(func)) Trap2(RE_EXPECT_VAL, Get_Type_Word(REB_COMMAND), blk);
// Advance to next value
blk++;
if (ctx) ctx->index = index; // position of function
index++;
// get command arguments and body
words = VAL_FUNC_WORDS(func);
RXA_COUNT(&frm) = SERIES_TAIL(VAL_FUNC_ARGS(func))-1; // not self
// collect each argument (arg list already validated on MAKE)
n = 0;
for (args = BLK_SKIP(words, 1); NOT_END(args); args++) {
//Debug_Type(args);
val = blk++;
index++;
if (IS_END(val)) Trap2(RE_NO_ARG, cmd_word, args);
//Debug_Type(val);
// actual arg is a word, lookup?
if (VAL_TYPE(val) >= REB_WORD) {
if (IS_WORD(val)) {
if (IS_WORD(args)) val = Get_Var(val);
}
else if (IS_PATH(val)) {
if (IS_WORD(args)) val = Get_Any_Var(val); // volatile value!
}
else if (IS_PAREN(val)) {
val = Do_Blk(VAL_SERIES(val), 0); // volatile value!
}
// all others fall through
}
// check datatype
if (!TYPE_CHECK(args, VAL_TYPE(val)))
Trap3(RE_EXPECT_ARG, cmd_word, args, Of_Type(val));
// put arg into command frame
n++;
RXA_TYPE(&frm, n) = Reb_To_RXT[VAL_TYPE(val)];
frm.args[n] = Value_To_RXI(val);
}
// Call the command (also supports different extension modules):
func = BLK_HEAD(VAL_FUNC_BODY(func));
n = (REBCNT)VAL_INT64(func + 1);
ext = &Ext_List[VAL_I32(VAL_OBJ_VALUE(func, 1))]; // Handler
n = ext->call(n, &frm, context);
val = DS_RETURN;
switch (n) {
case RXR_VALUE:
RXI_To_Value(val, frm.args[1], RXA_TYPE(&frm, 1));
break;
case RXR_BLOCK:
RXI_To_Block(&frm, val);
break;
case RXR_UNSET:
SET_UNSET(val);
break;
case RXR_NONE:
SET_NONE(val);
break;
case RXR_TRUE:
SET_TRUE(val);
break;
case RXR_FALSE:
SET_FALSE(val);
break;
case RXR_ERROR:
default:
SET_UNSET(val);
}
if (set_word) {
Set_Var(set_word, val);
set_word = 0;
}
}
}
