*/ void Sieve_Ports(REBSER *ports)
/*
** Remove all ports not found in the WAKE list.
** ports could be NULL, in which case the WAKE list is cleared.
**
***********************************************************************/
{
REBVAL *port;
REBVAL *waked;
REBVAL *val;
REBCNT n;
port = Get_System(SYS_PORTS, PORTS_SYSTEM);
if (!IS_PORT(port)) return;
waked = VAL_OBJ_VALUE(port, STD_PORT_DATA);
if (!IS_BLOCK(waked)) return;
for (n = 0; ports && n < SERIES_TAIL(ports);) {
val = BLK_SKIP(ports, n);
if (IS_PORT(val)) {
assert(VAL_TAIL(waked) != 0);
if (VAL_TAIL(waked) == Find_Block_Simple(VAL_SERIES(waked), 0, val)) {//not found
Remove_Series(ports, n, 1);
continue;
}
}
n++;
}
//clear waked list
RESET_SERIES(VAL_SERIES(waked));
}
//
// Compare_Vector: C
//
REBINT Compare_Vector(const RELVAL *v1, const RELVAL *v2)
{
REBCNT l1 = VAL_LEN_AT(v1);
REBCNT l2 = VAL_LEN_AT(v2);
REBCNT len = MIN(l1, l2);
REBCNT n;
REBU64 i1;
REBU64 i2;
REBYTE *d1 = SER_DATA_RAW(VAL_SERIES(v1));
REBYTE *d2 = SER_DATA_RAW(VAL_SERIES(v2));
REBCNT b1 = VECT_TYPE(VAL_SERIES(v1));
REBCNT b2 = VECT_TYPE(VAL_SERIES(v2));
if ((b1 >= VTSF08 && b2 < VTSF08) || (b2 >= VTSF08 && b1 < VTSF08))
fail (Error(RE_NOT_SAME_TYPE));
for (n = 0; n < len; n++) {
i1 = get_vect(b1, d1, n + VAL_INDEX(v1));
i2 = get_vect(b2, d2, n + VAL_INDEX(v2));
if (i1 != i2) break;
}
if (n != len) {
if (i1 > i2) return 1;
return -1;
}
return l1 - l2;
}
*/ REBINT PD_Block(REBPVS *pvs)
/*
***********************************************************************/
{
REBINT n = 0;
/* Issues!!!
a/1.3
a/not-found: 10 error or append?
a/not-followed: 10 error or append?
*/
if (IS_INTEGER(pvs->select)) {
n = Int32(pvs->select) + VAL_INDEX(pvs->value) - 1;
}
else if (IS_WORD(pvs->select)) {
n = Find_Word(VAL_SERIES(pvs->value), VAL_INDEX(pvs->value), VAL_WORD_CANON(pvs->select));
if (n != NOT_FOUND) n++;
}
else {
// other values:
n = Find_Block_Simple(VAL_SERIES(pvs->value), VAL_INDEX(pvs->value), pvs->select) + 1;
}
if (n < 0 || (REBCNT)n >= VAL_TAIL(pvs->value)) {
if (pvs->setval) return PE_BAD_SELECT;
return PE_NONE;
}
if (pvs->setval) TRAP_PROTECT(VAL_SERIES(pvs->value));
pvs->value = VAL_BLK_SKIP(pvs->value, n);
// if valset - check PROTECT on block
//if (NOT_END(pvs->path+1)) Next_Path(pvs); return PE_OK;
return PE_SET;
}
static REBCNT find_string(REBSER *series, REBCNT index, REBCNT end, REBVAL *target, REBCNT len, REBCNT flags, REBINT skip)
{
REBCNT start = index;
if (flags & (AM_FIND_REVERSE | AM_FIND_LAST)) {
skip = -1;
start = 0;
if (flags & AM_FIND_LAST) index = end - len;
else index--;
}
if (ANY_BINSTR(target)) {
// Do the optimal search or the general search?
if (BYTE_SIZE(series) && VAL_BYTE_SIZE(target) && !(flags & ~(AM_FIND_CASE|AM_FIND_MATCH)))
return Find_Byte_Str(series, start, VAL_BIN_DATA(target), len, !GET_FLAG(flags, ARG_FIND_CASE-1), GET_FLAG(flags, ARG_FIND_MATCH-1));
else
return Find_Str_Str(series, start, index, end, skip, VAL_SERIES(target), VAL_INDEX(target), len, flags & (AM_FIND_MATCH|AM_FIND_CASE));
}
else if (IS_BINARY(target)) {
return Find_Byte_Str(series, start, VAL_BIN_DATA(target), len, 0, GET_FLAG(flags, ARG_FIND_MATCH-1));
}
else if (IS_CHAR(target)) {
return Find_Str_Char(series, start, index, end, skip, VAL_CHAR(target), flags);
}
else if (IS_INTEGER(target)) {
return Find_Str_Char(series, start, index, end, skip, (REBUNI)VAL_INT32(target), flags);
}
else if (IS_BITSET(target)) {
return Find_Str_Bitset(series, start, index, end, skip, VAL_SERIES(target), flags);
}
return NOT_FOUND;
}
*/ REBFLG Copy_Function(REBVAL *value, REBVAL *args)
/*
***********************************************************************/
{
REBVAL *spec = VAL_BLK(args);
REBVAL *body = VAL_BLK_SKIP(args, 1);
if (IS_END(spec)) body = 0;
else {
// Spec given, must be block or *
if (IS_BLOCK(spec)) {
VAL_FUNC_SPEC(value) = VAL_SERIES(spec);
VAL_FUNC_ARGS(value) = Check_Func_Spec(VAL_SERIES(spec));
} else
if (!IS_STAR(spec)) return FALSE;
}
if (body && !IS_END(body)) {
if (!IS_FUNCTION(value) && !IS_CLOSURE(value)) return FALSE;
// Body must be block:
if (!IS_BLOCK(body)) return FALSE;
VAL_FUNC_BODY(value) = VAL_SERIES(body);
}
// No body, use protytpe:
else if (IS_FUNCTION(value) || IS_CLOSURE(value))
VAL_FUNC_BODY(value) = Clone_Block(VAL_FUNC_BODY(value));
// Rebind function words:
if (IS_FUNCTION(value))
Bind_Relative(VAL_FUNC_ARGS(value), VAL_FUNC_BODY(value), VAL_FUNC_BODY(value));
return TRUE;
}
*/ REBINT CT_Frame(REBVAL *a, REBVAL *b, REBINT mode)
/*
***********************************************************************/
{
if (mode < 0) return -1;
return VAL_SERIES(a) == VAL_SERIES(b);
}
//
// Partial1: C
//
// Process the /part (or /skip) and other length modifying
// arguments.
//
REBINT Partial1(REBVAL *sval, REBVAL *lval)
{
REBI64 len;
REBINT maxlen;
REBINT is_ser = ANY_SERIES(sval);
// If lval is not set or is BAR!, use the current len of the target value:
if (IS_UNSET(lval) || IS_BAR(lval)) {
if (!is_ser) return 1;
if (VAL_INDEX(sval) >= VAL_LEN_HEAD(sval)) return 0;
return (VAL_LEN_HEAD(sval) - VAL_INDEX(sval));
}
if (IS_INTEGER(lval) || IS_DECIMAL(lval)) len = Int32(lval);
else {
if (is_ser && VAL_TYPE(sval) == VAL_TYPE(lval) && VAL_SERIES(sval) == VAL_SERIES(lval))
len = (REBINT)VAL_INDEX(lval) - (REBINT)VAL_INDEX(sval);
else
fail (Error(RE_INVALID_PART, lval));
}
if (is_ser) {
// Restrict length to the size available:
if (len >= 0) {
maxlen = (REBINT)VAL_LEN_AT(sval);
if (len > maxlen) len = maxlen;
} else {
len = -len;
if (len > (REBINT)VAL_INDEX(sval)) len = (REBINT)VAL_INDEX(sval);
VAL_INDEX(sval) -= (REBCNT)len;
}
}
return (REBINT)len;
}
*/ REBFLG Make_Function(REBCNT type, REBVAL *value, REBVAL *def)
/*
***********************************************************************/
{
REBVAL *spec;
REBVAL *body;
REBCNT len;
if (
!IS_BLOCK(def)
|| (len = VAL_LEN(def)) < 2
|| !IS_BLOCK(spec = VAL_BLK(def))
) return FALSE;
body = VAL_BLK_SKIP(def, 1);
VAL_FUNC_SPEC(value) = VAL_SERIES(spec);
VAL_FUNC_ARGS(value) = Check_Func_Spec(VAL_SERIES(spec));
if (type != REB_COMMAND) {
if (len != 2 || !IS_BLOCK(body)) return FALSE;
VAL_FUNC_BODY(value) = VAL_SERIES(body);
}
else
Make_Command(value, def);
VAL_SET(value, type);
if (type == REB_FUNCTION || type == REB_CLOSURE)
Bind_Relative(VAL_FUNC_ARGS(value), VAL_FUNC_ARGS(value), VAL_FUNC_BODY(value));
return TRUE;
}
*/ REBFLG Make_Function(REBCNT type, REBVAL *value, REBVAL *def)
/*
***********************************************************************/
{
REBVAL *spec;
REBVAL *body;
REBCNT len;
if (
!IS_BLOCK(def)
//// || type < REB_CLOSURE // for now
|| (len = VAL_LEN(def)) < 2
|| !IS_BLOCK(spec = VAL_BLK(def))
) return FALSE;
body = VAL_BLK_SKIP(def, 1);
// Print("Make_Func"); //: %s spec %d", Get_Sym_Name(type+1), SERIES_TAIL(spec));
VAL_FUNC_SPEC(value) = VAL_SERIES(spec);
VAL_FUNC_ARGS(value) = Check_Func_Spec(VAL_SERIES(spec));
if (type != REB_COMMAND) {
if (len != 2 || !IS_BLOCK(body)) return FALSE;
VAL_FUNC_BODY(value) = VAL_SERIES(body);
}
else
Make_Command(value, def);
VAL_SET(value, type);
if (type == REB_FUNCTION)
Bind_Relative(VAL_FUNC_ARGS(value), VAL_FUNC_BODY(value), VAL_FUNC_BODY(value));
return TRUE;
}
*/ REBINT Cmp_Block(REBVAL *sval, REBVAL *tval, REBFLG is_case)
/*
** Compare two blocks and return the difference of the first
** non-matching value.
**
***********************************************************************/
{
REBVAL *s = VAL_BLK_DATA(sval);
REBVAL *t = VAL_BLK_DATA(tval);
REBINT diff;
CHECK_STACK(&s);
if ((VAL_SERIES(sval)==VAL_SERIES(tval))&&
(VAL_INDEX(sval)==VAL_INDEX(tval)))
return 0;
while (!IS_END(s) && (VAL_TYPE(s) == VAL_TYPE(t) ||
(IS_NUMBER(s) && IS_NUMBER(t)))) {
if ((diff = Cmp_Value(s, t, is_case)) != 0)
return diff;
s++, t++;
}
return VAL_TYPE(s) - VAL_TYPE(t);
}
*/ REBINT CT_Map(REBVAL *a, REBVAL *b, REBINT mode)
/*
***********************************************************************/
{
if (mode < 0) return -1;
if (mode == 3) return VAL_SERIES(a) == VAL_SERIES(b);
return 0 == Cmp_Block(a, b, 0);
}
*/ 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;
}
//
// CT_Bitset: C
//
REBINT CT_Bitset(const REBVAL *a, const REBVAL *b, REBINT mode)
{
if (mode == 3) return VAL_SERIES(a) == VAL_SERIES(b);
if (mode >= 0) return (
BITS_NOT(VAL_SERIES(a)) == BITS_NOT(VAL_SERIES(b))
&&
Compare_Binary_Vals(a, b) == 0
);
return -1;
}
//
// Partial: C
//
// Args:
// aval: target value
// bval: argument to modify target (optional)
// lval: length value (or none)
//
// Determine the length of a /PART value. It can be:
// 1. integer or decimal
// 2. relative to A value (bval is null)
// 3. relative to B value
//
// NOTE: Can modify the value's index!
// The result can be negative. ???
//
REBINT Partial(REBVAL *aval, REBVAL *bval, REBVAL *lval)
{
REBVAL *val;
REBINT len;
REBINT maxlen;
// If lval is unset, use the current len of the target value:
if (IS_UNSET(lval)) {
val = (bval && ANY_SERIES(bval)) ? bval : aval;
if (VAL_INDEX(val) >= VAL_LEN_HEAD(val)) return 0;
return (VAL_LEN_HEAD(val) - VAL_INDEX(val));
}
if (IS_INTEGER(lval) || IS_DECIMAL(lval)) {
len = Int32(lval);
val = bval;
}
else {
// So, lval must be relative to aval or bval series:
if (
VAL_TYPE(aval) == VAL_TYPE(lval)
&& VAL_SERIES(aval) == VAL_SERIES(lval)
) {
val = aval;
}
else if (
bval
&& VAL_TYPE(bval) == VAL_TYPE(lval)
&& VAL_SERIES(bval) == VAL_SERIES(lval)
) {
val = bval;
}
else
fail (Error(RE_INVALID_PART, lval));
len = cast(REBINT, VAL_INDEX(lval)) - cast(REBINT, VAL_INDEX(val));
}
if (!val) val = aval;
// Restrict length to the size available
//
if (len >= 0) {
maxlen = (REBINT)VAL_LEN_AT(val);
if (len > maxlen) len = maxlen;
}
else {
len = -len;
if (len > cast(REBINT, VAL_INDEX(val)))
len = cast(REBINT, VAL_INDEX(val));
VAL_INDEX(val) -= (REBCNT)len;
}
return len;
}
*/ REBINT CT_String(REBVAL *a, REBVAL *b, REBINT mode)
/*
***********************************************************************/
{
REBINT num;
if (mode == 3)
return VAL_SERIES(a) == VAL_SERIES(b) && VAL_INDEX(a) == VAL_INDEX(b);
num = Compare_String_Vals(a, b, (REBOOL) !(mode > 1));
if (mode >= 0) return (num == 0);
if (mode == -1) return (num >= 0);
return (num > 0);
}
*/ REBINT CT_Block(REBVAL *a, REBVAL *b, REBINT mode)
/*
***********************************************************************/
{
REBINT num;
if (mode == 3)
return VAL_SERIES(a) == VAL_SERIES(b) && VAL_INDEX(a) == VAL_INDEX(b);
num = Cmp_Block(a, b, mode > 1);
if (mode >= 0) return (num == 0);
if (mode == -1) return (num >= 0);
return (num > 0);
}
STOID Mold_File(REBVAL *value, REB_MOLD *mold)
{
REBUNI *dp;
REBCNT n;
REBUNI c;
REBCNT len = VAL_LEN(value);
REBSER *ser = VAL_SERIES(value);
// Compute extra space needed for hex encoded characters:
for (n = VAL_INDEX(value); n < VAL_TAIL(value); n++) {
c = GET_ANY_CHAR(ser, n);
if (IS_FILE_ESC(c)) len += 2;
}
len++; // room for % at start
dp = Prep_Uni_Series(mold, len);
*dp++ = '%';
for (n = VAL_INDEX(value); n < VAL_TAIL(value); n++) {
c = GET_ANY_CHAR(ser, n);
if (IS_FILE_ESC(c)) dp = Form_Hex_Esc_Uni(dp, c); // c => %xx
else *dp++ = c;
}
*dp = 0;
}
static void swap_chars(REBVAL *val1, REBVAL *val2)
{
REBUNI c1;
REBUNI c2;
REBSER *s1 = VAL_SERIES(val1);
REBSER *s2 = VAL_SERIES(val2);
c1 = GET_ANY_CHAR(s1, VAL_INDEX(val1));
c2 = GET_ANY_CHAR(s2, VAL_INDEX(val2));
if (BYTE_SIZE(s1) && c2 > 0xff) Widen_String(s1);
SET_ANY_CHAR(s1, VAL_INDEX(val1), c2);
if (BYTE_SIZE(s2) && c1 > 0xff) Widen_String(s2);
SET_ANY_CHAR(s2, VAL_INDEX(val2), c1);
}
*/ REBINT PD_File(REBPVS *pvs)
/*
***********************************************************************/
{
REBSER *ser;
REB_MOLD mo = {0};
REBCNT n;
REBUNI c;
REBSER *arg;
if (pvs->setval) return PE_BAD_SET;
ser = Copy_Series_Value(pvs->value);
n = SERIES_TAIL(ser);
if (n > 0) c = GET_ANY_CHAR(ser, n-1);
if (n == 0 || c != '/') Append_Byte(ser, '/');
if (ANY_STR(pvs->select))
arg = VAL_SERIES(pvs->select);
else {
Reset_Mold(&mo);
Mold_Value(&mo, pvs->select, 0);
arg = mo.series;
}
c = GET_ANY_CHAR(arg, 0);
n = (c == '/' || c == '\\') ? 1 : 0;
Append_String(ser, arg, n, arg->tail-n);
Set_Series(VAL_TYPE(pvs->value), pvs->store, ser);
return PE_USE;
}
//
// Pick_Vector: C
//
void Pick_Vector(REBVAL *out, const REBVAL *value, const REBVAL *picker) {
REBSER *vect = VAL_SERIES(value);
REBINT n;
if (IS_INTEGER(picker) || IS_DECIMAL(picker))
n = Int32(picker);
else
fail (Error_Invalid_Arg(picker));
n += VAL_INDEX(value);
if (n <= 0 || cast(REBCNT, n) > SER_LEN(vect)) {
SET_VOID(out); // out of range of vector data
return;
}
REBYTE *vp = SER_DATA_RAW(vect);
REBINT bits = VECT_TYPE(vect);
if (bits < VTSF08)
SET_INTEGER(out, get_vect(bits, vp, n - 1)); // 64-bit
else {
VAL_RESET_HEADER(out, REB_DECIMAL);
INIT_DECIMAL_BITS(out, get_vect(bits, vp, n - 1)); // 64-bit
}
}
*/ REBVAL *Append_Event()
/*
** Append an event to the end of the current event port queue.
** Return a pointer to the event value.
**
** Note: this function may be called from out of environment,
** so do NOT extend the event queue here. If it does not have
** space, return 0. (Should it overwrite or wrap???)
**
***********************************************************************/
{
REBVAL *port;
REBVAL *value;
REBVAL *state;
port = Get_System(SYS_PORTS, PORTS_SYSTEM);
if (!IS_PORT(port)) return 0; // verify it is a port object
// Get queue block:
state = VAL_BLK_SKIP(port, STD_PORT_STATE);
if (!IS_BLOCK(state)) return 0;
// Append to tail if room:
if (SERIES_FULL(VAL_SERIES(state))) Crash(RP_MAX_EVENTS);
VAL_TAIL(state)++;
value = VAL_BLK_TAIL(state);
SET_END(value);
value--;
SET_NONE(value);
//Dump_Series(VAL_SERIES(state), "state");
//Print("Tail: %d %d", VAL_TAIL(state), nn++);
return value;
}
REBVAL *N_watch(REBFRM *frame, REBVAL **inter_block)
{
WatchVar = Get_Word(FRM_ARG1(frame));
Watcher = VAL_SERIES(WatchVar);
SET_INTEGER(FRM_ARG1(frame), 0);
return Nothing;
}
*/ void Set_Error_Type(ERROR_OBJ *error)
/*
** Sets error type and id fields based on code number.
**
***********************************************************************/
{
REBSER *cats; // Error catalog object
REBSER *cat; // Error category object
REBCNT n; // Word symbol number
REBCNT code;
code = VAL_INT32(&error->code);
// Set error category:
n = code / 100 + 1;
cats = VAL_OBJ_FRAME(Get_System(SYS_CATALOG, CAT_ERRORS));
if (code >= 0 && n < SERIES_TAIL(cats) &&
NZ(cat = VAL_SERIES(BLK_SKIP(cats, n)))
) {
Set_Word(&error->type, FRM_WORD_SYM(cats, n), cats, n);
// Find word related to the error itself:
n = code % 100 + 3;
if (n < SERIES_TAIL(cat))
Set_Word(&error->id, FRM_WORD_SYM(cat, n), cat, n);
}
}
/***********************************************************************
**
** 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;
}
*/ static void Bind_Relative_Words(REBSER *frame, REBSER *block)
/*
** Recursive function for relative function word binding.
**
** Note: frame arg points to an identifying series of the function,
** not a normal frame. This will be used to verify the word fetch.
**
***********************************************************************/
{
REBVAL *value = BLK_HEAD(block);
REBINT n;
for (; NOT_END(value); value++) {
if (ANY_WORD(value)) {
// Is the word (canon sym) found in this frame?
if (NZ(n = WORDS_HEAD(Bind_Table)[VAL_WORD_CANON(value)])) {
// Word is in frame, bind it:
VAL_WORD_INDEX(value) = n;
VAL_WORD_FRAME(value) = frame; // func body
}
}
else if (ANY_BLOCK(value))
Bind_Relative_Words(frame, VAL_SERIES(value));
}
}
STOID Mold_Tag(REBVAL *value, REB_MOLD *mold)
{
Append_Byte(mold->series, '<');
Insert_String(mold->series, AT_TAIL, VAL_SERIES(value), VAL_INDEX(value), VAL_LEN(value), 0);
Append_Byte(mold->series, '>');
}
*/ static REBFLG Get_Index_Var(REBVAL *item, REBSER *series, REBINT *index)
/*
** Get the series index from a word or path or integer.
**
** Returns: TRUE if value was a series. FALSE if integer.
**
***********************************************************************/
{
REBVAL *hold = item;
if (IS_END(item)) Trap1(RE_PARSE_END, item);
if (IS_WORD(item)) {
if (!VAL_CMD(item)) item = Get_Var(item);
}
else if (IS_PATH(item)) {
REBVAL *path = item;
Do_Path(&path, 0); //!!! function!
item = DS_TOP;
}
else if (!IS_INTEGER(item))
Trap1(RE_PARSE_VARIABLE, hold);
if (IS_INTEGER(item)) {
*index = Int32(item);
return FALSE;
}
if (!ANY_SERIES(item) || VAL_SERIES(item) != series)
Trap1(RE_PARSE_SERIES, hold);
*index = VAL_INDEX(item);
return TRUE;
}
*/ static void Sort_String(REBVAL *string, REBFLG ccase, REBVAL *skipv, REBVAL *compv, REBVAL *part, REBFLG all, REBFLG rev)
/*
***********************************************************************/
{
REBCNT len;
REBCNT skip = 1;
REBCNT size = 1;
int (*sfunc)(const void *v1, const void *v2);
// Determine length of sort:
len = Partial(string, 0, part, 0);
if (len <= 1) return;
// Skip factor:
if (!IS_NONE(skipv)) {
skip = Get_Num_Arg(skipv);
if (skip <= 0 || len % skip != 0 || skip > len)
Trap_Arg(skipv);
}
// Use fast quicksort library function:
if (skip > 1) len /= skip, size *= skip;
sfunc = rev ? Compare_Chr_Rev : Compare_Chr;
//!!uni - needs to compare wide chars too
qsort((void *)VAL_DATA(string), len, size * SERIES_WIDE(VAL_SERIES(string)), sfunc);
}
//
// Mold_Bitset: C
//
void Mold_Bitset(const REBVAL *value, REB_MOLD *mold)
{
REBSER *ser = VAL_SERIES(value);
if (BITS_NOT(ser)) Append_Unencoded(mold->series, "[not bits ");
Mold_Binary(value, mold);
if (BITS_NOT(ser)) Append_Codepoint_Raw(mold->series, ']');
}
//
// Temp_Byte_Chars_May_Fail: C
//
// NOTE: This function returns a temporary result, and uses an internal
// buffer. Do not use it recursively. Also, it will Trap on errors.
//
// Prequalifies a string before using it with a function that
// expects it to be 8-bits. It would be used for instance to convert
// a string that is potentially REBUNI-wide into a form that can be used
// with a Scan_XXX routine, that is expecting ASCII or UTF-8 source.
// (Many TO-XXX conversions from STRING re-use that scanner logic.)
//
// Returns a temporary string and sets the length field.
//
// If `allow_utf8`, the constructed result is converted to UTF8.
//
// Checks or converts it:
//
// 1. it is byte string (not unicode)
// 2. if unicode, copy and return as temp byte string
// 3. it's actual content (less space, newlines) <= max len
// 4. it does not contain other values ("123 456")
// 5. it's not empty or only whitespace
//
REBYTE *Temp_Byte_Chars_May_Fail(
const REBVAL *val,
REBINT max_len,
REBCNT *length,
REBOOL allow_utf8
) {
REBCNT tail = VAL_LEN_HEAD(val);
REBCNT index = VAL_INDEX(val);
REBCNT len;
REBUNI c;
REBYTE *bp;
REBSER *src = VAL_SERIES(val);
if (index > tail) fail (Error(RE_PAST_END));
Resize_Series(BYTE_BUF, max_len+1);
bp = BIN_HEAD(BYTE_BUF);
// Skip leading whitespace:
for (; index < tail; index++) {
c = GET_ANY_CHAR(src, index);
if (!IS_SPACE(c)) break;
}
// Copy chars that are valid:
for (; index < tail; index++) {
c = GET_ANY_CHAR(src, index);
if (c >= 0x80) {
if (!allow_utf8) fail (Error(RE_INVALID_CHARS));
len = Encode_UTF8_Char(bp, c);
max_len -= len;
bp += len;
}
else if (!IS_SPACE(c)) {
*bp++ = (REBYTE)c;
max_len--;
}
else break;
if (max_len < 0)
fail (Error(RE_TOO_LONG));
}
// Rest better be just spaces:
for (; index < tail; index++) {
c = GET_ANY_CHAR(src, index);
if (!IS_SPACE(c)) fail (Error(RE_INVALID_CHARS));
}
*bp = '\0';
len = bp - BIN_HEAD(BYTE_BUF);
if (len == 0) fail (Error(RE_TOO_SHORT));
if (length) *length = len;
return BIN_HEAD(BYTE_BUF);
}