*/ static void Loop_Series(REBVAL *out, REBVAL *var, REBSER* body, REBVAL *start, REBINT ei, REBINT ii)
/*
***********************************************************************/
{
REBINT si = VAL_INDEX(start);
REBCNT type = VAL_TYPE(start);
*var = *start;
if (ei >= cast(REBINT, VAL_TAIL(start)))
ei = cast(REBINT, VAL_TAIL(start));
if (ei < 0) ei = 0;
SET_NONE(out); // Default result to NONE if the loop does not run
for (; (ii > 0) ? si <= ei : si >= ei; si += ii) {
VAL_INDEX(var) = si;
if (!DO_BLOCK(out, body, 0) && Check_Error(out) >= 0) break;
if (VAL_TYPE(var) != type) Trap1(RE_INVALID_TYPE, var);
si = VAL_INDEX(var);
}
}
*/ static void Loop_Number(REBVAL *out, REBVAL *var, REBSER* body, REBVAL *start, REBVAL *end, REBVAL *incr)
/*
***********************************************************************/
{
REBDEC s;
REBDEC e;
REBDEC i;
if (IS_INTEGER(start)) s = cast(REBDEC, VAL_INT64(start));
else if (IS_DECIMAL(start) || IS_PERCENT(start)) s = VAL_DECIMAL(start);
else { Trap_Arg(start); DEAD_END_VOID; }
if (IS_INTEGER(end)) e = cast(REBDEC, VAL_INT64(end));
else if (IS_DECIMAL(end) || IS_PERCENT(end)) e = VAL_DECIMAL(end);
else { Trap_Arg(end); DEAD_END_VOID; }
if (IS_INTEGER(incr)) i = cast(REBDEC, VAL_INT64(incr));
else if (IS_DECIMAL(incr) || IS_PERCENT(incr)) i = VAL_DECIMAL(incr);
else { Trap_Arg(incr); DEAD_END_VOID; }
VAL_SET(var, REB_DECIMAL);
SET_NONE(out); // Default result to NONE if the loop does not run
for (; (i > 0.0) ? s <= e : s >= e; s += i) {
VAL_DECIMAL(var) = s;
if (!DO_BLOCK(out, body, 0) && Check_Error(out) >= 0) break;
if (!IS_DECIMAL(var)) Trap_Type(var);
s = VAL_DECIMAL(var);
}
}
*/ static void Loop_Integer(REBVAL *out, REBVAL *var, REBSER* body, REBI64 start, REBI64 end, REBI64 incr)
/*
***********************************************************************/
{
VAL_SET(var, REB_INTEGER);
SET_NONE(out); // Default result to NONE if the loop does not run
while ((incr > 0) ? start <= end : start >= end) {
VAL_INT64(var) = start;
if (!DO_BLOCK(out, body, 0) && Check_Error(out) >= 0) break;
if (!IS_INTEGER(var)) Trap_Type(var);
start = VAL_INT64(var);
if (REB_I64_ADD_OF(start, incr, &start)) {
Trap(RE_OVERFLOW);
}
}
}
*/ static REB_R Loop_Each(struct Reb_Call *call_, 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;
REBVAL *ds;
assert(mode >= 0 && mode < 3);
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_OUT); // Default result to NONE if the loop does not run
// If it's MAP, create result block:
if (mode == 2) {
out = Make_Block(VAL_LEN(value));
SAVE_SERIES(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_DEAD_END(FRM_WORD(frame, 3));
}
else if (IS_MAP(value)) {
series = VAL_SERIES(value);
index = 0;
//if (frame->tail > 3) Trap_Arg_DEAD_END(FRM_WORD(frame, 3));
}
else {
series = VAL_SERIES(value);
index = VAL_INDEX(value);
if (index >= cast(REBINT, SERIES_TAIL(series))) {
if (mode == 1) {
SET_INTEGER(D_OUT, 0);
} else if (mode == 2) {
Set_Block(D_OUT, out);
UNSAVE_SERIES(out);
}
return R_OUT;
}
}
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_EXT(BLK_SKIP(out, index), EXT_WORD_HIDE)) {
// Alternate between word and value parts of object:
if (j == 0) {
Init_Word(vars, REB_WORD, 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_DEAD_END(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_DEAD_END(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 SET_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_DEAD_END(words);
}
if (index == rindex) index++; //the word block has only set-words: foreach [a:] [1 2 3][]
if (!DO_BLOCK(D_OUT, body, 0)) {
if ((err = Check_Error(D_OUT)) >= 0) {
index = rindex;
break;
}
// else CONTINUE:
if (mode == 1) SET_FALSE(D_OUT); // keep the value (for mode == 1)
} else {
err = 0; // prevent later test against uninitialized value
}
if (mode > 0) {
//if (ANY_OBJECT(value)) Trap_Types_DEAD_END(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_CONDITIONAL_FALSE(D_OUT)) {
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(D_OUT)) Append_Value(out, D_OUT); // (mode == 2)
}
skip_hidden: ;
}
// Finish up:
if (mode == 1) {
// Remove hole (updates tail):
if (windex < index) Remove_Series(series, windex, index - windex);
SET_INTEGER(D_OUT, index - windex);
return R_OUT;
}
// If MAP...
if (mode == 2) {
UNSAVE_SERIES(out);
if (err != 2) {
// ...and not BREAK/RETURN:
Set_Block(D_OUT, out);
return R_OUT;
}
}
return R_OUT;
}
*/ static int Loop_All(struct Reb_Call *call_, REBINT mode)
/*
** 0: forall
** 1: forskip
**
***********************************************************************/
{
REBVAL *var;
REBSER *body;
REBCNT bodi;
REBSER *dat;
REBINT idx;
REBINT inc = 1;
REBCNT type;
REBVAL *ds;
var = GET_MUTABLE_VAR(D_ARG(1));
if (IS_NONE(var)) return R_NONE;
// Save the starting var value:
*D_ARG(1) = *var;
SET_NONE(D_OUT);
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) >= VAL_TAIL(var)) {
VAL_INDEX(var) = 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 = VAL_INDEX(var);
if (idx < 0) break;
if (idx >= cast(REBINT, SERIES_TAIL(dat))) {
if (inc >= 0) break;
idx = SERIES_TAIL(dat) + inc; // negative
if (idx < 0) break;
VAL_INDEX(var) = idx;
}
if (!DO_BLOCK(D_OUT, body, bodi)) { // Break, throw, continue, error.
if (Check_Error(D_OUT) >= 0) {
break;
}
}
if (VAL_TYPE(var) != type) Trap_Arg_DEAD_END(var);
VAL_INDEX(var) += inc;
}
}
else Trap_Arg_DEAD_END(var);
// !!!!! ???? allowed to write VAR????
*var = *D_ARG(1);
return R_OUT;
}
/** Scan converts the RLE encoded char - see notes above re structure of form. */
void rlechar(render_blit_t *rb, FORM *theform , dcoord sx , dcoord sy )
{
register dcoord x1 , x2 , ey, h ;
register int32 wupdate , wclipupdate;
register dcoord x1c , x2c ;
dcoord y1c, y2c;
const dbbox_t *clip ;
/* register */ uint8 *memory ;
uint8 repeat ;
int32 temp ;
RLECACHE_LINE_READ_STATE state ;
int32 span_lengths[2] ;
HQASSERT( theFormH(*theform) > 0, "Rlechar height zero") ;
HQASSERT( theFormW(*theform) > 0, "Rlechar width zero") ;
/* Preclip bounding box. */
clip = &rb->p_ri->clip ;
h = theFormH(*theform) ;
y1c = clip->y1;
if ( sy + h <= y1c )
return ;
y2c = clip->y2;
if ( sy > y2c )
return ;
x2c = clip->x2;
if ( sx > x2c )
return ;
x1c = clip->x1;
if ( sx + theFormW(*theform) <= x1c )
return ;
memory = (uint8 *)theFormA(*theform) ;
/* Partial clip of the top. */
if ( ( temp = sy - y1c ) < 0 ) {
for (;;) { /* Skip block if totally clipped. */
temp += memory[0] ;
if ( temp > 0 )
break ;
memory += 2 + memory[1] ;
/* Bail out if we've read all the data in the form */
if ( memory >= (uint8 *)theform->addr + theform->size ) {
HQFAIL("Off the end of a form");
return;
}
}
repeat = (uint8)temp ;
h -= y1c - sy;
sy = y1c;
}
else {
repeat = memory[0] ;
}
/* Partial clip of the bottom. */
temp = sy + h ;
if ( temp > y2c )
h -= ( temp - y2c - 1 );
if ( h <= 0 )
return ;
if ( h < (int32)repeat )
repeat = (uint8)h ;
/* Go for it.. */
wupdate = theFormL(*rb->outputform) ;
rb->ylineaddr = BLIT_ADDRESS(theFormA(*rb->outputform),
wupdate * (sy - theFormHOff(*rb->outputform) - rb->y_sep_position)) ;
wclipupdate = theFormL(*rb->clipform) ;
rb->ymaskaddr = BLIT_ADDRESS(theFormA(*rb->clipform),
wclipupdate * (sy - theFormHOff(*rb->clipform) - rb->y_sep_position)) ;
/* use end coordinates 1 past the end of the span to reduce */
/* number of +1 and -1 calculations */
++x2c ;
state.next_line = memory;
for ( ;; ) {
rlecache_line_read_init(&state, theform, state.next_line);
ey = sy + (int32)repeat - 1 ;
x2 = sx ; /* Start of first white span. */
/* Last nibble can be ignored, because it would be a single white span */
while ( ! state.line_finished ) {
rlecache_get_span_pair(&state, span_lengths) ;
x1 = x2 + span_lengths[0] ; /* White span - ignore. */
x2 = x1 + span_lengths[1] ; /* Black span. */
if ( x1 < x1c )
x1 = x1c ;
if ( x2 >= x2c ) { /* Touching or clipped off to the right, so ignore rest. */
if ( x1 < x2c )
DO_BLOCK(rb, sy, ey, x1, x2c - 1 );
break ;
}
if ( x1 < x2 )
DO_BLOCK(rb, sy, ey, x1, x2 - 1 ) ;
}
if ( ( h -= (int32)repeat ) <= 0 )
return ;
{
int32 rows = ey - sy + 1 ;
rb->ylineaddr = BLIT_ADDRESS(rb->ylineaddr, rows * wupdate) ;
rb->ymaskaddr = BLIT_ADDRESS(rb->ymaskaddr, rows * wclipupdate) ;
sy += rows ;
}
/* Bail out if we've read all the data in the form */
if (state.next_line >= ((uint8 *) theform->addr) + theform->size) {
HQFAIL("Off the end of a form");
return;
}
repeat = state.next_line[0] ;
if ( h < (int32)repeat )
repeat = (uint8)h ;
}
}