*/ void Trap_Num(REBCNT err, REBCNT num)
/*
***********************************************************************/
{
DS_PUSH_INTEGER(num);
Trap1(err, DS_TOP);
}
*/ static REBVAL *Do_Parse_Path(REBVAL *item, REBPARSE *parse, REBCNT *index)
/*
** Handle a PATH, including get and set, that's found in a rule.
**
***********************************************************************/
{
REBVAL *path = item;
REBVAL tmp;
if (IS_PATH(item)) {
if (Do_Path(&path, 0)) return item; // found a function
item = DS_TOP;
}
else if (IS_SET_PATH(item)) {
Set_Series(parse->type, &tmp, parse->series);
VAL_INDEX(&tmp) = *index;
if (Do_Path(&path, &tmp)) return item; // found a function
return 0;
}
else if (IS_GET_PATH(item)) {
if (Do_Path(&path, 0)) return item; // found a function
item = DS_TOP;
// CureCode #1263 change
// if (parse->type != VAL_TYPE(item) || VAL_SERIES(item) != parse->series)
if (!ANY_SERIES(item)) Trap1(RE_PARSE_SERIES, path);
*index = Set_Parse_Series(parse, item);
return 0;
}
return item;
}
*/ void Trap_Types(REBCNT errnum, REBCNT type1, REBCNT type2)
/*
***********************************************************************/
{
if (type2 != 0) Trap2(errnum, Get_Type(type1), Get_Type(type2));
Trap1(errnum, Get_Type(type1));
}
*/ REBINT PD_Frame(REBPVS *pvs)
/*
** pvs->value points to the first value in frame (SELF).
**
***********************************************************************/
{
REBCNT sym;
REBCNT s;
REBVAL *word;
REBVAL *val;
if (IS_WORD(pvs->select)) {
sym = VAL_WORD_SYM(pvs->select);
s = SYMBOL_TO_CANON(sym);
word = BLK_SKIP(VAL_FRM_WORDS(pvs->value), 1);
for (val = pvs->value + 1; NOT_END(val); val++, word++) {
if (sym == VAL_BIND_SYM(word) || s == VAL_BIND_CANON(word)) {
if (VAL_GET_OPT(word, OPTS_HIDE)) break;
if (VAL_PROTECTED(word)) Trap1(RE_LOCKED_WORD, word);
pvs->value = val;
return PE_SET;
}
}
}
return PE_BAD_SELECT;
}
*/ 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;
}
*/ int Mul_Max(int type, i64 n, i64 m, i64 maxi)
/*
***********************************************************************/
{
i64 r = n * m;
if (r < -maxi || r > maxi) Trap1(RE_TYPE_LIMIT, Get_Type(type));
return (int)r;
}
*/ void Trap_Word(REBCNT num, REBCNT sym, REBVAL *arg)
/*
***********************************************************************/
{
Init_Word(DS_TOP, sym);
if (arg) Trap2(num, DS_TOP, arg);
else Trap1(num, DS_TOP);
}
*/ void Trap_Range(REBVAL *arg)
/*
** value out of range: <value>
**
***********************************************************************/
{
Trap1(RE_OUT_OF_RANGE, arg);
}
*/ void Trap_Type(REBVAL *arg)
/*
** <type> type is not allowed here
**
***********************************************************************/
{
Trap1(RE_INVALID_TYPE, Of_Type(arg));
}
*/ i64 Add_Max(int type, i64 n, i64 m, i64 maxi)
/*
***********************************************************************/
{
i64 r = n + m;
if (r < -maxi || r > maxi) {
if (type) Trap1(RE_TYPE_LIMIT, Get_Type(type));
r = r > 0 ? maxi : -maxi;
}
return r;
}
*/ 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 Make_Command(REBVAL *value, REBVAL *def)
/*
** Assumes prior function has already stored the spec and args
** series. This function validates the body.
**
***********************************************************************/
{
REBVAL *args = BLK_HEAD(VAL_FUNC_ARGS(value));
REBCNT n;
REBVAL *val = VAL_BLK_SKIP(def, 1);
REBEXT *ext;
if (
VAL_LEN(def) != 3
|| !(IS_MODULE(val) || IS_OBJECT(val))
|| !IS_HANDLE(VAL_OBJ_VALUE(val, 1))
|| !IS_INTEGER(val+1)
|| VAL_INT64(val+1) > 0xffff
) Trap1(RE_BAD_FUNC_DEF, def);
val = VAL_OBJ_VALUE(val, 1);
if (
!(ext = &Ext_List[VAL_I32(val)])
|| !(ext->call)
) Trap1(RE_BAD_EXTENSION, def);
// make command! [[arg-spec] handle cmd-index]
VAL_FUNC_BODY(value) = Copy_Block_Len(VAL_SERIES(def), 1, 2);
// Check for valid command arg datatypes:
args++; // skip self
n = 1;
for (; NOT_END(args); args++, n++) {
// If the typeset contains args that are not valid:
// (3 is the default when no args given, for not END and UNSET)
if (3 != ~VAL_TYPESET(args) && (VAL_TYPESET(args) & ~RXT_ALLOWED_TYPES))
Trap1(RE_BAD_FUNC_ARG, args);
}
VAL_SET(value, REB_COMMAND);
}
*/ 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 REBDAT Normalize_Date(REBINT day, REBINT month, REBINT year, REBINT tz)
/*
** Given a year, month and day, normalize and combine to give a new
** date value.
**
***********************************************************************/
{
REBINT d;
REBDAT dr;
// First we normalize the month to get the right year
if (month<0) {
year-=(-month+11)/12;
month=11-((-month+11)%12);
}
if (month >= 12) {
year += month / 12;
month %= 12;
}
// Now adjust the days by stepping through each month
while (day >= (d = (REBINT)Month_Length(month, year))) {
day -= d;
if (++month >= 12) {
month = 0;
year++;
}
}
while (day < 0) {
if (month == 0) {
month = 11;
year--;
}
else
month--;
day += (REBINT)Month_Length(month, year);
}
if (year < 0 || year > MAX_YEAR) {
Trap1(RE_TYPE_LIMIT, Get_Type(REB_DATE));
// Unreachable, but we want to make the compiler happy
assert(FALSE);
return dr;
}
dr.date.year = year;
dr.date.month = month+1;
dr.date.day = day+1;
dr.date.zone = tz;
return dr;
}
*/ static void Open_File_Port(REBSER *port, REBREQ *file, REBVAL *path)
/*
** Open a file port.
**
***********************************************************************/
{
if (Is_Port_Open(port)) Trap1(RE_ALREADY_OPEN, path);
if (OS_DO_DEVICE(file, RDC_OPEN) < 0)
Trap_Port(RE_CANNOT_OPEN, port, file->error);
Set_Port_Open(port, TRUE);
}
*/ REBVAL *Make_Module(REBVAL *spec)
/*
** Create a module from a spec and an init block.
** Call the Make_Module function in the system/intrinsic object.
**
***********************************************************************/
{
REBVAL *value;
value = Do_Sys_Func(SYS_CTX_MAKE_MODULE_P, spec, 0); // volatile
if (IS_NONE(value)) Trap1(RE_INVALID_SPEC, spec);
return value;
}
*/ 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 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);
}
*/ void Trap_Security(REBCNT flag, REBCNT sym, REBVAL *value)
/*
** Take action on the policy flags provided. The sym and value
** are provided for error message purposes only.
**
***********************************************************************/
{
if (flag == SEC_THROW) {
if (!value) {
Init_Word(DS_TOP, sym);
value = DS_TOP;
}
Trap1(RE_SECURITY, value);
}
else if (flag == SEC_QUIT) OS_EXIT(101);
}
*/ REBSER *Check_Func_Spec(REBSER *block)
/*
** Check function spec of the form:
**
** ["description" arg "notes" [type! type2! ...] /ref ...]
**
** Throw an error for invalid values.
**
***********************************************************************/
{
REBVAL *blk;
REBSER *words;
REBINT n = 0;
REBVAL *value;
blk = BLK_HEAD(block);
words = Collect_Frame(BIND_ALL | BIND_NO_DUP | BIND_NO_SELF, 0, blk);
// !!! needs more checks
for (; NOT_END(blk); blk++) {
switch (VAL_TYPE(blk)) {
case REB_BLOCK:
// Skip the SPEC block as an arg. Use other blocks as datatypes:
if (n > 0) Make_Typeset(VAL_BLK(blk), BLK_SKIP(words, n), 0);
break;
case REB_STRING:
case REB_INTEGER: // special case used by datatype test actions
break;
case REB_WORD:
case REB_GET_WORD:
case REB_LIT_WORD:
n++;
break;
case REB_REFINEMENT:
// Refinement only allows logic! and none! for its datatype:
n++;
value = BLK_SKIP(words, n);
VAL_TYPESET(value) = (TYPESET(REB_LOGIC) | TYPESET(REB_NONE));
break;
case REB_SET_WORD:
default:
Trap1(RE_BAD_FUNC_DEF, blk);
}
}
return words; //Create_Frame(words, 0);
}
*/ static void Set_GOB_Vars(REBGOB *gob, REBVAL *blk)
/*
***********************************************************************/
{
REBVAL *var;
REBVAL *val;
while (NOT_END(blk)) {
var = blk++;
val = blk++;
if (!IS_SET_WORD(var)) Trap2(RE_EXPECT_VAL, Get_Type(REB_SET_WORD), Of_Type(var));
if (IS_END(val) || IS_UNSET(val) || IS_SET_WORD(val))
Trap1(RE_NEED_VALUE, var);
val = Get_Simple_Value(val);
if (!Set_GOB_Var(gob, var, val)) Trap2(RE_BAD_FIELD_SET, var, Of_Type(val));
}
}
*/ void Collect_Words(REBVAL *block, REBFLG modes)
/*
** The inner recursive loop used for Collect_Words function below.
**
***********************************************************************/
{
REBINT *binds = WORDS_HEAD(Bind_Table);
REBVAL *word;
REBVAL *value;
for (; NOT_END(block); block++) {
value = block;
//if (modes & BIND_GET && IS_GET_WORD(block)) value = Get_Var(block);
if (ANY_WORD(value)) {
if (!binds[VAL_WORD_CANON(value)]) { // only once per word
if (IS_SET_WORD(value) || modes & BIND_ALL) {
binds[VAL_WORD_CANON(value)] = SERIES_TAIL(BUF_WORDS);
EXPAND_SERIES_TAIL(BUF_WORDS, 1);
word = BLK_LAST(BUF_WORDS);
VAL_SET(word, VAL_TYPE(value));
VAL_SET_OPT(word, OPTS_UNWORD);
VAL_BIND_SYM(word) = VAL_WORD_SYM(value);
// Allow all datatypes (to start):
VAL_BIND_TYPESET(word) = ~((TYPESET(REB_END) | TYPESET(REB_UNSET))); // not END or UNSET
}
} else {
// If word duplicated:
if (modes & BIND_NO_DUP) {
// Reset binding table (note BUF_WORDS may have expanded):
for (word = BLK_HEAD(BUF_WORDS); NOT_END(word); word++)
binds[VAL_WORD_CANON(word)] = 0;
RESET_TAIL(BUF_WORDS); // allow reuse
Trap1(RE_DUP_VARS, value);
}
}
continue;
}
// Recurse into sub-blocks:
if (ANY_EVAL_BLOCK(value) && (modes & BIND_DEEP))
Collect_Words(VAL_BLK_DATA(value), modes);
// In this mode (foreach native), do not allow non-words:
//else if (modes & BIND_GET) Trap_Arg(value);
}
BLK_TERM(BUF_WORDS);
}
*/ REBSER *Compress(REBSER *input, REBINT index, REBINT len, REBFLG use_crc)
/*
** Compress a binary (only).
** data
** /part
** length
** /crc32
**
** Note: If the file length is "small", it can't overrun on
** compression too much so we use our magic numbers; otherwise,
** we'll just be safe by a percentage of the file size. This may
** be a bit much, though.
**
***********************************************************************/
{
REBCNT size;
REBSER *output;
REBINT err;
REBYTE out_size[4];
if (len < 0) Trap0(RE_PAST_END); // !!! better msg needed
size = len + (len > STERLINGS_MAGIC_NUMBER ? len / 10 + 12 : STERLINGS_MAGIC_FIX);
output = Make_Binary(size);
//DISABLE_GC; // !!! why??
// dest, dest-len, src, src-len, level
err = Z_compress2(BIN_HEAD(output), (uLongf*)&size, BIN_HEAD(input) + index, len, use_crc);
if (err) {
if (err == Z_MEM_ERROR) Trap0(RE_NO_MEMORY);
SET_INTEGER(DS_RETURN, err);
Trap1(RE_BAD_PRESS, DS_RETURN); //!!!provide error string descriptions
}
SET_STR_END(output, size);
SERIES_TAIL(output) = size;
Long_To_Bytes(out_size, (REBCNT)len); // Tag the size to the end.
Append_Series(output, (REBYTE*)out_size, 4);
if (SERIES_AVAIL(output) > 1024) // Is there wasted space?
output = Copy_Series(output); // Trim it down if too big. !!! Revisit this based on mem alloc alg.
//ENABLE_GC;
return output;
}
*/ static void Loop_Series(REBVAL *var, REBSER* body, REBVAL *start, REBINT ei, REBINT ii)
/*
***********************************************************************/
{
REBVAL *result;
REBINT si = VAL_INDEX(start);
REBCNT type = VAL_TYPE(start);
*var = *start;
if (ei >= (REBINT)VAL_TAIL(start)) ei = (REBINT)VAL_TAIL(start);
if (ei < 0) ei = 0;
for (; (ii > 0) ? si <= ei : si >= ei; si += ii) {
VAL_INDEX(var) = si;
result = Do_Blk(body, 0);
if (THROWN(result) && Check_Error(result) >= 0) break;
if (VAL_TYPE(var) != type) Trap1(RE_INVALID_TYPE, var);
si = VAL_INDEX(var);
}
}
*/ REBINT Partial1(REBVAL *sval, REBVAL *lval)
/*
** Process the /part (or /skip) and other length modifying
** arguments.
**
***********************************************************************/
{
REBI64 len;
REBINT maxlen;
REBINT is_ser = ANY_SERIES(sval);
// If lval = NONE, use the current len of the target value:
if (IS_NONE(lval)) {
if (!is_ser) return 1;
if (VAL_INDEX(sval) >= VAL_TAIL(sval)) return 0;
return (VAL_TAIL(sval) - VAL_INDEX(sval));
}
if (IS_INTEGER(lval) || IS_DECIMAL(lval)) len = Int32(lval);
else {
if (is_ser && VAL_TYPE(sval) == VAL_TYPE(lval) && VAL_SERIES(sval) == VAL_SERIES(lval))
len = (REBINT)VAL_INDEX(lval) - (REBINT)VAL_INDEX(sval);
else
Trap1(RE_INVALID_PART, lval);
}
if (is_ser) {
// Restrict length to the size available:
if (len >= 0) {
maxlen = (REBINT)VAL_LEN(sval);
if (len > maxlen) len = maxlen;
} else {
len = -len;
if (len > (REBINT)VAL_INDEX(sval)) len = (REBINT)VAL_INDEX(sval);
VAL_INDEX(sval) -= (REBCNT)len;
}
}
return (REBINT)len;
}
*/ static REBOOL Is_Of_Type(REBVAL *value, REBVAL *types)
/*
** Types can be: word or block. Each element must be either
** a datatype or a typeset.
**
***********************************************************************/
{
REBVAL *val;
val = IS_WORD(types) ? Get_Var(types) : types;
if (IS_DATATYPE(val)) {
return (VAL_DATATYPE(val) == (REBINT)VAL_TYPE(value));
}
if (IS_TYPESET(val)) {
return (TYPE_CHECK(val, VAL_TYPE(value)));
}
if (IS_BLOCK(val)) {
for (types = VAL_BLK_DATA(val); NOT_END(types); types++) {
val = IS_WORD(types) ? Get_Var(types) : types;
if (IS_DATATYPE(val))
if (VAL_DATATYPE(val) == (REBINT)VAL_TYPE(value)) return TRUE;
else if (IS_TYPESET(val))
if (TYPE_CHECK(val, VAL_TYPE(value))) return TRUE;
else
Trap1(RE_INVALID_TYPE, Of_Type(val));
}
return FALSE;
}
Trap_Arg(types);
return 0; // for compiler
}
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];
}
}
}
}
*/ REBINT Partial(REBVAL *aval, REBVAL *bval, REBVAL *lval, REBFLG flag)
/*
** Args:
** aval: target value
** bval: argument to modify target (optional)
** lval: length value (or none)
**
** Determine the length of a /PART value. It can be:
** 1. integer or decimal
** 2. relative to A value (bval is null)
** 3. relative to B value
**
** Flag: indicates special treatment for CHANGE. As in:
** CHANGE/part "abcde" "xy" 3 => "xyde"
**
** NOTE: Can modify the value's index!
** The result can be negative. ???
**
***********************************************************************/
{
REBVAL *val;
REBINT len;
REBINT maxlen;
// If lval = NONE, use the current len of the target value:
if (IS_NONE(lval)) {
val = (bval && ANY_SERIES(bval)) ? bval : aval;
if (VAL_INDEX(val) >= VAL_TAIL(val)) return 0;
return (VAL_TAIL(val) - VAL_INDEX(val));
}
if (IS_INTEGER(lval)) {
len = Int32(lval);
val = flag ? aval : bval;
}
else if (IS_DECIMAL(lval)) {
len = Int32(lval);
val = bval;
}
else {
// So, lval must be relative to aval or bval series:
if (VAL_TYPE(aval) == VAL_TYPE(lval) && VAL_SERIES(aval) == VAL_SERIES(lval))
val = aval;
else if (bval && VAL_TYPE(bval) == VAL_TYPE(lval) && VAL_SERIES(bval) == VAL_SERIES(lval))
val = bval;
else
Trap1(RE_INVALID_PART, lval);
len = (REBINT)VAL_INDEX(lval) - (REBINT)VAL_INDEX(val);
}
if (!val) val = aval;
// Restrict length to the size available:
if (len >= 0) {
maxlen = (REBINT)VAL_LEN(val);
if (len > maxlen) len = maxlen;
} else {
len = -len;
if (len > (REBINT)VAL_INDEX(val)) len = (REBINT)VAL_INDEX(val);
VAL_INDEX(val) -= (REBCNT)len;
// if ((-len) > (REBINT)VAL_INDEX(val)) len = -(REBINT)VAL_INDEX(val);
}
return len;
}
*/ REBCNT Get_Part_Length(REBVAL *bval, REBVAL *eval)
/*
** Determine the length of a /PART value.
** If /PART value is an integer just use it.
** If it is a series and it is the same series as the first,
** use the difference between the two indices.
**
** If the length ends up negative, back up the index as much
** as possible. If backed up over the head, adjust the length.
**
** Note: This one does not handle list datatypes.
**
***********************************************************************/
{
REBINT len;
REBCNT tail;
if (IS_INTEGER(eval) || IS_DECIMAL(eval)) {
len = Int32(eval);
if (IS_SCALAR(bval) && VAL_TYPE(bval) != REB_PORT)
Trap1(RE_INVALID_PART, bval);
}
else if (
(
// IF normal series and self referencing:
VAL_TYPE(eval) >= REB_STRING &&
VAL_TYPE(eval) <= REB_BLOCK &&
VAL_TYPE(bval) == VAL_TYPE(eval) &&
VAL_SERIES(bval) == VAL_SERIES(eval)
) || (
// OR IF it is a port:
IS_PORT(bval) && IS_PORT(eval) &&
VAL_OBJ_FRAME(bval) == VAL_OBJ_FRAME(eval)
)
)
len = (REBINT)VAL_INDEX(eval) - (REBINT)VAL_INDEX(bval);
else
Trap1(RE_INVALID_PART, eval);
/* !!!!
if (IS_PORT(bval)) {
PORT_STATE_OBJ *port;
port = VAL_PORT(&VAL_PSP(bval)->state);
if (PORT_FLAG(port) & PF_DIRECT)
tail = 0x7fffffff;
else
tail = PORT_TAIL(VAL_PORT(&VAL_PSP(bval)->state));
}
else
*/ tail = VAL_TAIL(bval);
if (len < 0) {
len = -len;
if (len > (REBINT)VAL_INDEX(bval))
len = (REBINT)VAL_INDEX(bval);
VAL_INDEX(bval) -= (REBCNT)len;
}
else if (!IS_INTEGER(eval) && (len + VAL_INDEX(bval)) > tail)
len = (REBINT)(tail - VAL_INDEX(bval));
return (REBCNT)len;
}
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);
}
