/*********************************************************************** ** ** Get_Obj_Mods -- return a block of modified words from an object ** ***********************************************************************/ REBVAL *Get_Obj_Mods(REBFRM *frame, REBVAL **inter_block) { REBVAL *obj = D_ARG(1); REBVAL *words, *val; REBFRM *frm = VAL_OBJ_FRAME(obj); REBSER *ser = Make_Block(2); REBOOL clear = D_REF(2); //DISABLE_GC; val = BLK_HEAD(frm->values); words = BLK_HEAD(frm->words); for (; NOT_END(val); val++, words++) if (!(VAL_FLAGS(val) & FLAGS_CLEAN)) { Append_Val(ser, words); if (clear) VAL_FLAGS(val) |= FLAGS_CLEAN; } if (!STR_LEN(ser)) { ENABLE_GC; goto is_none; } Bind_Block(frm, BLK_HEAD(ser), FALSE); VAL_SERIES(Temp_Blk_Value) = ser; //ENABLE_GC; return Temp_Blk_Value; }
STOID Mold_Object(REBVAL *value, REB_MOLD *mold) { REBSER *wser; REBVAL *words; REBVAL *vals; // first value is context REBCNT n; REBOOL indented = !GET_MOPT(mold, MOPT_INDENT); ASSERT(VAL_OBJ_FRAME(value), RP_NO_OBJECT_FRAME); wser = VAL_OBJ_WORDS(value); // if (wser < 1000) // Dump_Block_Raw(VAL_OBJ_FRAME(value), 0, 1); words = BLK_HEAD(wser); vals = VAL_OBJ_VALUES(value); // first value is context Pre_Mold(value, mold); Append_Byte(mold->series, '['); // Prevent infinite looping: if (Find_Same_Block(MOLD_LOOP, value) > 0) { Append_Bytes(mold->series, "...]"); return; } Append_Val(MOLD_LOOP, value); mold->indent++; for (n = 1; n < SERIES_TAIL(wser); n++) { if ( !VAL_GET_OPT(words+n, OPTS_HIDE) && ((VAL_TYPE(vals+n) > REB_NONE) || !GET_MOPT(mold, MOPT_NO_NONE)) ){ if(indented) New_Indented_Line(mold); else if (n > 1) Append_Byte(mold->series, ' '); Append_UTF8(mold->series, Get_Sym_Name(VAL_WORD_SYM(words+n)), -1); //Print("Slot: %s", Get_Sym_Name(VAL_WORD_SYM(words+n))); Append_Bytes(mold->series, ": "); if (IS_WORD(vals+n) && !GET_MOPT(mold, MOPT_MOLD_ALL)) Append_Byte(mold->series, '\''); Mold_Value(mold, vals+n, TRUE); } } mold->indent--; if (indented) New_Indented_Line(mold); Append_Byte(mold->series, ']'); End_Mold(mold); Remove_Last(MOLD_LOOP); }
*/ 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; }
STOID Form_Object(REBVAL *value, REB_MOLD *mold) { REBSER *wser = VAL_OBJ_WORDS(value); REBVAL *words = BLK_HEAD(wser); REBVAL *vals = VAL_OBJ_VALUES(value); // first value is context REBCNT n; // Prevent endless mold loop: if (Find_Same_Block(MOLD_LOOP, value) > 0) { Append_Bytes(mold->series, "...]"); return; } Append_Val(MOLD_LOOP, value); // Mold all words and their values: for (n = 1; n < SERIES_TAIL(wser); n++) { if (!VAL_GET_OPT(words+n, OPTS_HIDE)) Emit(mold, "N: V\n", VAL_WORD_SYM(words+n), vals+n); } Remove_Last(mold->series); Remove_Last(MOLD_LOOP); }
RL_API int RL_Set_Value(REBSER *series, u32 index, RXIARG val, int type) /* ** Set a value in a block. ** ** Returns: ** TRUE if index past end and value was appended to tail of block. ** Arguments: ** series - block series pointer ** index - index of the value in the block (zero based) ** val - new value for field ** type - datatype of value */ { REBVAL value = {0}; RXI_To_Value(&value, val, type); if (index >= series->tail) { Append_Val(series, &value); return TRUE; } *BLK_SKIP(series, index) = value; return FALSE; }
STOID Mold_Map(REBVAL *value, REB_MOLD *mold, REBFLG molded) { REBSER *mapser = VAL_SERIES(value); REBVAL *val; // Prevent endless mold loop: if (Find_Same_Block(MOLD_LOOP, value) > 0) { Append_Bytes(mold->series, "...]"); return; } Append_Val(MOLD_LOOP, value); if (molded) { Pre_Mold(value, mold); Append_Byte(mold->series, '['); } // Mold all non-none entries mold->indent++; for (val = BLK_HEAD(mapser); NOT_END(val) && NOT_END(val+1); val += 2) { if (!IS_NONE(val+1)) { if (molded) New_Indented_Line(mold); Emit(mold, "V V", val, val+1); if (!molded) Append_Byte(mold->series, '\n'); } } mold->indent--; if (molded) { New_Indented_Line(mold); Append_Byte(mold->series, ']'); } End_Mold(mold); Remove_Last(MOLD_LOOP); }
*/ static REBFLG Set_GOB_Var(REBGOB *gob, REBVAL *word, REBVAL *val) /* ***********************************************************************/ { REBVAL *spec; REBVAL *hndl; switch (VAL_WORD_CANON(word)) { case SYM_OFFSET: return Set_Pair(&(gob->offset), val); case SYM_SIZE: return Set_Pair(&gob->size, val); case SYM_IMAGE: CLR_GOB_OPAQUE(gob); if (IS_IMAGE(val)) { SET_GOB_TYPE(gob, GOBT_IMAGE); GOB_W(gob) = (REBD32)VAL_IMAGE_WIDE(val); GOB_H(gob) = (REBD32)VAL_IMAGE_HIGH(val); GOB_CONTENT(gob) = VAL_SERIES(val); // if (!VAL_IMAGE_TRANSP(val)) SET_GOB_OPAQUE(gob); } else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE); else return FALSE; break; #ifdef HAS_WIDGET_GOB case SYM_WIDGET: //printf("WIDGET GOB\n"); SET_GOB_TYPE(gob, GOBT_WIDGET); SET_GOB_OPAQUE(gob); GOB_CONTENT(gob) = Make_Block(4); // [handle type spec data] hndl = Append_Value(GOB_CONTENT(gob)); Append_Value(GOB_CONTENT(gob)); // used to cache type on host's side spec = Append_Value(GOB_CONTENT(gob)); Append_Value(GOB_CONTENT(gob)); // used to cache result data SET_HANDLE(hndl, 0, SYM_WIDGET, 0); if (IS_WORD(val) || IS_LIT_WORD(val)) { Set_Block(spec, Make_Block(1)); Append_Val(VAL_SERIES(spec), val); } else if (IS_BLOCK(val)) { Set_Block(spec, VAL_SERIES(val)); } else return FALSE; break; #endif // HAS_WIDGET_GOB case SYM_DRAW: CLR_GOB_OPAQUE(gob); if (IS_BLOCK(val)) { SET_GOB_TYPE(gob, GOBT_DRAW); GOB_CONTENT(gob) = VAL_SERIES(val); } else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE); else return FALSE; break; case SYM_TEXT: CLR_GOB_OPAQUE(gob); if (IS_BLOCK(val)) { SET_GOB_TYPE(gob, GOBT_TEXT); GOB_CONTENT(gob) = VAL_SERIES(val); } else if (IS_STRING(val)) { SET_GOB_TYPE(gob, GOBT_STRING); GOB_CONTENT(gob) = VAL_SERIES(val); } else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE); else return FALSE; break; case SYM_EFFECT: CLR_GOB_OPAQUE(gob); if (IS_BLOCK(val)) { SET_GOB_TYPE(gob, GOBT_EFFECT); GOB_CONTENT(gob) = VAL_SERIES(val); } else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE); else return FALSE; break; case SYM_COLOR: CLR_GOB_OPAQUE(gob); if (IS_TUPLE(val)) { SET_GOB_TYPE(gob, GOBT_COLOR); Set_Pixel_Tuple((REBYTE*)&GOB_CONTENT(gob), val); if (VAL_TUPLE_LEN(val) < 4 || VAL_TUPLE(val)[3] == 255) SET_GOB_OPAQUE(gob); } else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE); break; case SYM_PANE: if (GOB_PANE(gob)) Clear_Series(GOB_PANE(gob)); if (IS_BLOCK(val)) Insert_Gobs(gob, VAL_BLK_DATA(val), 0, VAL_BLK_LEN(val), 0); else if (IS_GOB(val)) Insert_Gobs(gob, val, 0, 1, 0); else if (IS_NONE(val)) gob->pane = 0; else return FALSE; break; case SYM_ALPHA: GOB_ALPHA(gob) = Clip_Int(Int32(val), 0, 255); break; case SYM_DATA: #ifdef HAS_WIDGET_GOB if (GOB_TYPE(gob) == GOBT_WIDGET) { OS_SET_WIDGET_DATA(gob, val); } else { #endif SET_GOB_DTYPE(gob, GOBD_NONE); if (IS_OBJECT(val)) { SET_GOB_DTYPE(gob, GOBD_OBJECT); SET_GOB_DATA(gob, VAL_OBJ_FRAME(val)); } else if (IS_BLOCK(val)) { SET_GOB_DTYPE(gob, GOBD_BLOCK); SET_GOB_DATA(gob, VAL_SERIES(val)); } else if (IS_STRING(val)) { SET_GOB_DTYPE(gob, GOBD_STRING); SET_GOB_DATA(gob, VAL_SERIES(val)); } else if (IS_BINARY(val)) { SET_GOB_DTYPE(gob, GOBD_BINARY); SET_GOB_DATA(gob, VAL_SERIES(val)); } else if (IS_INTEGER(val)) { SET_GOB_DTYPE(gob, GOBD_INTEGER); SET_GOB_DATA(gob, (void*)(REBIPT)VAL_INT64(val)); } else if (IS_NONE(val)) SET_GOB_TYPE(gob, GOBT_NONE); else return FALSE; #ifdef HAS_WIDGET_GOB } #endif break; case SYM_FLAGS: if (IS_WORD(val)) Set_Gob_Flag(gob, val); else if (IS_BLOCK(val)) { gob->flags = 0; for (val = VAL_BLK(val); NOT_END(val); val++) { if (IS_WORD(val)) Set_Gob_Flag(gob, val); } } break; case SYM_OWNER: if (IS_GOB(val)) GOB_TMP_OWNER(gob) = VAL_GOB(val); else return FALSE; break; default: return FALSE; } return TRUE; }
*/ static REBCNT Do_Eval_Rule(REBPARSE *parse, REBCNT index, REBVAL **rule) /* ** Evaluate the input as a code block. Advance input if ** rule succeeds. Return new index or failure. ** ** Examples: ** do skip ** do end ** do "abc" ** do 'abc ** do [...] ** do variable ** do datatype! ** do quote 123 ** do into [...] ** ** Problem: cannot write: set var do datatype! ** ***********************************************************************/ { REBVAL value; REBVAL *item = *rule; REBCNT n; REBPARSE newparse; // First, check for end of input: if (index >= parse->series->tail) { if (IS_WORD(item) && VAL_CMD(item) == SYM_END) return index; else return NOT_FOUND; } // Evaluate next N input values: index = Do_Next(parse->series, index, FALSE); // Value is on top of stack (volatile!): value = *DS_POP; if (THROWN(&value)) Throw_Break(&value); // Get variable or command: if (IS_WORD(item)) { n = VAL_CMD(item); if (n == SYM_SKIP) return (IS_SET(&value)) ? index : NOT_FOUND; if (n == SYM_QUOTE) { item = item + 1; (*rule)++; if (IS_END(item)) Trap1(RE_PARSE_END, item-2); if (IS_PAREN(item)) { item = Do_Block_Value_Throw(item); // might GC } } else if (n == SYM_INTO) { item = item + 1; (*rule)++; if (IS_END(item)) Trap1(RE_PARSE_END, item-2); item = Get_Parse_Value(item); // sub-rules if (!IS_BLOCK(item)) Trap1(RE_PARSE_RULE, item-2); if (!ANY_BINSTR(&value) && !ANY_BLOCK(&value)) return NOT_FOUND; return (Parse_Series(&value, VAL_BLK_DATA(item), parse->flags, 0) == VAL_TAIL(&value)) ? index : NOT_FOUND; } else if (n > 0) Trap1(RE_PARSE_RULE, item); else item = Get_Parse_Value(item); // variable } else if (IS_PATH(item)) { item = Get_Parse_Value(item); // variable } else if (IS_SET_WORD(item) || IS_GET_WORD(item) || IS_SET_PATH(item) || IS_GET_PATH(item)) Trap1(RE_PARSE_RULE, item); if (IS_NONE(item)) { return (VAL_TYPE(&value) > REB_NONE) ? NOT_FOUND : index; } // Copy the value into its own block: newparse.series = Make_Block(1); SAVE_SERIES(newparse.series); Append_Val(newparse.series, &value); newparse.type = REB_BLOCK; newparse.flags = parse->flags; newparse.result = 0; n = (Parse_Next_Block(&newparse, 0, item, 0) != NOT_FOUND) ? index : NOT_FOUND; UNSAVE_SERIES(newparse.series); return n; }
*/ 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; }