*/ REBI64 Int64s(REBVAL *val, REBINT sign) /* ** Get integer as positive, negative 64 bit value. ** Sign field can be ** 0: >= 0 ** 1: > 0 ** -1: < 0 ** ***********************************************************************/ { REBI64 n; if (IS_DECIMAL(val)) { if (VAL_DECIMAL(val) > MAX_I64 || VAL_DECIMAL(val) < MIN_I64) Trap_Range(val); n = (REBI64)VAL_DECIMAL(val); } else { n = VAL_INT64(val); } // More efficient to use positive sense: if ( (sign == 0 && n >= 0) || (sign > 0 && n > 0) || (sign < 0 && n < 0) ) return n; Trap_Range(val); DEAD_END; }
*/ REBINT Get_Num_Arg(REBVAL *val) /* ** Get the amount to skip or pick. ** Allow multiple types. Throw error if not valid. ** Note that the result is one-based. ** ***********************************************************************/ { REBINT n; if (IS_INTEGER(val)) { if (VAL_INT64(val) > (i64)MAX_I32 || VAL_INT64(val) < (i64)MIN_I32) Trap_Range(val); n = VAL_INT32(val); } else if (IS_DECIMAL(val) || IS_PERCENT(val)) { if (VAL_DECIMAL(val) > MAX_I32 || VAL_DECIMAL(val) < MIN_I32) Trap_Range(val); n = (REBINT)VAL_DECIMAL(val); } else if (IS_LOGIC(val)) n = (VAL_LOGIC(val) ? 1 : 2); else Trap_Arg(val); return n; }
*/ REBINT Int32s(REBVAL *val, REBINT sign) /* ** Get integer as positive, negative 32 bit value. ** Sign field can be ** 0: >= 0 ** 1: > 0 ** -1: < 0 ** ***********************************************************************/ { REBINT n = 0; if (IS_DECIMAL(val)) { if (VAL_DECIMAL(val) > MAX_I32 || VAL_DECIMAL(val) < MIN_I32) Trap_Range(val); n = (REBINT)VAL_DECIMAL(val); } else { if (VAL_INT64(val) > (i64)MAX_I32 || VAL_INT64(val) < (i64)MIN_I32) Trap_Range(val); n = VAL_INT32(val); } // More efficient to use positive sense: if ( (sign == 0 && n >= 0) || (sign > 0 && n > 0) || (sign < 0 && n < 0) ) return n; Trap_Range(val); return 0; }
*/ REBINT Int8u(REBVAL *val) /* ***********************************************************************/ { if (VAL_INT64(val) > (i64)255 || VAL_INT64(val) < (i64)0) Trap_Range(val); return VAL_INT32(val); }
*/ REBINT Int32(REBVAL *val) /* ***********************************************************************/ { REBINT n = 0; if (IS_DECIMAL(val)) { if (VAL_DECIMAL(val) > MAX_I32 || VAL_DECIMAL(val) < MIN_I32) Trap_Range(val); n = (REBINT)VAL_DECIMAL(val); } else { if (VAL_INT64(val) > (i64)MAX_I32 || VAL_INT64(val) < (i64)MIN_I32) Trap_Range(val); n = VAL_INT32(val); } return n; }
*/ REBINT PD_String(REBPVS *pvs) /* ***********************************************************************/ { REBVAL *data = pvs->value; REBVAL *val = pvs->setval; REBINT n = 0; REBCNT i; REBINT c; REBSER *ser = VAL_SERIES(data); if (IS_INTEGER(pvs->select)) { n = Int32(pvs->select) + VAL_INDEX(data) - 1; } else return PE_BAD_SELECT; if (val == 0) { if (n < 0 || (REBCNT)n >= SERIES_TAIL(ser)) return PE_NONE; if (IS_BINARY(data)) { SET_INTEGER(pvs->store, *BIN_SKIP(ser, n)); } else { SET_CHAR(pvs->store, GET_ANY_CHAR(ser, n)); } return PE_USE; } if (n < 0 || (REBCNT)n >= SERIES_TAIL(ser)) return PE_BAD_RANGE; if (IS_CHAR(val)) { c = VAL_CHAR(val); if (c > MAX_CHAR) return PE_BAD_SET; } else if (IS_INTEGER(val)) { c = Int32(val); if (c > MAX_CHAR || c < 0) return PE_BAD_SET; if (IS_BINARY(data)) { // special case for binary if (c > 0xff) Trap_Range(val); BIN_HEAD(ser)[n] = (REBYTE)c; return PE_OK; } } else if (ANY_BINSTR(val)) { i = VAL_INDEX(val); if (i >= VAL_TAIL(val)) return PE_BAD_SET; c = GET_ANY_CHAR(VAL_SERIES(val), i); } else return PE_BAD_SELECT; TRAP_PROTECT(ser); if (BYTE_SIZE(ser) && c > 0xff) Widen_String(ser); SET_ANY_CHAR(ser, n, c); return PE_OK; }
*/ REBINT Float_Int16(REBD32 f) /* ***********************************************************************/ { if (fabs(f) > (REBD32)(0x7FFF)) { DS_PUSH_DECIMAL(f); Trap_Range(DS_TOP); } return (REBINT)f; }
*/ static void Sort_Block(REBVAL *block, REBFLG ccase, REBVAL *skipv, REBVAL *compv, REBVAL *part, REBFLG all, REBFLG rev) /* ** series [series!] ** /case {Case sensitive sort} ** /skip {Treat the series as records of fixed size} ** size [integer!] {Size of each record} ** /compare {Comparator offset, block or function} ** comparator [integer! block! function!] ** /part {Sort only part of a series} ** length [number! series!] {Length of series to sort} ** /all {Compare all fields} ** /reverse {Reverse sort order} ** ***********************************************************************/ { REBCNT len; REBCNT skip = 1; REBCNT size = sizeof(REBVAL); // int (*sfunc)(const void *v1, const void *v2); sort_flags.cased = ccase; sort_flags.reverse = rev; sort_flags.compare = 0; sort_flags.offset = 0; if (IS_INTEGER(compv)) sort_flags.offset = Int32(compv)-1; if (ANY_FUNC(compv)) sort_flags.compare = compv; // Determine length of sort: len = Partial1(block, part); if (len <= 1) return; // Skip factor: if (!IS_NONE(skipv)) { skip = Get_Num_Arg(skipv); if (skip <= 0 || len % skip != 0 || skip > len) Trap_Range(skipv); } // Use fast quicksort library function: if (skip > 1) len /= skip, size *= skip; if (sort_flags.compare) qsort((void *)VAL_BLK_DATA(block), len, size, Compare_Call); else qsort((void *)VAL_BLK_DATA(block), len, size, Compare_Val); }
*/ REBINT PD_Time(REBPVS *pvs) /* ***********************************************************************/ { REBVAL *val; REBINT i; REBINT n; REBDEC f; REB_TIMEF tf; if (IS_WORD(pvs->select)) { switch (VAL_WORD_CANON(pvs->select)) { case SYM_HOUR: i = 0; break; case SYM_MINUTE: i = 1; break; case SYM_SECOND: i = 2; break; default: return PE_BAD_SELECT; } } else if (IS_INTEGER(pvs->select)) i = VAL_INT32(pvs->select) - 1; else return PE_BAD_SELECT; Split_Time(VAL_TIME(pvs->value), &tf); // loses sign if (!(val = pvs->setval)) { val = pvs->store; switch(i) { case 0: // hours SET_INTEGER(val, tf.h); break; case 1: SET_INTEGER(val, tf.m); break; case 2: if (tf.n == 0) SET_INTEGER(val, tf.s); else SET_DECIMAL(val, (REBDEC)tf.s + (tf.n * NANO)); break; default: return PE_NONE; } return PE_USE; } else { if (IS_INTEGER(val) || IS_DECIMAL(val)) n = Int32s(val, 0); else if (IS_NONE(val)) n = 0; else return PE_BAD_SET; switch(i) { case 0: tf.h = n; break; case 1: tf.m = n; break; case 2: if (IS_DECIMAL(val)) { f = VAL_DECIMAL(val); if (f < 0.0) Trap_Range(val); tf.s = (REBINT)f; tf.n = (REBINT)((f - tf.s) * SEC_SEC); } else { tf.s = n; tf.n = 0; } break; default: return PE_BAD_SELECT; } VAL_TIME(pvs->value) = Join_Time(&tf); return PE_OK; } }
*/ REBI64 Make_Time(REBVAL *val) /* ** Returns NO_TIME if error. ** ***********************************************************************/ { REBI64 secs = 0; if (IS_TIME(val)) { secs = VAL_TIME(val); } else if (IS_STRING(val)) { REBYTE *bp; REBCNT len; bp = Qualify_String(val, 30, &len, FALSE); // can trap, ret diff str if (!Scan_Time(bp, len, val)) goto no_time; secs = VAL_TIME(val); } else if (IS_INTEGER(val)) { if (VAL_INT64(val) < -MAX_SECONDS || VAL_INT64(val) > MAX_SECONDS) Trap_Range(val); secs = VAL_INT64(val) * SEC_SEC; } else if (IS_DECIMAL(val)) { if (VAL_DECIMAL(val) < (REBDEC)(-MAX_SECONDS) || VAL_DECIMAL(val) > (REBDEC)MAX_SECONDS) Trap_Range(val); secs = DEC_TO_SECS(VAL_DECIMAL(val)); } else if (ANY_BLOCK(val) && VAL_BLK_LEN(val) <= 3) { REBFLG neg = FALSE; REBINT i; val = VAL_BLK_DATA(val); if (!IS_INTEGER(val)) goto no_time; i = Int32(val); if (i < 0) i = -i, neg = TRUE; secs = i * 3600; if (secs > MAX_SECONDS) goto no_time; if (NOT_END(++val)) { if (!IS_INTEGER(val)) goto no_time; if ((i = Int32(val)) < 0) goto no_time; secs += i * 60; if (secs > MAX_SECONDS) goto no_time; if (NOT_END(++val)) { if (IS_INTEGER(val)) { if ((i = Int32(val)) < 0) goto no_time; secs += i; if (secs > MAX_SECONDS) goto no_time; } else if (IS_DECIMAL(val)) { if (secs + (REBI64)VAL_DECIMAL(val) + 1 > MAX_SECONDS) goto no_time; // added in below } else goto no_time; } } secs *= SEC_SEC; if (IS_DECIMAL(val)) secs += DEC_TO_SECS(VAL_DECIMAL(val)); if (neg) secs = -secs; } else no_time: return NO_TIME; return secs; }
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; }