*/ void Do_Command(REBVAL *value) /* ** Evaluates the arguments for a command function and creates ** a resulting stack frame (struct or object) for command processing. ** ** A command value consists of: ** args - same as other funcs ** spec - same as other funcs ** body - [ext-obj func-index] ** ***********************************************************************/ { REBVAL *val = BLK_HEAD(VAL_FUNC_BODY(value)); REBEXT *ext; REBCNT cmd; REBCNT argc; REBCNT n; RXIFRM frm; // args stored here // All of these were checked above on definition: val = BLK_HEAD(VAL_FUNC_BODY(value)); cmd = (int)VAL_INT64(val+1); ext = &Ext_List[VAL_I32(VAL_OBJ_VALUE(val, 1))]; // Handler // Copy args to command frame (array of args): RXA_COUNT(&frm) = argc = SERIES_TAIL(VAL_FUNC_ARGS(value))-1; // not self if (argc > 7) Trap0(RE_BAD_COMMAND); val = DS_ARG(1); for (n = 1; n <= argc; n++, val++) { RXA_TYPE(&frm, n) = Reb_To_RXT[VAL_TYPE(val)]; frm.args[n] = Value_To_RXI(val); } // Call the command: n = ext->call(cmd, &frm, 0); 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); } }
x*/ void Modify_StringX(REBCNT action, REBVAL *string, REBVAL *arg) /* ** Actions: INSERT, APPEND, CHANGE ** ** string [string!] {Series at point to insert} ** value [any-type!] {The value to insert} ** /part {Limits to a given length or position.} ** length [number! series! pair!] ** /only {Inserts a series as a series.} ** /dup {Duplicates the insert a specified number of times.} ** count [number! pair!] ** ***********************************************************************/ { REBSER *series = VAL_SERIES(string); REBCNT index = VAL_INDEX(string); REBCNT tail = VAL_TAIL(string); REBINT rlen; // length to be removed REBINT ilen = 1; // length to be inserted REBINT cnt = 1; // DUP count REBINT size; REBVAL *val; REBSER *arg_ser = 0; // argument series // Length of target (may modify index): (arg can be anything) rlen = Partial1((action == A_CHANGE) ? string : arg, DS_ARG(AN_LENGTH)); index = VAL_INDEX(string); if (action == A_APPEND || index > tail) index = tail; // If the arg is not a string, then we need to create a string: if (IS_BINARY(string)) { if (IS_INTEGER(arg)) { if (VAL_INT64(arg) > 255 || VAL_INT64(arg) < 0) Trap_Range(arg); arg_ser = Make_Binary(1); Append_Byte(arg_ser, VAL_CHAR(arg)); // check for size!!! } else if (!ANY_BINSTR(arg)) Trap_Arg(arg); } else if (IS_BLOCK(arg)) { // MOVE! REB_MOLD mo = {0}; arg_ser = mo.series = Make_Unicode(VAL_BLK_LEN(arg) * 10); // GC!? for (val = VAL_BLK_DATA(arg); NOT_END(val); val++) Mold_Value(&mo, val, 0); } else if (IS_CHAR(arg)) { // Optimize this case !!! arg_ser = Make_Unicode(1); Append_Byte(arg_ser, VAL_CHAR(arg)); } else if (!ANY_STR(arg) || IS_TAG(arg)) { arg_ser = Copy_Form_Value(arg, 0); } if (arg_ser) Set_String(arg, arg_ser); else arg_ser = VAL_SERIES(arg); // Length of insertion: ilen = (action != A_CHANGE && DS_REF(AN_PART)) ? rlen : VAL_LEN(arg); // If Source == Destination we need to prevent possible conflicts. // Clone the argument just to be safe. // (Note: It may be possible to optimize special cases like append !!) if (series == VAL_SERIES(arg)) { arg_ser = Copy_Series_Part(arg_ser, VAL_INDEX(arg), ilen); // GC!? } // Get /DUP count: if (DS_REF(AN_DUP)) { cnt = Int32(DS_ARG(AN_COUNT)); if (cnt <= 0) return; // no changes } // Total to insert: size = cnt * ilen; if (action != A_CHANGE) { // Always expand series for INSERT and APPEND actions: Expand_Series(series, index, size); } else { if (size > rlen) Expand_Series(series, index, size-rlen); else if (size < rlen && DS_REF(AN_PART)) Remove_Series(series, index, rlen-size); else if (size + index > tail) { EXPAND_SERIES_TAIL(series, size - (tail - index)); } } // For dup count: for (; cnt > 0; cnt--) { Insert_String(series, index, arg_ser, VAL_INDEX(arg), ilen, TRUE); index += ilen; } TERM_SERIES(series); VAL_INDEX(string) = (action == A_APPEND) ? 0 : index; }
*/ void Modify_Blockx(REBCNT action, REBVAL *block, REBVAL *arg) /* ** Actions: INSERT, APPEND, CHANGE ** ** block [block!] {Series at point to insert} ** value [any-type!] {The value to insert} ** /part {Limits to a given length or position.} ** length [number! series! pair!] ** /only {Inserts a series as a series.} ** /dup {Duplicates the insert a specified number of times.} ** count [number! pair!] ** ** Add: ** Handle insert [] () case ** What does insert () [] do? ** /deep option for cloning subcontents? ** ***********************************************************************/ { REBSER *series = VAL_SERIES(block); REBCNT index = VAL_INDEX(block); REBCNT tail = VAL_TAIL(block); REBFLG only = DS_REF(AN_ONLY); REBINT rlen; // length to be removed REBINT ilen = 1; // length to be inserted REBINT cnt = 1; // DUP count REBINT size; REBFLG is_blk = FALSE; // arg is a block not a value // Length of target (may modify index): (arg can be anything) rlen = Partial1((action == A_CHANGE) ? block : arg, DS_ARG(AN_LENGTH)); index = VAL_INDEX(block); if (action == A_APPEND || index > tail) index = tail; // Check /PART, compute LEN: if (!only && ANY_BLOCK(arg)) { is_blk = TRUE; // arg is a block // Are we modifying ourselves? If so, copy arg block first: if (series == VAL_SERIES(arg)) { VAL_SERIES(arg) = Copy_Block(VAL_SERIES(arg), VAL_INDEX(arg)); VAL_INDEX(arg) = 0; } // Length of insertion: ilen = (action != A_CHANGE && DS_REF(AN_PART)) ? rlen : VAL_LEN(arg); } // Get /DUP count: if (DS_REF(AN_DUP)) { cnt = Int32(DS_ARG(AN_COUNT)); if (cnt <= 0) return; // no changes } // Total to insert: size = cnt * ilen; if (action != A_CHANGE) { // Always expand series for INSERT and APPEND actions: Expand_Series(series, index, size); } else { if (size > rlen) Expand_Series(series, index, size-rlen); else if (size < rlen && DS_REF(AN_PART)) Remove_Series(series, index, rlen-size); else if (size + index > tail) { EXPAND_SERIES_TAIL(series, size - (tail - index)); } } if (is_blk) arg = VAL_BLK_DATA(arg); // For dup count: VAL_INDEX(block) = (action == A_APPEND) ? 0 : size + index; index *= SERIES_WIDE(series); // loop invariant ilen *= SERIES_WIDE(series); // loop invariant for (; cnt > 0; cnt--) { memcpy(series->data + index, (REBYTE *)arg, ilen); index += ilen; } BLK_TERM(series); }
*/ REBINT Do_Series_Action(REBCNT action, REBVAL *value, REBVAL *arg) /* ** Common series functions. ** ***********************************************************************/ { REBINT index; REBINT tail; REBINT len = 0; // Common setup code for all actions: if (action != A_MAKE && action != A_TO) { index = (REBINT)VAL_INDEX(value); tail = (REBINT)VAL_TAIL(value); } else return -1; switch (action) { //-- Navigation: case A_HEAD: VAL_INDEX(value) = 0; break; case A_TAIL: VAL_INDEX(value) = (REBCNT)tail; break; case A_HEADQ: DECIDE(index == 0); case A_TAILQ: DECIDE(index >= tail); case A_PASTQ: DECIDE(index > tail); case A_NEXT: if (index < tail) VAL_INDEX(value)++; break; case A_BACK: if (index > 0) VAL_INDEX(value)--; break; case A_SKIP: case A_AT: len = Get_Num_Arg(arg); { REBI64 i = (REBI64)index + (REBI64)len; if (action == A_SKIP) { if (IS_LOGIC(arg)) i--; } else { // A_AT if (len > 0) i--; } if (i > (REBI64)tail) i = (REBI64)tail; else if (i < 0) i = 0; VAL_INDEX(value) = (REBCNT)i; } break; /* case A_ATZ: len = Get_Num_Arg(arg); { REBI64 idx = Add_Max(0, index, len, MAX_I32); if (idx < 0) idx = 0; VAL_INDEX(value) = (REBCNT)idx; } break; */ case A_INDEXQ: SET_INTEGER(DS_RETURN, ((REBI64)index) + 1); return R_RET; case A_LENGTHQ: SET_INTEGER(DS_RETURN, tail > index ? tail - index : 0); return R_RET; case A_REMOVE: // /PART length TRAP_PROTECT(VAL_SERIES(value)); len = DS_REF(2) ? Partial(value, 0, DS_ARG(3), 0) : 1; index = (REBINT)VAL_INDEX(value); if (index < tail && len != 0) Remove_Series(VAL_SERIES(value), VAL_INDEX(value), len); break; case A_ADD: // Join_Strings(value, arg); case A_SUBTRACT: // "test this" - 10 case A_MULTIPLY: // "t" * 4 = "tttt" case A_DIVIDE: case A_REMAINDER: case A_POWER: case A_ODDQ: case A_EVENQ: case A_ABSOLUTE: Trap_Action(VAL_TYPE(value), action); default: return -1; } DS_RET_VALUE(value); return R_RET; is_false: return R_FALSE; is_true: return R_TRUE; }
*/ 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; }