*/ REBSER *Make_Object(REBSER *parent, REBVAL *block)
/*
** Create an object from a parent object and a spec block.
** The words within the resultant object are not bound.
**
***********************************************************************/
{
REBSER *words;
REBSER *object;
PG_Reb_Stats->Objects++;
if (!block || IS_END(block)) {
object = parent ? Copy_Block_Values(parent, 0, SERIES_TAIL(parent), TS_CLONE) : Make_Frame(0);
} else {
words = Collect_Frame(BIND_ONLY, parent, block); // GC safe
object = Create_Frame(words, 0); // GC safe
if (parent) {
if (Reb_Opts->watch_obj_copy)
Debug_Fmt(BOOT_STR(RS_WATCH, 2), SERIES_TAIL(parent) - 1, FRM_WORD_SERIES(object));
// Copy parent values and deep copy blocks and strings:
COPY_VALUES(FRM_VALUES(parent)+1, FRM_VALUES(object)+1, SERIES_TAIL(parent) - 1);
Copy_Deep_Values(object, 1, SERIES_TAIL(object), TS_CLONE);
}
}
//Dump_Frame(object);
return object;
}
static REBSER *Trim_Object(REBSER *obj)
{
REBVAL *val;
REBINT cnt = 0;
REBSER *nobj;
REBVAL *nval;
REBVAL *word;
REBVAL *nwrd;
word = FRM_WORDS(obj)+1;
for (val = FRM_VALUES(obj)+1; NOT_END(val); val++, word++) {
if (VAL_TYPE(val) > REB_NONE && !VAL_GET_OPT(word, OPTS_HIDE))
cnt++;
}
nobj = Make_Frame(cnt);
nval = FRM_VALUES(nobj)+1;
word = FRM_WORDS(obj)+1;
nwrd = FRM_WORDS(nobj)+1;
for (val = FRM_VALUES(obj)+1; NOT_END(val); val++, word++) {
if (VAL_TYPE(val) > REB_NONE && !VAL_GET_OPT(word, OPTS_HIDE)) {
*nval++ = *val;
*nwrd++ = *word;
}
}
SET_END(nval);
SET_END(nwrd);
SERIES_TAIL(nobj) = cnt+1;
SERIES_TAIL(FRM_WORD_SERIES(nobj)) = cnt+1;
return nobj;
}
*/ REBSER *Merge_Frames(REBSER *parent1, REBSER *parent2)
/*
** Create a child frame from two parent frames. Merge common fields.
** Values from the second parent take precedence.
**
** Deep copy and rebind the child.
**
***********************************************************************/
{
REBSER *wrds;
REBSER *child;
REBVAL *words;
REBVAL *value;
REBCNT n;
REBINT *binds = WORDS_HEAD(Bind_Table);
// Merge parent1 and parent2 words.
// Keep the binding table.
Collect_Start(BIND_ALL);
// Setup binding table and BUF_WORDS with parent1 words:
if (parent1) Collect_Object(parent1);
// Add parent2 words to binding table and BUF_WORDS:
Collect_Words(BLK_SKIP(FRM_WORD_SERIES(parent2), 1), BIND_ALL);
// Allocate child (now that we know the correct size):
wrds = Copy_Series(BUF_WORDS);
child = Make_Block(SERIES_TAIL(wrds));
value = Append_Value(child);
VAL_SET(value, REB_FRAME);
VAL_FRM_WORDS(value) = wrds;
VAL_FRM_SPEC(value) = 0;
// Copy parent1 values:
COPY_VALUES(FRM_VALUES(parent1)+1, FRM_VALUES(child)+1, SERIES_TAIL(parent1)-1);
// Copy parent2 values:
words = FRM_WORDS(parent2)+1;
value = FRM_VALUES(parent2)+1;
for (; NOT_END(words); words++, value++) {
// no need to search when the binding table is available
n = binds[VAL_WORD_CANON(words)];
BLK_HEAD(child)[n] = *value;
}
// Terminate the child frame:
SERIES_TAIL(child) = SERIES_TAIL(wrds);
BLK_TERM(child);
// Deep copy the child
Copy_Deep_Values(child, 1, SERIES_TAIL(child), TS_CLONE);
// Rebind the child
Rebind_Block(parent1, child, BLK_SKIP(child, 1), REBIND_FUNC);
Rebind_Block(parent2, child, BLK_SKIP(child, 1), REBIND_FUNC | REBIND_TABLE);
// release the bind table
Collect_End(wrds);
return child;
}
*/ 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;
}
*/ REBVAL *Of_Type(REBVAL *value)
/*
** Returns the datatype value for the given value.
** The datatypes are all at the head of the context.
**
***********************************************************************/
{
return FRM_VALUES(Lib_Context) + VAL_TYPE(value) + 1;
}
*/ REBVAL *Get_Field(REBSER *obj, REBCNT index)
/*
** Get an instance variable from an object series.
**
***********************************************************************/
{
ASSERT1(index < SERIES_TAIL(obj), RP_BAD_OBJ_INDEX);
return FRM_VALUES(obj) + index;
}
*/ REBVAL *Get_Type(REBCNT index)
/*
** Returns the specified datatype value from the system context.
** The datatypes are all at the head of the context.
**
***********************************************************************/
{
ASSERT(index < SERIES_TAIL(Lib_Context), RP_BAD_OBJ_INDEX);
return FRM_VALUES(Lib_Context) + index + 1;
}
*/ 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);
}
*/ 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;
}
*/ void Set_Object_Values(REBSER *obj, REBVAL *vals)
/*
***********************************************************************/
{
REBVAL *value;
for (value = FRM_VALUES(obj) + 1; NOT_END(value); value++) { // skip self
if (IS_END(vals)) SET_NONE(value);
else *value = *vals++;
}
}
*/ REBSER *Merge_Frames(REBSER *parent, REBSER *child)
/*
** Create a frame from two frames. Merge common fields.
** Values from the second frame take precedence. No rebinding.
**
***********************************************************************/
{
REBSER *wrds;
REBSER *frame;
REBVAL *words;
REBVAL *value;
REBCNT n;
// Merge parent and child words. This trick works because the
// word list is itself a valid block.
wrds = Collect_Frame(BIND_ALL, parent, BLK_SKIP(FRM_WORD_SERIES(child),1));
// Allocate frame (now that we know the correct size):
frame = Make_Block(SERIES_TAIL(wrds)); // GC!!!
value = Append_Value(frame);
VAL_SET(value, REB_FRAME);
VAL_FRM_WORDS(value) = wrds;
VAL_FRM_SPEC(value) = 0;
// Copy parent values:
COPY_VALUES(FRM_VALUES(parent)+1, FRM_VALUES(frame)+1, SERIES_TAIL(parent)-1);
// Copy new words and values:
words = FRM_WORDS(child)+1;
value = FRM_VALUES(child)+1;
for (; NOT_END(words); words++, value++) {
n = Find_Word_Index(frame, VAL_BIND_SYM(words), FALSE);
if (n) BLK_HEAD(frame)[n] = *value;
}
// Terminate the new frame:
SERIES_TAIL(frame) = SERIES_TAIL(wrds);
BLK_TERM(frame);
return frame;
}
*/ static void Scan_Error(REBCNT errnum, SCAN_STATE *ss, REBCNT tkn, REBYTE *arg, REBCNT size, REBVAL *relax)
/*
** Scanner error handler
**
***********************************************************************/
{
ERROR_OBJ *error;
REBSER *errs;
REBYTE *name;
REBYTE *cp;
REBYTE *bp;
REBSER *ser;
REBCNT len = 0;
ss->errors++;
if (PG_Boot_Strs)
name = BOOT_STR(RS_SCAN,tkn);
else
name = (REBYTE*)"boot";
cp = ss->head_line;
while (IS_LEX_SPACE(*cp)) cp++; // skip indentation
bp = cp;
while (NOT_NEWLINE(*cp)) cp++, len++;
//DISABLE_GC;
errs = Make_Error(errnum, 0, 0, 0);
error = (ERROR_OBJ *)FRM_VALUES(errs);
ser = Make_Binary(len + 16);
Append_Bytes(ser, "(line ");
Append_Int(ser, ss->line_count);
Append_Bytes(ser, ") ");
Append_Series(ser, (REBYTE*)bp, len);
Set_String(&error->nearest, ser);
Set_String(&error->arg1, Copy_Bytes(name, -1));
Set_String(&error->arg2, Copy_Bytes(arg, size));
if (relax) {
SET_ERROR(relax, errnum, errs);
//ENABLE_GC;
return;
}
Throw_Error(errs); // ENABLE_GC implied
}
*/ void Check_Frame(REBSER *frame)
/*
***********************************************************************/
{
REBINT n;
REBVAL *values = FRM_VALUES(frame);
REBVAL *words = FRM_WORDS(frame);
REBINT tail = SERIES_TAIL(frame);
for (n = 0; n < tail; n++, values++, words++) {
if (IS_END(words) || IS_END(values)) {
Debug_Fmt("** Early %s end at index: %d", IS_END(words) ? "words" : "values", n);
}
}
if (NOT_END(words) || NOT_END(values))
Debug_Fmt("** Missing %s end at index: %d type: %d", NOT_END(words) ? "words" : "values", n, VAL_TYPE(words));
}
RL_API int RL_Set_Field(REBSER *obj, u32 word, RXIARG val, int type)
/*
** Set a field (context variable) of an object.
**
** Returns:
** The type arg, or zero if word not found in object or if field is protected.
** Arguments:
** obj - object pointer (e.g. from RXA_OBJECT)
** word - global word identifier (integer)
** val - new value for field
** type - datatype of value
*/
{
REBVAL value = {0};
if (!(word = Find_Word_Index(obj, word, FALSE))) return 0;
if (VAL_PROTECTED(FRM_WORDS(obj)+word)) return 0; // Trap1(RE_LOCKED_WORD, word);
RXI_To_Value(FRM_VALUES(obj)+word, val, type);
return type;
}
*/ 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);
}
*/ 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;
}
*/ 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;
}
xx*/ void Dump_Frame(REBSER *frame, REBINT limit)
/*
***********************************************************************/
{
REBINT n;
REBVAL *values = FRM_VALUES(frame);
REBVAL *words = FRM_WORDS(frame);
if (limit == -1 || limit > (REBINT)SERIES_TAIL(frame))
limit = SERIES_TAIL(frame);
Debug_Fmt("Frame: %x len = %d", frame, SERIES_TAIL(frame));
for (n = 0; n < limit; n++, values++, words++) {
Debug_Fmt(" %02d: %s (%s) [%s]",
n,
Get_Sym_Name(VAL_BIND_SYM(words)),
Get_Sym_Name(VAL_BIND_CANON(words)),
Get_Type_Name(values)
);
}
if (limit >= (REBINT)SERIES_TAIL(frame) && NOT_END(words))
Debug_Fmt("** Word list not terminated! Type: %d, Tail: %d", VAL_TYPE(words), SERIES_TAIL(frame));
}
*/ 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);
}
*/ static REBINT Do_Cmd(REBDIA *dia)
/*
** Returns the length of command processed or error. See below.
**
***********************************************************************/
{
REBVAL *fargs;
REBINT size;
REBVAL *val;
REBINT err;
REBINT n;
// Get formal arguments block for this command:
fargs = FRM_VALUES(dia->dialect) + dia->cmd;
if (!IS_BLOCK(fargs)) return -REB_DIALECT_BAD_SPEC;
dia->fargs = VAL_SERIES(fargs);
fargs = VAL_BLK_DATA(fargs);
size = Count_Dia_Args(fargs); // approximate
// Preallocate output block (optimize for large blocks):
if (dia->len > size) size = dia->len;
if (GET_FLAG(dia->flags, RDIA_ALL)) {
Extend_Series(dia->out, size+1);
}
else {
Resize_Series(dia->out, size+1); // tail = 0
CLEAR_SERIES(dia->out); // Be sure it is entirely cleared
}
// Insert command word:
if (!GET_FLAG(dia->flags, RDIA_NO_CMD)) {
val = Append_Value(dia->out);
Set_Word(val, FRM_WORD_SYM(dia->dialect, dia->cmd), dia->dialect, dia->cmd);
if (GET_FLAG(dia->flags, RDIA_LIT_CMD)) VAL_SET(val, REB_LIT_WORD);
dia->outi++;
size++;
}
if (dia->cmd > 1) dia->argi++; // default cmd has no word arg
// Foreach argument provided:
for (n = dia->len; n > 0; n--, dia->argi++) {
val = Eval_Arg(dia);
if (!val)
return -REB_DIALECT_BAD_ARG;
if (IS_END(val)) break;
if (!IS_NONE(val)) {
//Print("n %d len %d argi %d", n, dia->len, dia->argi);
err = Add_Arg(dia, val); // 1: good, 0: no-type, -N: error
if (err == 0) return n; // remainder
if (err < 0) return err;
}
}
// If not enough args, pad with NONE values:
if (dia->cmd > 1) {
for (n = SERIES_TAIL(dia->out); n < size; n++) {
Append_Value(dia->out);
}
}
dia->outi = SERIES_TAIL(dia->out);
return 0;
}
*/ 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);
}
}
*/ REBSER *Make_Object(REBSER *parent, REBVAL value[])
/*
** Create an object from a parent object and a spec block.
** The words within the resultant object are not bound.
**
***********************************************************************/
{
REBSER *words;
REBSER *object;
PG_Reb_Stats->Objects++;
if (!value || IS_END(value)) {
if (parent) {
object = Copy_Array_Core_Managed(
parent, 0, SERIES_TAIL(parent), TRUE, TS_CLONE
);
}
else {
object = Make_Frame(0, TRUE);
MANAGE_FRAME(object);
}
}
else {
words = Collect_Frame(parent, &value[0], BIND_ONLY); // GC safe
object = Create_Frame(words, 0); // GC safe
if (parent) {
if (Reb_Opts->watch_obj_copy)
Debug_Fmt(cs_cast(BOOT_STR(RS_WATCH, 2)), SERIES_TAIL(parent) - 1, FRM_WORD_SERIES(object));
// Bitwise copy parent values (will have bits fixed by Clonify)
memcpy(
FRM_VALUES(object) + 1,
FRM_VALUES(parent) + 1,
(SERIES_TAIL(parent) - 1) * sizeof(REBVAL)
);
// For values we copied that were blocks and strings, replace
// their series components with deep copies of themselves:
Clonify_Values_Len_Managed(
BLK_SKIP(object, 1), SERIES_TAIL(object) - 1, TRUE, TS_CLONE
);
// The *word series* might have been reused from the parent,
// based on whether any words were added, or we could have gotten
// a fresh one back. Force our invariant here (as the screws
// tighten...)
ENSURE_SERIES_MANAGED(FRM_WORD_SERIES(object));
MANAGE_SERIES(object);
}
else {
MANAGE_FRAME(object);
}
assert(words == FRM_WORD_SERIES(object));
}
ASSERT_SERIES_MANAGED(object);
ASSERT_SERIES_MANAGED(FRM_WORD_SERIES(object));
ASSERT_FRAME(object);
return object;
}
*/ 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;
}
}
}
*/ 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;
}
