*/ REBVAL *Find_Error_Info(ERROR_OBJ *error, REBINT *num)
/*
** Return the error message needed to print an error.
** Must scan the error catalog and its error lists.
** Note that the error type and id words no longer need
** to be bound to the error catalog context.
** If the message is not found, return null.
**
***********************************************************************/
{
REBSER *frame;
REBVAL *obj1;
REBVAL *obj2;
if (!IS_WORD(&error->type) || !IS_WORD(&error->id)) return 0;
// Find the correct error type object in the catalog:
frame = VAL_OBJ_FRAME(Get_System(SYS_CATALOG, CAT_ERRORS));
obj1 = Find_Word_Value(frame, VAL_WORD_SYM(&error->type));
if (!obj1) return 0;
// Now find the correct error message for that type:
frame = VAL_OBJ_FRAME(obj1);
obj2 = Find_Word_Value(frame, VAL_WORD_SYM(&error->id));
if (!obj2) return 0;
if (num) {
obj1 = Find_Word_Value(frame, SYM_CODE);
*num = VAL_INT32(obj1)
+ Find_Word_Index(frame, VAL_WORD_SYM(&error->id), FALSE)
- Find_Word_Index(frame, SYM_TYPE, FALSE) - 1;
}
return obj2;
}
*/ REBINT PD_Object(REBPVS *pvs)
/*
***********************************************************************/
{
REBINT n = 0;
if (!VAL_OBJ_FRAME(pvs->value)) {
return PE_NONE; // Error objects may not have a frame.
}
if (IS_WORD(pvs->select)) {
n = Find_Word_Index(VAL_OBJ_FRAME(pvs->value), VAL_WORD_SYM(pvs->select), FALSE);
}
// else if (IS_INTEGER(pvs->select)) {
// n = Int32s(pvs->select, 1);
// }
else return PE_BAD_SELECT;
if (n <= 0 || (REBCNT)n >= SERIES_TAIL(VAL_OBJ_FRAME(pvs->value)))
return PE_BAD_SELECT;
if (pvs->setval && IS_END(pvs->path+1) && VAL_PROTECTED(VAL_FRM_WORD(pvs->value, n)))
Trap1(RE_LOCKED_WORD, pvs->select);
pvs->value = VAL_OBJ_VALUES(pvs->value) + n;
return PE_SET;
// if setval, check PROTECT mode!!!
// VAL_FLAGS((VAL_OBJ_VALUES(value) + n)) &= ~FLAGS_CLEAN;
}
*/ REBCNT Find_Action(REBVAL *object, REBCNT action)
/*
** Given an action number, return the action's index in
** the specified object. If not found, a zero is returned.
**
***********************************************************************/
{
return Find_Word_Index(VAL_OBJ_FRAME(object), VAL_BIND_SYM(Get_Action_Word(action)), FALSE);
}
*/ REBVAL *Find_Word_Value(REBSER *frame, REBCNT sym)
/*
** Search a frame looking for the given word symbol and
** return the value for the word. Locate it by matching
** the canon word identifiers. Return NULL if not found.
**
***********************************************************************/
{
REBINT n;
if (!frame) return 0;
n = Find_Word_Index(frame, sym, FALSE);
if (!n) return 0;
return BLK_SKIP(frame, n);
}
*/ 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;
}
RL_API int RL_Get_Field(REBSER *obj, u32 word, RXIARG *result)
/*
** Get a field value (context variable) of an object.
**
** Returns:
** Datatype of value or zero if word is not found in the object.
** Arguments:
** obj - object pointer (e.g. from RXA_OBJECT)
** word - global word identifier (integer)
** result - gets set to the value of the field
*/
{
REBVAL *value;
if (!(word = Find_Word_Index(obj, word, FALSE))) return 0;
value = BLK_SKIP(obj, word);
*result = Value_To_RXI(value);
return Reb_To_RXT[VAL_TYPE(value)];
}
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;
}
*/ 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 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;
}
static void Append_Obj(REBSER *obj, REBVAL *arg)
{
REBCNT i;
REBCNT len = 0;
REBVAL *val;
REBVAL *start = arg;
// Can be a word:
if (ANY_WORD(arg)) {
if (!Find_Word_Index(obj, VAL_WORD_SYM(arg), TRUE)) {
if (VAL_WORD_CANON(arg) == SYM_SELF) Trap0(RE_SELF_PROTECTED);
Expand_Frame(obj, 1, 1); // copy word table also
Append_Frame(obj, 0, VAL_WORD_SYM(arg));
// val is UNSET
}
return;
}
if (!IS_BLOCK(arg)) Trap_Arg(arg);
// Verify word/value argument block:
for (arg = VAL_BLK_DATA(arg); NOT_END(arg); arg += 2) {
if (!IS_WORD(arg) && !IS_SET_WORD(arg)) Trap_Arg(arg);
if (NZ(i = Find_Word_Index(obj, VAL_WORD_SYM(arg), TRUE))) {
// Just change the value, do not append it.
val = FRM_VALUE(obj, i);
if (GET_FLAGS(VAL_OPTS(FRM_WORD(obj, i)), OPTS_HIDE, OPTS_LOCK)) {
// Back out... reset any prior flags:
for (; arg != VAL_BLK_DATA(start); arg -= 2) VAL_CLR_OPT(arg, OPTS_TEMP);
if (VAL_PROTECTED(FRM_WORD(obj, i))) Trap1(RE_LOCKED_WORD, FRM_WORD(obj, i));
Trap0(RE_HIDDEN);
}
// Problem above: what about prior OPTS_FLAGS? Ok to leave them as is?
if (IS_END(arg+1)) SET_NONE(val);
else *val = arg[1];
VAL_SET_OPT(arg, OPTS_TEMP);
} else {
if (VAL_WORD_CANON(arg) == SYM_SELF) Trap0(RE_SELF_PROTECTED);
len++;
// was: Trap1(RE_DUP_VARS, arg);
}
if (IS_END(arg+1)) break; // fix bug#708
}
// Append new values to end of frame (if necessary):
if (len > 0) {
Expand_Frame(obj, len, 1); // copy word table also
for (arg = VAL_BLK_DATA(start); NOT_END(arg); arg += 2) {
if (VAL_GET_OPT(arg, OPTS_TEMP)) VAL_CLR_OPT(arg, OPTS_TEMP);
else {
val = Append_Frame(obj, 0, VAL_WORD_SYM(arg));
if (IS_END(arg+1)) {
SET_NONE(val);
break;
}
else *val = arg[1];
}
}
}
}
static void Append_Obj(REBSER *obj, REBVAL *arg)
{
REBCNT i, len;
REBVAL *word, *val;
REBINT *binds; // for binding table
// Can be a word:
if (ANY_WORD(arg)) {
if (!Find_Word_Index(obj, VAL_WORD_SYM(arg), TRUE)) {
// bug fix, 'self is protected only in selfish frames
if ((VAL_WORD_CANON(arg) == SYM_SELF) && !IS_SELFLESS(obj))
Trap0(RE_SELF_PROTECTED);
Expand_Frame(obj, 1, 1); // copy word table also
Append_Frame(obj, 0, VAL_WORD_SYM(arg));
// val is UNSET
}
return;
}
if (!IS_BLOCK(arg)) Trap_Arg(arg);
// Process word/value argument block:
arg = VAL_BLK_DATA(arg);
// Use binding table
binds = WORDS_HEAD(Bind_Table);
// Handle selfless
Collect_Start(IS_SELFLESS(obj) ? BIND_NO_SELF | BIND_ALL : BIND_ALL);
// Setup binding table with obj words:
Collect_Object(obj);
// Examine word/value argument block
for (word = arg; NOT_END(word); word += 2) {
if (!IS_WORD(word) && !IS_SET_WORD(word)) {
// release binding table
BLK_TERM(BUF_WORDS);
Collect_End(obj);
Trap_Arg(word);
}
if (NZ(i = binds[VAL_WORD_CANON(word)])) {
// bug fix, 'self is protected only in selfish frames:
if ((VAL_WORD_CANON(word) == SYM_SELF) && !IS_SELFLESS(obj)) {
// release binding table
BLK_TERM(BUF_WORDS);
Collect_End(obj);
Trap0(RE_SELF_PROTECTED);
}
} else {
// collect the word
binds[VAL_WORD_CANON(word)] = SERIES_TAIL(BUF_WORDS);
EXPAND_SERIES_TAIL(BUF_WORDS, 1);
val = BLK_LAST(BUF_WORDS);
*val = *word;
}
if (IS_END(word + 1)) break; // fix bug#708
}
BLK_TERM(BUF_WORDS);
// Append new words to obj
len = SERIES_TAIL(obj);
Expand_Frame(obj, SERIES_TAIL(BUF_WORDS) - len, 1);
for (word = BLK_SKIP(BUF_WORDS, len); NOT_END(word); word++)
Append_Frame(obj, 0, VAL_WORD_SYM(word));
// Set new values to obj words
for (word = arg; NOT_END(word); word += 2) {
i = binds[VAL_WORD_CANON(word)];
val = FRM_VALUE(obj, i);
if (GET_FLAGS(VAL_OPTS(FRM_WORD(obj, i)), OPTS_HIDE, OPTS_LOCK)) {
// release binding table
Collect_End(obj);
if (VAL_PROTECTED(FRM_WORD(obj, i)))
Trap1(RE_LOCKED_WORD, FRM_WORD(obj, i));
Trap0(RE_HIDDEN);
}
if (IS_END(word + 1)) SET_NONE(val);
else *val = word[1];
if (IS_END(word + 1)) break; // fix bug#708
}
// release binding table
Collect_End(obj);
}
