*/ void Do_Function(REBVAL *func)
/*
***********************************************************************/
{
REBVAL *result;
REBVAL *ds;
#if !defined(NDEBUG)
const REBYTE *name = Get_Word_Name(DSF_LABEL(DSF));
#endif
Eval_Functions++;
//Dump_Block(VAL_FUNC_BODY(func));
result = Do_Blk(VAL_FUNC_BODY(func), 0);
ds = DS_OUT;
if (IS_ERROR(result) && IS_RETURN(result)) {
// Value below is kept safe from GC because no-allocation is
// done between point of SET_THROW and here.
if (VAL_ERR_VALUE(result))
*ds = *VAL_ERR_VALUE(result);
else
SET_UNSET(ds);
}
else *ds = *result; // Set return value (atomic)
}
*/ static void Loop_Number(REBVAL *var, REBSER* body, REBVAL *start, REBVAL *end, REBVAL *incr)
/*
***********************************************************************/
{
REBVAL *result;
REBDEC s;
REBDEC e;
REBDEC i;
if (IS_INTEGER(start)) s = (REBDEC)VAL_INT64(start);
else if (IS_DECIMAL(start) || IS_PERCENT(start)) s = VAL_DECIMAL(start);
else Trap_Arg(start);
if (IS_INTEGER(end)) e = (REBDEC)VAL_INT64(end);
else if (IS_DECIMAL(end) || IS_PERCENT(end)) e = VAL_DECIMAL(end);
else Trap_Arg(end);
if (IS_INTEGER(incr)) i = (REBDEC)VAL_INT64(incr);
else if (IS_DECIMAL(incr) || IS_PERCENT(incr)) i = VAL_DECIMAL(incr);
else Trap_Arg(incr);
VAL_SET(var, REB_DECIMAL);
for (; (i > 0.0) ? s <= e : s >= e; s += i) {
VAL_DECIMAL(var) = s;
result = Do_Blk(body, 0);
if (THROWN(result) && Check_Error(result) >= 0) break;
if (!IS_DECIMAL(var)) Trap_Type(var);
s = VAL_DECIMAL(var);
}
}
*/ void Do_Closure(REBVAL *func)
/*
** Do a closure by cloning its body and binding it to
** a new frame of words/values.
**
** This could be made faster by pre-binding the body,
** then using Rebind_Block to rebind the words in it.
**
***********************************************************************/
{
REBSER *body;
REBSER *frame;
REBVAL *result;
REBVAL *ds;
Eval_Functions++;
//DISABLE_GC;
// Clone the body of the function to allow rebinding to it:
body = Clone_Block(VAL_FUNC_BODY(func));
// Copy stack frame args as the closure object (one extra at head)
frame = Copy_Values(BLK_SKIP(DS_Series, DS_ARG_BASE), SERIES_TAIL(VAL_FUNC_ARGS(func)));
SET_FRAME(BLK_HEAD(frame), 0, VAL_FUNC_ARGS(func));
// Rebind the body to the new context (deeply):
//Rebind_Block(VAL_FUNC_ARGS(func), frame, body);
Bind_Block(frame, BLK_HEAD(body), BIND_DEEP); // | BIND_NO_SELF);
ds = DS_RETURN;
SET_OBJECT(ds, body); // keep it GC safe
result = Do_Blk(body, 0); // GC-OK - also, result returned on DS stack
ds = DS_RETURN;
if (IS_ERROR(result) && IS_RETURN(result)) {
// Value below is kept safe from GC because no-allocation is
// done between point of SET_THROW and here.
if (VAL_ERR_VALUE(result))
*ds = *VAL_ERR_VALUE(result);
else
SET_UNSET(ds);
}
else *ds = *result; // Set return value (atomic)
}
*/ static void Loop_Integer(REBVAL *var, REBSER* body, REBI64 start, REBI64 end, REBI64 incr)
/*
***********************************************************************/
{
REBVAL *result;
VAL_SET(var, REB_INTEGER);
while ((incr > 0) ? start <= end : start >= end) {
VAL_INT64(var) = start;
result = Do_Blk(body, 0);
if (THROWN(result) && Check_Error(result) >= 0) break;
if (!IS_INTEGER(var)) Trap_Type(var);
start = VAL_INT64(var);
if (REB_I64_ADD_OF(start, incr, &start)) {
Trap0(RE_OVERFLOW);
}
}
}
*/ 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);
}
}
*/ 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;
}
}
}
*/ static int Loop_Each(REBVAL *ds, REBINT mode)
/*
** Supports these natives (modes):
** 0: foreach
** 1: remove-each
** 2: map
**
***********************************************************************/
{
REBSER *body;
REBVAL *vars;
REBVAL *words;
REBSER *frame;
REBVAL *value;
REBSER *series;
REBSER *out; // output block (for MAP, mode = 2)
REBINT index; // !!!! should these be REBCNT?
REBINT tail;
REBINT windex; // write
REBINT rindex; // read
REBINT err;
REBCNT i;
REBCNT j;
value = D_ARG(2); // series
if (IS_NONE(value)) return R_NONE;
body = Init_Loop(D_ARG(1), D_ARG(3), &frame); // vars, body
SET_OBJECT(D_ARG(1), frame); // keep GC safe
Set_Block(D_ARG(3), body); // keep GC safe
SET_NONE(D_RET);
SET_NONE(DS_NEXT);
// If it's MAP, create result block:
if (mode == 2) {
out = Make_Block(VAL_LEN(value));
Set_Block(D_RET, out);
}
// Get series info:
if (ANY_OBJECT(value)) {
series = VAL_OBJ_FRAME(value);
out = FRM_WORD_SERIES(series); // words (the out local reused)
index = 1;
//if (frame->tail > 3) Trap_Arg(FRM_WORD(frame, 3));
}
else if (IS_MAP(value)) {
series = VAL_SERIES(value);
index = 0;
//if (frame->tail > 3) Trap_Arg(FRM_WORD(frame, 3));
}
else {
series = VAL_SERIES(value);
index = VAL_INDEX(value);
if (index >= (REBINT)SERIES_TAIL(series)) {
if (mode == 1) {
SET_INTEGER(D_RET, 0);
}
return R_RET;
}
}
windex = index;
// Iterate over each value in the series block:
while (index < (tail = SERIES_TAIL(series))) {
rindex = index; // remember starting spot
j = 0;
// Set the FOREACH loop variables from the series:
for (i = 1; i < frame->tail; i++) {
vars = FRM_VALUE(frame, i);
words = FRM_WORD(frame, i);
// var spec is WORD
if (IS_WORD(words)) {
if (index < tail) {
if (ANY_BLOCK(value)) {
*vars = *BLK_SKIP(series, index);
}
else if (ANY_OBJECT(value)) {
if (!VAL_GET_OPT(BLK_SKIP(out, index), OPTS_HIDE)) {
// Alternate between word and value parts of object:
if (j == 0) {
Set_Word(vars, VAL_WORD_SYM(BLK_SKIP(out, index)), series, index);
if (NOT_END(vars+1)) index--; // reset index for the value part
}
else if (j == 1)
*vars = *BLK_SKIP(series, index);
else
Trap_Arg(words);
j++;
}
else {
// Do not evaluate this iteration
index++;
goto skip_hidden;
}
}
else if (IS_VECTOR(value)) {
Set_Vector_Value(vars, series, index);
}
else if (IS_MAP(value)) {
REBVAL *val = BLK_SKIP(series, index | 1);
if (!IS_NONE(val)) {
if (j == 0) {
*vars = *BLK_SKIP(series, index & ~1);
if (IS_END(vars+1)) index++; // only words
}
else if (j == 1)
*vars = *BLK_SKIP(series, index);
else
Trap_Arg(words);
j++;
}
else {
index += 2;
goto skip_hidden;
}
}
else { // A string or binary
if (IS_BINARY(value)) {
SET_INTEGER(vars, (REBI64)(BIN_HEAD(series)[index]));
}
else if (IS_IMAGE(value)) {
Set_Tuple_Pixel(BIN_SKIP(series, index), vars);
}
else {
VAL_SET(vars, REB_CHAR);
VAL_CHAR(vars) = GET_ANY_CHAR(series, index);
}
}
index++;
}
else SET_NONE(vars);
}
// var spec is WORD:
else if (IS_SET_WORD(words)) {
if (ANY_OBJECT(value) || IS_MAP(value)) {
*vars = *value;
} else {
VAL_SET(vars, REB_BLOCK);
VAL_SERIES(vars) = series;
VAL_INDEX(vars) = index;
}
//if (index < tail) index++; // do not increment block.
}
else Trap_Arg(words);
}
ds = Do_Blk(body, 0);
if (THROWN(ds)) {
if ((err = Check_Error(ds)) >= 0) break;
// else CONTINUE:
if (mode == 1) SET_FALSE(ds); // keep the value (for mode == 1)
} else {
err = 0; // prevent later test against uninitialized value
}
if (mode > 0) {
//if (ANY_OBJECT(value)) Trap_Types(words, REB_BLOCK, VAL_TYPE(value)); //check not needed
// If FALSE return, copy values to the write location:
if (mode == 1) { // remove-each
if (IS_FALSE(ds)) {
REBCNT wide = SERIES_WIDE(series);
// memory areas may overlap, so use memmove and not memcpy!
memmove(series->data + (windex * wide), series->data + (rindex * wide), (index - rindex) * wide);
windex += index - rindex;
// old: while (rindex < index) *BLK_SKIP(series, windex++) = *BLK_SKIP(series, rindex++);
}
}
else
if (!IS_UNSET(ds)) Append_Val(out, ds); // (mode == 2)
}
skip_hidden: ;
}
// Finish up:
if (mode == 1) {
// Remove hole (updates tail):
if (windex < index) Remove_Series(series, windex, index - windex);
SET_INTEGER(DS_RETURN, index - windex);
return R_RET;
}
// If MAP and not BREAK/RETURN:
if (mode == 2 && err != 2) return R_RET;
return R_TOS1;
}
*/ static int Loop_All(REBVAL *ds, REBINT mode)
/*
** 0: forall
** 1: forskip
**
***********************************************************************/
{
REBVAL *var;
REBSER *body;
REBCNT bodi;
REBSER *dat;
REBINT idx;
REBINT inc = 1;
REBCNT type;
var = Get_Var(D_ARG(1));
if (IS_NONE(var)) return R_NONE;
// Save the starting var value:
*D_ARG(1) = *var;
SET_NONE(D_RET);
if (mode == 1) inc = Int32(D_ARG(2));
type = VAL_TYPE(var);
body = VAL_SERIES(D_ARG(mode+2));
bodi = VAL_INDEX(D_ARG(mode+2));
// Starting location when past end with negative skip:
if (inc < 0 && VAL_INDEX(var) >= (REBINT)VAL_TAIL(var)) {
VAL_INDEX(var) = (REBINT)VAL_TAIL(var) + inc;
}
// NOTE: This math only works for index in positive ranges!
if (ANY_SERIES(var)) {
while (TRUE) {
dat = VAL_SERIES(var);
idx = (REBINT)VAL_INDEX(var);
if (idx < 0) break;
if (idx >= (REBINT)SERIES_TAIL(dat)) {
if (inc >= 0) break;
idx = (REBINT)SERIES_TAIL(dat) + inc; // negative
if (idx < 0) break;
VAL_INDEX(var) = idx;
}
ds = Do_Blk(body, bodi); // (may move stack)
if (THROWN(ds)) { // Break, throw, continue, error.
if (Check_Error(ds) >= 0) {
*DS_RETURN = *DS_NEXT;
break;
}
}
*DS_RETURN = *ds;
if (VAL_TYPE(var) != type) Trap_Arg(var);
VAL_INDEX(var) += inc;
}
}
else Trap_Arg(var);
// !!!!! ???? allowed to write VAR????
*var = *DS_ARG(1);
return R_RET;
}