static void Mold_Object(const REBVAL *value, REB_MOLD *mold) { REBSER *wser; REBVAL *words; REBVAL *vals; // first value is context REBCNT n; assert(VAL_OBJ_FRAME(value)); 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_Unencoded(mold->series, "...]"); return; } Append_Value(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)) ){ New_Indented_Line(mold); 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_Unencoded(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--; New_Indented_Line(mold); Append_Byte(mold->series, ']'); End_Mold(mold); Remove_Last(MOLD_LOOP); }
*/ void Rebind_Block(REBSER *frame_src, REBSER *frame_dst, REBSER *block) /* ** Rebind all words that reference src frame to dst frame. ** Rebind is always deep. ** ***********************************************************************/ { REBVAL *value; for (value = BLK_HEAD(block); NOT_END(value); value++) { if (ANY_BLOCK(value)) Rebind_Block(frame_src, frame_dst, VAL_SERIES(value)); else if (ANY_WORD(value) && VAL_WORD_FRAME(value) == frame_src) { VAL_WORD_FRAME(value) = frame_dst; } } }
*/ void Collect_Object(REBSER *prior) /* ** Collect words from a prior object. ** ***********************************************************************/ { REBVAL *words; REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here REBINT n; words = FRM_WORDS(prior); COPY_VALUES(words, BLK_HEAD(BUF_WORDS), SERIES_TAIL(prior)); SERIES_TAIL(BUF_WORDS) = SERIES_TAIL(prior); for (n = 1, words++; NOT_END(words); words++) // skips first = SELF binds[VAL_WORD_CANON(words)] = n++; }
*/ 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_DEAD_END(RE_BAD_FUNC_DEF, blk); } } return words; //Create_Frame(words, 0); }
// // Rehash_Hash: C // // Recompute the entire hash table. Table must be large enough. // static void Rehash_Hash(REBSER *series) { REBVAL *val; REBCNT n; REBCNT key; REBCNT *hashes; if (!series->extra.series) return; hashes = cast(REBCNT*, series->extra.series->data); val = BLK_HEAD(series); for (n = 0; n < series->tail; n += 2, val += 2) { key = Find_Key(series, series->extra.series, val, 2, 0, 0); hashes[key] = n/2+1; } }
*/ void Validate_Port(REBSER *port, REBCNT action) /* ** Because port actors are exposed to the user level, we must ** prevent them from being called with invalid values. ** ***********************************************************************/ { if ( action >= A_MAX_ACTION || port->tail > 50 || SERIES_WIDE(port) != sizeof(REBVAL) || !IS_FRAME(BLK_HEAD(port)) || !IS_OBJECT(BLK_SKIP(port, STD_PORT_SPEC)) ) { raise Error_0(RE_INVALID_PORT); } }
*/ 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); }
*/ void Collect_Object(REBSER *prior) /* ** Collect words from a prior object. ** ***********************************************************************/ { REBVAL *words = FRM_WORDS(prior); REBINT *binds = WORDS_HEAD(Bind_Table); REBINT n; // this is necessary for COPY_VALUES below // to not overwrite memory BUF_WORDS does not own RESIZE_SERIES(BUF_WORDS, SERIES_TAIL(prior)); COPY_VALUES(words, BLK_HEAD(BUF_WORDS), SERIES_TAIL(prior)); SERIES_TAIL(BUF_WORDS) = SERIES_TAIL(prior); for (n = 1, words++; NOT_END(words); words++) // skips first = SELF binds[VAL_WORD_CANON(words)] = n++; }
*/ static void Bind_Values_Inner_Loop(REBINT *binds, REBVAL value[], REBSER *frame, REBCNT mode) /* ** Bind_Values_Core() sets up the binding table and then calls ** this recursive routine to do the actual binding. ** ***********************************************************************/ { REBFLG selfish = !IS_SELFLESS(frame); for (; NOT_END(value); value++) { if (ANY_WORD(value)) { //Print("Word: %s", Get_Sym_Name(VAL_WORD_CANON(value))); // Is the word found in this frame? REBCNT n = binds[VAL_WORD_CANON(value)]; if (n != 0) { if (n == NO_RESULT) n = 0; // SELF word assert(n < SERIES_TAIL(frame)); // Word is in frame, bind it: VAL_WORD_INDEX(value) = n; VAL_WORD_FRAME(value) = frame; } else if (selfish && VAL_WORD_CANON(value) == SYM_SELF) { VAL_WORD_INDEX(value) = 0; VAL_WORD_FRAME(value) = frame; } else { // Word is not in frame. Add it if option is specified: if ((mode & BIND_ALL) || ((mode & BIND_SET) && (IS_SET_WORD(value)))) { Expand_Frame(frame, 1, 1); Append_Frame(frame, value, 0); binds[VAL_WORD_CANON(value)] = VAL_WORD_INDEX(value); } } } else if (ANY_BLOCK(value) && (mode & BIND_DEEP)) Bind_Values_Inner_Loop( binds, VAL_BLK_DATA(value), frame, mode ); else if ((IS_FUNCTION(value) || IS_CLOSURE(value)) && (mode & BIND_FUNC)) Bind_Values_Inner_Loop( binds, BLK_HEAD(VAL_FUNC_BODY(value)), frame, mode ); } }
*/ static void Collect_Frame_Inner_Loop(REBINT *binds, REBVAL value[], REBCNT modes) /* ** The inner recursive loop used for Collect_Frame function below. ** ***********************************************************************/ { for (; NOT_END(value); value++) { if (ANY_WORD(value)) { if (!binds[VAL_WORD_CANON(value)]) { // only once per word if (IS_SET_WORD(value) || modes & BIND_ALL) { REBVAL *word; binds[VAL_WORD_CANON(value)] = SERIES_TAIL(BUF_WORDS); EXPAND_SERIES_TAIL(BUF_WORDS, 1); word = BLK_LAST(BUF_WORDS); Val_Init_Word_Typed( word, VAL_TYPE(value), VAL_WORD_SYM(value), // Allow all datatypes but END or UNSET (initially): ~((TYPESET(REB_END) | TYPESET(REB_UNSET))) ); } } else { // If word duplicated: if (modes & BIND_NO_DUP) { // Reset binding table (note BUF_WORDS may have expanded): REBVAL *word; for (word = BLK_HEAD(BUF_WORDS); NOT_END(word); word++) binds[VAL_WORD_CANON(word)] = 0; RESET_TAIL(BUF_WORDS); // allow reuse raise Error_1(RE_DUP_VARS, value); } } continue; } // Recurse into sub-blocks: if (ANY_EVAL_BLOCK(value) && (modes & BIND_DEEP)) Collect_Frame_Inner_Loop(binds, VAL_BLK_DATA(value), modes); // In this mode (foreach native), do not allow non-words: //else if (modes & BIND_GET) raise Error_Invalid_Arg(value); } BLK_TERM(BUF_WORDS); }
*/ REBSER *Create_Frame(REBSER *words, REBSER *spec) /* ** Create a new frame from a word list. ** The values of the frame are initialized to NONE. ** ***********************************************************************/ { REBINT len = SERIES_TAIL(words); REBSER *frame = Make_Block(len); REBVAL *value = BLK_HEAD(frame); SET_FRAME(value, spec, words); SERIES_TAIL(frame) = len; for (value++, len--; len > 0; len--, value++) SET_NONE(value); // skip first value (self) SET_END(value); return frame; }
*/ 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; }
*/ 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 Collect_Object(REBSER *prior) /* ** Collect words from a prior object. ** ***********************************************************************/ { REBVAL *words = FRM_WORDS(prior); REBINT *binds = WORDS_HEAD(Bind_Table); REBINT n; // this is necessary for memcpy below to not overwrite memory // BUF_WORDS does not own RESIZE_SERIES(BUF_WORDS, SERIES_TAIL(prior)); // Word values can be copied just as bits (these are EXT_WORD_TYPED) memcpy(BLK_HEAD(BUF_WORDS), words, SERIES_TAIL(prior) * sizeof(REBVAL)); SERIES_TAIL(BUF_WORDS) = SERIES_TAIL(prior); for (n = 1, words++; NOT_END(words); words++) // skips first = SELF binds[VAL_WORD_CANON(words)] = n++; }
*/ static void Rehash_Hash(REBSER *series) /* ** Recompute the entire hash table. Table must be large enough. ** ***********************************************************************/ { REBVAL *val; REBCNT n; REBCNT key; REBCNT *hashes; if (!series->extra.series) return; hashes = cast(REBCNT*, series->extra.series->data); val = BLK_HEAD(series); for (n = 0; n < series->tail; n += 2, val += 2) { key = Find_Key(series, series->extra.series, val, 2, 0, 0); hashes[key] = n/2+1; } }
*/ void Dump_Series(REBSER *series, REBYTE *memo) /* ***********************************************************************/ { if (!series) return; Debug_Fmt( Str_Dump[0], //"%s Series %x %s: Wide: %2d - Bias: %d Tail: %d Rest: %d Size: %6d" memo, series, (SERIES_LABEL(series) ? SERIES_LABEL(series) : "-"), SERIES_WIDE(series), SERIES_BIAS(series), SERIES_TAIL(series), SERIES_REST(series), SERIES_TOTAL(series) ); if (SERIES_WIDE(series) == sizeof(REBVAL)) Dump_Values(BLK_HEAD(series), SERIES_TAIL(series)); else Dump_Bytes(series->data, (SERIES_TAIL(series)+1) * SERIES_WIDE(series)); }
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); }
xx*/ void Dump_Block_Raw(REBSER *series, int depth, int max_depth) /* ***********************************************************************/ { REBVAL *val; REBCNT n; REBYTE *str; if (!IS_BLOCK_SERIES(series) || depth > max_depth) return; for (n = 0, val = BLK_HEAD(series); NOT_END(val); val++, n++) { Debug_Chars(' ', depth * 4); if (IS_BLOCK(val)) { Debug_Fmt("%3d: [%s] len: %d", n, Get_Type_Name(val), VAL_TAIL(val)); Dump_Block_Raw(VAL_SERIES(val), depth + 1, max_depth); } else { str = ""; if (ANY_WORD(val)) str = Get_Word_Name(val); Debug_Fmt("%3d: [%s] %s", n, Get_Type_Name(val), str); } } //if (depth == 2) Input_Str(); }
*/ REBSER *Collect_Set_Words(REBVAL *val) /* ** Scan a block, collecting all of its SET words as a block. ** ***********************************************************************/ { REBCNT cnt = 0; REBVAL *val2 = val; REBSER *ser; for (; NOT_END(val); val++) if (IS_SET_WORD(val)) cnt++; val = val2; ser = Make_Block(cnt); val2 = BLK_HEAD(ser); for (; NOT_END(val); val++) { if (IS_SET_WORD(val)) Init_Word(val2++, VAL_WORD_SYM(val)); } SET_END(val2); SERIES_TAIL(ser) = cnt; return ser; }
*/ void Collect_Start(REBCNT modes) /* ** Use the Bind_Table to start collecting new words for ** a frame. Use Collect_End() when done. ** ** WARNING: Do not call code that might call BIND or otherwise ** make use of the Bind_Table or the Word cache array (BUF_WORDS). ** ***********************************************************************/ { REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here CHECK_BIND_TABLE; // Reuse a global word list block because length of block cannot // be known until all words are scanned. Then copy this block. if (SERIES_TAIL(BUF_WORDS)) Crash(RP_WORD_LIST); // still in use // Add the SELF word to slot zero. if ((modes = (modes & BIND_NO_SELF)?0:SYM_SELF)) binds[modes] = -1; // (cannot use zero here) Init_Frame_Word(BLK_HEAD(BUF_WORDS), modes); SERIES_TAIL(BUF_WORDS) = 1; }
*/ void Rebind_Block(REBSER *src_frame, REBSER *dst_frame, REBVAL *data, REBFLG modes) /* ** Rebind all words that reference src frame to dst frame. ** Rebind is always deep. ** ** There are two types of frames: relative frames and normal frames. ** When frame_src type and frame_dst type differ, ** modes must have REBIND_TYPE. ** ***********************************************************************/ { REBINT *binds = WORDS_HEAD(Bind_Table); for (; NOT_END(data); data++) { if (ANY_BLOCK(data)) Rebind_Block(src_frame, dst_frame, VAL_BLK_DATA(data), modes); else if (ANY_WORD(data) && VAL_WORD_FRAME(data) == src_frame) { VAL_WORD_FRAME(data) = dst_frame; if (modes & REBIND_TABLE) VAL_WORD_INDEX(data) = binds[VAL_WORD_CANON(data)]; if (modes & REBIND_TYPE) VAL_WORD_INDEX(data) = - VAL_WORD_INDEX(data); } else if ((modes & REBIND_FUNC) && (IS_FUNCTION(data) || IS_CLOSURE(data))) Rebind_Block(src_frame, dst_frame, BLK_HEAD(VAL_FUNC_BODY(data)), modes); } }
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 REBSER *Pane_To_Block(REBGOB *gob, REBCNT index, REBINT len) /* ** Convert pane list of gob pointers to a block of GOB!s. ** ***********************************************************************/ { REBSER *ser; REBGOB **gp; REBVAL *val; if (len == -1 || (len + index) > GOB_TAIL(gob)) len = GOB_TAIL(gob) - index; if (len < 0) len = 0; ser = Make_Block(len); ser->tail = len; val = BLK_HEAD(ser); gp = GOB_HEAD(gob); for (; len > 0; len--, val++, gp++) { SET_GOB(val, *gp); } SET_END(val); return ser; }
*/ static REBFLG Get_GOB_Var(REBGOB *gob, REBVAL *word, REBVAL *val) /* ***********************************************************************/ { REBSER *data; switch (VAL_WORD_CANON(word)) { case SYM_OFFSET: SET_PAIR(val, GOB_X(gob), GOB_Y(gob)); break; case SYM_SIZE: SET_PAIR(val, GOB_W(gob), GOB_H(gob)); break; case SYM_IMAGE: if (GOB_TYPE(gob) == GOBT_IMAGE) { // image } else goto is_none; break; #ifdef HAS_WIDGET_GOB case SYM_WIDGET: data = VAL_SERIES(GOB_WIDGET_SPEC(gob)); Init_Word(val, VAL_WORD_CANON(BLK_HEAD(data))); VAL_SET(val, REB_LIT_WORD); break; #endif case SYM_DRAW: if (GOB_TYPE(gob) == GOBT_DRAW) { Set_Block(val, GOB_CONTENT(gob)); // Note: compiler optimizes SET_BLOCKs below } else goto is_none; break; case SYM_TEXT: if (GOB_TYPE(gob) == GOBT_TEXT) { Set_Block(val, GOB_CONTENT(gob)); } else if (GOB_TYPE(gob) == GOBT_STRING) { Set_String(val, GOB_CONTENT(gob)); } else goto is_none; break; case SYM_EFFECT: if (GOB_TYPE(gob) == GOBT_EFFECT) { Set_Block(val, GOB_CONTENT(gob)); } else goto is_none; break; case SYM_COLOR: if (GOB_TYPE(gob) == GOBT_COLOR) { Set_Tuple_Pixel((REBYTE*)&GOB_CONTENT(gob), val); } else goto is_none; break; case SYM_ALPHA: SET_INTEGER(val, GOB_ALPHA(gob)); break; case SYM_PANE: if (GOB_PANE(gob)) Set_Block(val, Pane_To_Block(gob, 0, -1)); else Set_Block(val, Make_Block(0)); break; case SYM_PARENT: if (GOB_PARENT(gob)) { SET_GOB(val, GOB_PARENT(gob)); } else is_none: SET_NONE(val); break; case SYM_DATA: #ifdef HAS_WIDGET_GOB if (GOB_TYPE(gob) == GOBT_WIDGET) { return OS_GET_WIDGET_DATA(gob, val); } #endif data = GOB_DATA(gob); if (GOB_DTYPE(gob) == GOBD_OBJECT) { SET_OBJECT(val, data); } else if (GOB_DTYPE(gob) == GOBD_BLOCK) { Set_Block(val, data); } else if (GOB_DTYPE(gob) == GOBD_STRING) { Set_String(val, data); } else if (GOB_DTYPE(gob) == GOBD_BINARY) { SET_BINARY(val, data); } else if (GOB_DTYPE(gob) == GOBD_INTEGER) { SET_INTEGER(val, (REBIPT)data); } else goto is_none; break; case SYM_FLAGS: Set_Block(val, Flags_To_Block(gob)); break; default: return FALSE; } return TRUE; }
*/ REBCNT Modify_Block(REBCNT action, REBSER *dst_ser, REBCNT dst_idx, const REBVAL *src_val, REBCNT flags, REBINT dst_len, REBINT dups) /* ** action: INSERT, APPEND, CHANGE ** ** dst_ser: target ** dst_idx: position ** src_val: source ** flags: AN_ONLY, AN_PART ** dst_len: length to remove ** dups: dup count ** ** return: new dst_idx ** ***********************************************************************/ { REBCNT tail = SERIES_TAIL(dst_ser); REBINT ilen = 1; // length to be inserted REBINT size; // total to insert if (dups < 0) return (action == A_APPEND) ? 0 : dst_idx; if (action == A_APPEND || dst_idx > tail) dst_idx = tail; // Check /PART, compute LEN: if (!GET_FLAG(flags, AN_ONLY) && ANY_BLOCK(src_val)) { // Adjust length of insertion if changing /PART: if (action != A_CHANGE && GET_FLAG(flags, AN_PART)) ilen = dst_len; else ilen = VAL_LEN(src_val); // Are we modifying ourselves? If so, copy src_val block first: if (dst_ser == VAL_SERIES(src_val)) { REBSER *series = Copy_Block( VAL_SERIES(src_val), VAL_INDEX(src_val) ); src_val = BLK_HEAD(series); } else src_val = VAL_BLK_DATA(src_val); // skips by VAL_INDEX values } // Total to insert: size = dups * ilen; if (action != A_CHANGE) { // Always expand dst_ser for INSERT and APPEND actions: Expand_Series(dst_ser, dst_idx, size); } else { if (size > dst_len) Expand_Series(dst_ser, dst_idx, size-dst_len); else if (size < dst_len && GET_FLAG(flags, AN_PART)) Remove_Series(dst_ser, dst_idx, dst_len-size); else if (size + dst_idx > tail) { EXPAND_SERIES_TAIL(dst_ser, size - (tail - dst_idx)); } } tail = (action == A_APPEND) ? 0 : size + dst_idx; dst_idx *= SERIES_WIDE(dst_ser); // loop invariant ilen *= SERIES_WIDE(dst_ser); // loop invariant for (; dups > 0; dups--) { memcpy(dst_ser->data + dst_idx, src_val, ilen); dst_idx += ilen; } BLK_TERM(dst_ser); return tail; }
*/ REBINT Effect_Gob(void *effects, REBSER *block) /* ** Handles all commands for the EFFECT dialect as specified ** in the system/dialects/effect object. ** ** This function calls the REBOL_Dialect interpreter to ** parse the dialect and build and return the command number ** (the index offset in the draw object above) and a block ** of arguments. (For now, just a REBOL block, but this could ** be changed to isolate it from changes in REBOL's internals). ** ** Each arg will be of the specified datatype (given in the ** dialect) or NONE when no argument of that type was given ** and this code must determine the proper default value. ** ** If the cmd result is zero, then it is either the end of ** the block, or an error has occurred. If the error value ** is non-zero, then it was an error. ** ***********************************************************************/ { // REBSER *block; REBCNT index = 0; REBINT cmd; REBSER *args = 0; REBVAL *arg; REBCNT nargs; //default values REBYTE def_color1[4] = {0,0,0,0}; REBYTE def_color2[4] = {255,255,255,0}; REBPAR def_pair = {1,0}; do { cmd = Reb_Dialect(DIALECTS_EFFECT, block, &index, &args); if (cmd == 0) return 0; if (cmd < 0) { // Reb_Print("ERROR: %d, Index %d", -cmd, index); return -((REBINT)index+1); } // else // Reb_Print("EFFECT: Cmd %d, Index %d, Args %m", cmd, index, args); arg = BLK_HEAD(args); nargs = SERIES_TAIL(args); // Reb_Print("Number of args: %d", nargs); switch (cmd) { case EW_ADD: FX_Add(effects, ARG_OPT_IMAGE(0), ARG_OPT_IMAGE(1)); break; case EW_ALPHAMUL: if (IS_IMAGE(arg)) FX_Alphamul(effects, ARG_IMAGE(0), IS_NONE(arg+1) ? 127 : ARG_INTEGER(1)); break; case EW_ASPECT: { REBINT type = 1, mode = 2; if (ARG_WORD(0) == EW_RESAMPLE){ type = 2; mode = 1; } FX_Fit(effects,ARG_OPT_IMAGE(0), ARG_WORDS(type,EW_NEAREST,EW_GAUSSIAN), ARG_WORD(mode) == EW_RESAMPLE, IS_NONE(arg+3) ? 1.0 : ARG_DECIMAL(3), TRUE); } break; case EW_BLUR: // FX_Blur(effects, ARG_OPT_IMAGE(0)); { REBDEC filter[9] = {0, 1, 0, 1, 1, 1, 0, 1, 0}; FX_Convolve(effects, ARG_OPT_IMAGE(0),filter , 5.0, 0, FALSE); } break; case EW_COLORIFY: FX_Colorify(effects, IS_NONE(arg+1) ? def_color2 : ARG_TUPLE(1) , IS_NONE(arg+2) ? 255 : max(0, min(255,ARG_INTEGER(2))), ARG_OPT_IMAGE(0)); break; case EW_COLORIZE: FX_Colorize(effects, IS_NONE(arg+1) ? def_color2 : ARG_TUPLE(1) , ARG_OPT_IMAGE(0)); break; case EW_CONTRAST: FX_Contrast(effects, IS_NONE(arg+1) ? 127 : ARG_INTEGER(1), ARG_OPT_IMAGE(0)); break; case EW_CONVOLVE: //[image! block! decimal! decimal! logic!] if (IS_BLOCK(arg+1)) { REBDEC filter[9]; REBSER* mtx = (REBSER*)ARG_BLOCK(1); REBVAL* slot = BLK_HEAD(mtx); REBCNT len = SERIES_TAIL(mtx) ,i, num = 0; for (i = 0;i<len;i++){ if (IS_DECIMAL(slot+i)) filter[i] = VAL_DECIMAL(slot+i); else if (IS_INTEGER(slot+i)) filter[i] = VAL_INT32(slot+i); else return -cmd; num++; } if (num != 9) return -cmd; FX_Convolve(effects, ARG_OPT_IMAGE(0),filter , ARG_DECIMAL(2), ARG_INTEGER(3), ARG_LOGIC(4)); } break; case EW_CROP: FX_Crop(effects,ARG_OPT_IMAGE(0), IS_NONE(arg+1) ? 0 : &ARG_PAIR(1), IS_NONE(arg+2) ? 0 : &ARG_PAIR(2)); break; case EW_DIFFERENCE: FX_Difference(effects, IS_NONE(arg+2) ? def_color2 : ARG_TUPLE(2), ARG_OPT_IMAGE(0), ARG_OPT_IMAGE(1), (IS_NONE(arg+2)) ? 1 : 0); break; case EW_EMBOSS: { REBDEC filter[9] = {-1, 0, 1, -2, 0, 2, -1, 0, 1}; FX_Convolve(effects, ARG_OPT_IMAGE(0),filter , 6.0, 127, FALSE); } break; case EW_EXTEND: FX_Extend(effects,ARG_OPT_IMAGE(0), IS_NONE(arg+1) ? 0 : &ARG_PAIR(1), IS_NONE(arg+2) ? 0 : &ARG_PAIR(2)); break; case EW_FIT: if (IS_IMAGE(arg)){ REBINT type = 1, mode = 2; if (ARG_WORD(0) == EW_RESAMPLE){ type = 2; mode = 1; } FX_Fit(effects,ARG_IMAGE(0), ARG_WORDS(type,EW_NEAREST,EW_GAUSSIAN), ARG_WORD(mode) == EW_RESAMPLE, IS_NONE(arg+3) ? 1.0 : ARG_DECIMAL(3), FALSE); } break; case EW_FLIP: FX_Flip(effects, IS_NONE(arg+1) ? &def_pair : &ARG_PAIR(1), ARG_OPT_IMAGE(0)); break; case EW_GRADCOL: FX_Gradcol(effects, &ARG_PAIR(1), IS_NONE(arg+2) ? def_color1 : ARG_TUPLE(2), IS_NONE(arg+3) ? def_color2 : ARG_TUPLE(3),ARG_OPT_IMAGE(0)); break; case EW_GRADIENT: FX_Gradient(effects, &ARG_PAIR(1), IS_NONE(arg+2) ? def_color1 : ARG_TUPLE(2), IS_NONE(arg+3) ? def_color2 : ARG_TUPLE(3), ARG_OPT_IMAGE(0)); break; case EW_GRADMUL: FX_Gradmul(effects, &ARG_PAIR(1), IS_NONE(arg+2) ? def_color1 : ARG_TUPLE(2), IS_NONE(arg+3) ? def_color2 : ARG_TUPLE(3), ARG_OPT_IMAGE(0)); break; case EW_GRAYSCALE: FX_Grayscale(effects,ARG_OPT_IMAGE(0)); break; case EW_HSV: FX_HSV(effects, IS_NONE(arg+1) ? def_color2 : ARG_TUPLE(1), ARG_OPT_IMAGE(0)); break; case EW_INVERT: FX_Invert(effects,ARG_OPT_IMAGE(0)); break; case EW_KEY: if (IS_IMAGE(arg)) FX_Key(effects, IS_NONE(arg+1) ? def_color1 : ARG_TUPLE(1), ARG_IMAGE(0)); break; case EW_LUMA: FX_Luma(effects, IS_NONE(arg+1) ? 127 : ARG_INTEGER(1),ARG_OPT_IMAGE(0)); break; case EW_MIX: FX_Mix(effects, ARG_OPT_IMAGE(0), ARG_OPT_IMAGE(1)); break; case EW_MULTIPLY: { REBINT i = 0x00FFFFFF; REBYTE* color = (REBYTE*)&i; if (IS_INTEGER(arg+3)) { i = ARG_INTEGER(3); i = i + (i << 8) + (i << 16); } else if (IS_TUPLE(arg+2)) color = ARG_TUPLE(2); FX_Multiply(effects, color ,ARG_OPT_IMAGE(0), ARG_OPT_IMAGE(1), (IS_NONE(arg+2) && IS_NONE(arg+3)) ? 1 : 0); } break; case EW_REFLECT: FX_Reflect(effects, IS_NONE(arg+1) ? &def_pair : &ARG_PAIR(1), ARG_OPT_IMAGE(0)); break; case EW_ROTATE: FX_Rotate(effects, IS_NONE(arg+1) ? 90 : ARG_INTEGER(1), ARG_OPT_IMAGE(0)); break; case EW_SHADOW: if (IS_IMAGE(arg)) FX_Shadow(effects, ARG_IMAGE(0), IS_NONE(arg+1) ? 0 : &ARG_PAIR(1), IS_NONE(arg+2) ? 0 : &ARG_PAIR(2), IS_NONE(arg+3) ? 0 : ARG_TUPLE(3), IS_NONE(arg+4) ? 0 : ARG_DECIMAL(4), IS_NONE(arg+5) ? 0 : ARG_WORD(5) == EW_ONLY); break; case EW_SHARPEN: // FX_Sharpen(effects, ARG_OPT_IMAGE(0)); { REBDEC filter[9] = {0, -1, 0, -1, 8, -1, 0, -1, 0}; FX_Convolve(effects, ARG_OPT_IMAGE(0),filter , 4.0, 0, FALSE); } break; case EW_TILE: if (IS_IMAGE(arg)) FX_Tile(effects, ARG_IMAGE(0), &ARG_PAIR(1)); break; case EW_TILE_VIEW: if (IS_IMAGE(arg)) { REBPAR p; Effect_Offset(effects, &p); FX_Tile(effects, ARG_IMAGE(0), &p); } break; case EW_TINT: FX_Tint(effects, IS_NONE(arg+1) ? 127 : ARG_INTEGER(1),ARG_OPT_IMAGE(0)); break; } } while (TRUE); }
*/ REBCNT Modify_Array(REBCNT action, REBSER *dst_ser, REBCNT dst_idx, const REBVAL *src_val, REBCNT flags, REBINT dst_len, REBINT dups) /* ** action: INSERT, APPEND, CHANGE ** ** dst_ser: target ** dst_idx: position ** src_val: source ** flags: AN_ONLY, AN_PART ** dst_len: length to remove ** dups: dup count ** ** return: new dst_idx ** ***********************************************************************/ { REBCNT tail = SERIES_TAIL(dst_ser); REBINT ilen = 1; // length to be inserted REBINT size; // total to insert #if !defined(NDEBUG) REBINT index; #endif if (IS_UNSET(src_val) || dups < 0) { // If they are effectively asking for "no action" then all we have // to do is return the natural index result for the operation. // (APPEND will return 0, insert the tail of the insertion...so index) return (action == A_APPEND) ? 0 : dst_idx; } if (action == A_APPEND || dst_idx > tail) dst_idx = tail; // Check /PART, compute LEN: if (!GET_FLAG(flags, AN_ONLY) && ANY_ARRAY(src_val)) { // Adjust length of insertion if changing /PART: if (action != A_CHANGE && GET_FLAG(flags, AN_PART)) ilen = dst_len; else ilen = VAL_LEN(src_val); // Are we modifying ourselves? If so, copy src_val block first: if (dst_ser == VAL_SERIES(src_val)) { REBSER *series = Copy_Array_At_Shallow( VAL_SERIES(src_val), VAL_INDEX(src_val) ); src_val = BLK_HEAD(series); } else src_val = VAL_BLK_DATA(src_val); // skips by VAL_INDEX values } // Total to insert: size = dups * ilen; if (action != A_CHANGE) { // Always expand dst_ser for INSERT and APPEND actions: Expand_Series(dst_ser, dst_idx, size); } else { if (size > dst_len) Expand_Series(dst_ser, dst_idx, size-dst_len); else if (size < dst_len && GET_FLAG(flags, AN_PART)) Remove_Series(dst_ser, dst_idx, dst_len-size); else if (size + dst_idx > tail) { EXPAND_SERIES_TAIL(dst_ser, size - (tail - dst_idx)); } } tail = (action == A_APPEND) ? 0 : size + dst_idx; #if !defined(NDEBUG) for (index = 0; index < ilen; index++) { if (SERIES_GET_FLAG(dst_ser, SER_MANAGED)) ASSERT_VALUE_MANAGED(&src_val[index]); } #endif dst_idx *= SERIES_WIDE(dst_ser); // loop invariant ilen *= SERIES_WIDE(dst_ser); // loop invariant for (; dups > 0; dups--) { memcpy(dst_ser->data + dst_idx, src_val, ilen); dst_idx += ilen; } TERM_ARRAY(dst_ser); return tail; }
*/ REBINT Text_Gob(void *richtext, REBSER *block) /* ** Handles all commands for the TEXT dialect as specified ** in the system/dialects/text object. ** ** This function calls the REBOL_Dialect interpreter to ** parse the dialect and build and return the command number ** (the index offset in the text object above) and a block ** of arguments. (For now, just a REBOL block, but this could ** be changed to isolate it from changes in REBOL's internals). ** ** Each arg will be of the specified datatype (given in the ** dialect) or NONE when no argument of that type was given ** and this code must determine the proper default value. ** ** If the cmd result is zero, then it is either the end of ** the block, or an error has occurred. If the error value ** is non-zero, then it was an error. ** ***********************************************************************/ { REBCNT index = 0; REBINT cmd; REBSER *args = 0; REBVAL *arg; REBCNT nargs; //font object conversion related values REBFNT* font; REBVAL* val; REBPAR offset; REBPAR space; //para object conversion related values REBPRA* para; REBPAR origin; REBPAR margin; REBPAR indent; REBPAR scroll; do { cmd = Reb_Dialect(DIALECTS_TEXT, block, &index, &args); if (cmd == 0) return 0; if (cmd < 0) { // Reb_Print("ERROR: %d, Index %d", -cmd, index); return -((REBINT)index+1); } // else // Reb_Print("TEXT: Cmd %d, Index %d, Args %m", cmd, index, args); arg = BLK_HEAD(args); nargs = SERIES_TAIL(args); // Reb_Print("Number of args: %d", nargs); switch (cmd) { case TW_TYPE_SPEC: if (IS_STRING(arg)) { rt_text(richtext, ARG_STRING(0), index); } else if (IS_TUPLE(arg)) { rt_color(richtext, ARG_TUPLE(0)); } break; case TW_ANTI_ALIAS: rt_anti_alias(richtext, ARG_OPT_LOGIC(0)); break; case TW_SCROLL: rt_scroll(richtext, ARG_PAIR(0)); break; case TW_BOLD: case TW_B: rt_bold(richtext, ARG_OPT_LOGIC(0)); break; case TW_ITALIC: case TW_I: rt_italic(richtext, ARG_OPT_LOGIC(0)); break; case TW_UNDERLINE: case TW_U: rt_underline(richtext, ARG_OPT_LOGIC(0)); break; case TW_CENTER: rt_center(richtext); break; case TW_LEFT: rt_left(richtext); break; case TW_RIGHT: rt_right(richtext); break; case TW_FONT: if (!IS_OBJECT(arg)) break; font = (REBFNT*)rt_get_font(richtext); val = BLK_HEAD(ARG_OBJECT(0))+1; if (IS_STRING(val)) { font->name = VAL_STRING(val); } // Reb_Print("font/name: %s", font->name); val++; if (IS_BLOCK(val)) { REBSER* styles = VAL_SERIES(val); REBVAL* slot = BLK_HEAD(styles); REBCNT len = SERIES_TAIL(styles) ,i; for (i = 0;i<len;i++){ if (IS_WORD(slot+i)){ set_font_styles(font, slot+i); } } } else if (IS_WORD(val)) { set_font_styles(font, val); } val++; if (IS_INTEGER(val)) { font->size = VAL_INT32(val); } // Reb_Print("font/size: %d", font->size); val++; if ((IS_TUPLE(val)) || (IS_NONE(val))) { COPY_MEM(font->color,VAL_TUPLE(val), 4); } // Reb_Print("font/color: %d.%d.%d.%d", font->color[0],font->color[1],font->color[2],font->color[3]); val++; if ((IS_PAIR(val)) || (IS_NONE(val))) { offset = VAL_PAIR(val); font->offset_x = offset.x; font->offset_y = offset.y; } // Reb_Print("font/offset: %dx%d", offset.x,offset.y); val++; if ((IS_PAIR(val)) || (IS_NONE(val))) { space = VAL_PAIR(val); font->space_x = space.x; font->space_y = space.y; } // Reb_Print("font/space: %dx%d", space.x, space.y); val++; font->shadow_x = 0; font->shadow_y = 0; if (IS_BLOCK(val)) { REBSER* ser = VAL_SERIES(val); REBVAL* slot = BLK_HEAD(ser); REBCNT len = SERIES_TAIL(ser) ,i; for (i = 0;i<len;i++){ if (IS_PAIR(slot)) { REBPAR shadow = VAL_PAIR(slot); font->shadow_x = shadow.x; font->shadow_y = shadow.y; } else if (IS_TUPLE(slot)) { COPY_MEM(font->shadow_color,VAL_TUPLE(slot), 4); } else if (IS_INTEGER(slot)) { font->shadow_blur = VAL_INT32(slot); } slot++; } } else if (IS_PAIR(val)) { REBPAR shadow = VAL_PAIR(val); font->shadow_x = shadow.x; font->shadow_y = shadow.y; } rt_font(richtext, font); break; case TW_PARA: if (!IS_OBJECT(arg)) break; para = (REBPRA*)rt_get_para(richtext); val = BLK_HEAD(ARG_OBJECT(0))+1; if (IS_PAIR(val)) { origin = VAL_PAIR(val); para->origin_x = origin.x; para->origin_y = origin.y; } // Reb_Print("para/origin: %dx%d", origin.x, origin.y); val++; if (IS_PAIR(val)) { margin = VAL_PAIR(val); para->margin_x = margin.x; para->margin_y = margin.y; } // Reb_Print("para/margin: %dx%d", margin.x, margin.y); val++; if (IS_PAIR(val)) { indent = VAL_PAIR(val); para->indent_x = indent.x; para->indent_y = indent.y; } // Reb_Print("para/indent: %dx%d", indent.x, indent.y); val++; if (IS_INTEGER(val)) { para->tabs = VAL_INT32(val); } // Reb_Print("para/tabs: %d", para->tabs); val++; if (IS_LOGIC(val)) { para->wrap = VAL_LOGIC(val); } // Reb_Print("para/wrap?: %d", para->wrap); val++; if (IS_PAIR(val)) { scroll = VAL_PAIR(val); para->scroll_x = scroll.x; para->scroll_y = scroll.y; } // Reb_Print("para/scroll: %dx%d", scroll.x, scroll.y); val++; if (IS_WORD(val)) { REBINT result = Reb_Find_Word(VAL_WORD_SYM(val), Symbol_Ids, 0); switch (result){ case SW_RIGHT: case SW_LEFT: case SW_CENTER: para->align = result; break; default: para->align = SW_LEFT; break; } } val++; if (IS_WORD(val)) { REBINT result = Reb_Find_Word(VAL_WORD_SYM(val), Symbol_Ids, 0); switch (result){ case SW_TOP: case SW_BOTTOM: case SW_MIDDLE: para->valign = result; break; default: para->valign = SW_TOP; break; } } rt_para(richtext, para); break; case TW_SIZE: rt_font_size(richtext, ARG_INTEGER(0)); break; case TW_SHADOW: rt_shadow(richtext, &ARG_PAIR(0), ARG_TUPLE(1), ARG_INTEGER(2)); break; case TW_DROP: rt_drop(richtext, ARG_OPT_INTEGER(0)); break; case TW_NEWLINE: case TW_NL: rt_newline(richtext, index); break; case TW_CARET: { REBPAR caret = {0,0}; REBPAR highlightStart = {0,0}; REBPAR highlightEnd = {0,0}; REBVAL *slot; if (!IS_OBJECT(arg)) break; val = BLK_HEAD(ARG_OBJECT(0))+1; if (IS_BLOCK(val)) { slot = BLK_HEAD(VAL_SERIES(val)); if (SERIES_TAIL(VAL_SERIES(val)) == 2 && IS_BLOCK(slot) && IS_STRING(slot+1)){ caret.x = 1 + slot->data.series.index; caret.y = 1 + (slot+1)->data.series.index;; //Reb_Print("caret %d, %d", caret.x, caret.y); } } val++; if (IS_BLOCK(val)) { slot = BLK_HEAD(VAL_SERIES(val)); if (SERIES_TAIL(VAL_SERIES(val)) == 2 && IS_BLOCK(slot) && IS_STRING(slot+1)){ highlightStart.x = 1 + slot->data.series.index; highlightStart.y = 1 + (slot+1)->data.series.index;; //Reb_Print("highlight-start %d, %d", highlightStart.x, highlightStart.y); } } val++; if (IS_BLOCK(val)) { slot = BLK_HEAD(VAL_SERIES(val)); if (SERIES_TAIL(VAL_SERIES(val)) == 2 && IS_BLOCK(slot) && IS_STRING(slot+1)){ highlightEnd.x = 1 + slot->data.series.index; highlightEnd.y = 1 + (slot+1)->data.series.index;; //Reb_Print("highlight-End %d, %d", highlightEnd.x, highlightEnd.y); } } rt_caret(richtext, &caret, &highlightStart,&highlightEnd); } break; } } while (TRUE); }
// // Find_Entry: C // // Try to find the entry in the map. If not found // and val is SET, create the entry and store the key and // val. // // RETURNS: the index to the VALUE or zero if there is none. // static REBCNT Find_Entry(REBSER *series, REBVAL *key, REBVAL *val) { REBSER *hser = series->extra.series; // can be null REBCNT *hashes; REBCNT hash; REBVAL *v; REBCNT n; if (IS_NONE(key)) return 0; // We may not be large enough yet for the hash table to // be worthwhile, so just do a linear search: if (!hser) { if (series->tail < MIN_DICT*2) { v = BLK_HEAD(series); if (ANY_WORD(key)) { for (n = 0; n < series->tail; n += 2, v += 2) { if ( ANY_WORD(v) && SAME_SYM(VAL_WORD_SYM(key), VAL_WORD_SYM(v)) ) { if (val) *++v = *val; return n/2+1; } } } else if (ANY_BINSTR(key)) { for (n = 0; n < series->tail; n += 2, v += 2) { if (VAL_TYPE(key) == VAL_TYPE(v) && 0 == Compare_String_Vals(key, v, (REBOOL)!IS_BINARY(v))) { if (val) *++v = *val; return n/2+1; } } } else if (IS_INTEGER(key)) { for (n = 0; n < series->tail; n += 2, v += 2) { if (IS_INTEGER(v) && VAL_INT64(key) == VAL_INT64(v)) { if (val) *++v = *val; return n/2+1; } } } else if (IS_CHAR(key)) { for (n = 0; n < series->tail; n += 2, v += 2) { if (IS_CHAR(v) && VAL_CHAR(key) == VAL_CHAR(v)) { if (val) *++v = *val; return n/2+1; } } } else fail (Error_Has_Bad_Type(key)); if (!val) return 0; Append_Value(series, key); Append_Value(series, val); // does not copy value, e.g. if string return series->tail/2; } // Add hash table: //Print("hash added %d", series->tail); series->extra.series = hser = Make_Hash_Sequence(series->tail); MANAGE_SERIES(hser); Rehash_Hash(series); } // Get hash table, expand it if needed: if (series->tail > hser->tail/2) { Expand_Hash(hser); // modifies size value Rehash_Hash(series); } hash = Find_Key(series, hser, key, 2, 0, 0); hashes = (REBCNT*)hser->data; n = hashes[hash]; // Just a GET of value: if (!val) return n; // Must set the value: if (n) { // re-set it: *BLK_SKIP(series, ((n-1)*2)+1) = *val; // set it return n; } // Create new entry: Append_Value(series, key); Append_Value(series, val); // does not copy value, e.g. if string return (hashes[hash] = series->tail/2); }
*/ int Do_Port_Action(struct Reb_Call *call_, REBSER *port, REBCNT action) /* ** Call a PORT actor (action) value. Search PORT actor ** first. If not found, search the PORT scheme actor. ** ** NOTE: stack must already be setup correctly for action, and ** the caller must cleanup the stack. ** ***********************************************************************/ { REBVAL *actor; REBCNT n = 0; assert(action < A_MAX_ACTION); // Verify valid port (all of these must be false): if ( // Must be = or larger than std port: (SERIES_TAIL(port) < STD_PORT_MAX) || // Must be an object series: !IS_FRAME(BLK_HEAD(port)) || // Must have a spec object: !IS_OBJECT(BLK_SKIP(port, STD_PORT_SPEC)) ) { raise Error_0(RE_INVALID_PORT); } // Get actor for port, if it has one: actor = BLK_SKIP(port, STD_PORT_ACTOR); if (IS_NONE(actor)) return R_NONE; // If actor is a native function: if (IS_NATIVE(actor)) return cast(REBPAF, VAL_FUNC_CODE(actor))(call_, port, action); // actor must be an object: if (!IS_OBJECT(actor)) raise Error_0(RE_INVALID_ACTOR); // Dispatch object function: n = Find_Action(actor, action); actor = Obj_Value(actor, n); if (!n || !actor || !ANY_FUNC(actor)) raise Error_1(RE_NO_PORT_ACTION, Get_Action_Word(action)); if (Redo_Func_Throws(actor)) { // No special handling needed, as we are just going to return // the output value in D_OUT anyway. } return R_OUT; // If not in PORT actor, use the SCHEME actor: #ifdef no_longer_used if (n == 0) { actor = Obj_Value(scheme, STD_SCHEME_actor); if (!actor) goto err; if (IS_NATIVE(actor)) goto fun; if (!IS_OBJECT(actor)) goto err; //vTrap_Expect(value, STD_PORT_actor, REB_OBJECT); n = Find_Action(actor, action); if (n == 0) goto err; } #endif }