//
// MT_Bitset: C
//
REBOOL MT_Bitset(REBVAL *out, REBVAL *data, enum Reb_Kind type)
{
REBOOL is_not = FALSE;
if (IS_BLOCK(data)) {
REBINT len = Find_Max_Bit(data);
REBSER *ser;
if (len < 0 || len > 0xFFFFFF) fail (Error_Invalid_Arg(data));
ser = Make_Bitset(len);
Set_Bits(ser, data, TRUE);
Val_Init_Bitset(out, ser);
return TRUE;
}
if (!IS_BINARY(data)) return FALSE;
Val_Init_Bitset(out, Copy_Sequence_At_Position(data));
BITS_NOT(VAL_SERIES(out)) = FALSE;
return TRUE;
}
*/ REBFLG MT_Bitset(REBVAL *out, REBVAL *data, REBCNT type)
/*
***********************************************************************/
{
REBFLG is_not = 0;
if (IS_BLOCK(data)) {
REBINT len = Find_Max_Bit(data);
REBSER *ser;
if (len < 0 || len > 0xFFFFFF) raise Error_Invalid_Arg(data);
ser = Make_Bitset(len);
Set_Bits(ser, data, TRUE);
Val_Init_Bitset(out, ser);
return TRUE;
}
if (!IS_BINARY(data)) return FALSE;
Val_Init_Bitset(out, Copy_Sequence_At_Position(data));
BITS_NOT(VAL_SERIES(out)) = 0;
return TRUE;
}
//
// Xandor_Binary: C
//
// Only valid for BINARY data.
//
REBSER *Xandor_Binary(const REBVAL *verb, REBVAL *value, REBVAL *arg)
{
REBYTE *p0 = VAL_BIN_AT(value);
REBYTE *p1 = VAL_BIN_AT(arg);
REBCNT t0 = VAL_LEN_AT(value);
REBCNT t1 = VAL_LEN_AT(arg);
REBCNT mt = MIN(t0, t1); // smaller array size
// !!! This used to say "For AND - result is size of shortest input:" but
// the code was commented out
/*
if (verb == A_AND || (verb == 0 && t1 >= t0))
t2 = mt;
else
t2 = MAX(t0, t1);
*/
REBCNT t2 = MAX(t0, t1);
REBSER *series;
if (IS_BITSET(value)) {
//
// Although bitsets and binaries share some implementation here,
// they have distinct allocation functions...and bitsets need
// to set the REBSER.misc.negated union field (BITS_NOT) as
// it would be illegal to read it if it were cleared via another
// element of the union.
//
assert(IS_BITSET(arg));
series = Make_Bitset(t2 * 8);
}
else {
// Ordinary binary
//
series = Make_Binary(t2);
TERM_SEQUENCE_LEN(series, t2);
}
REBYTE *p2 = BIN_HEAD(series);
switch (VAL_WORD_SYM(verb)) {
case SYM_INTERSECT: { // and
REBCNT i;
for (i = 0; i < mt; i++)
*p2++ = *p0++ & *p1++;
CLEAR(p2, t2 - mt);
return series; }
case SYM_UNION: { // or
REBCNT i;
for (i = 0; i < mt; i++)
*p2++ = *p0++ | *p1++;
break; }
case SYM_DIFFERENCE: { // xor
REBCNT i;
for (i = 0; i < mt; i++)
*p2++ = *p0++ ^ *p1++;
break; }
case SYM_EXCLUDE: { // !!! not a "type action", word manually in %words.r
REBCNT i;
for (i = 0; i < mt; i++)
*p2++ = *p0++ & ~*p1++;
if (t0 > t1)
memcpy(p2, p0, t0 - t1); // residual from first only
return series; }
default:
fail (Error_Cannot_Use_Raw(verb, Datatype_From_Kind(REB_BINARY)));
}
// Copy the residual
//
memcpy(p2, ((t0 > t1) ? p0 : p1), t2 - mt);
return series;
}
//
// Xandor_Binary: C
//
// Only valid for BINARY data.
//
REBSER *Xandor_Binary(REBCNT action, REBVAL *value, REBVAL *arg)
{
REBSER *series;
REBYTE *p0 = VAL_BIN_AT(value);
REBYTE *p1 = VAL_BIN_AT(arg);
REBYTE *p2;
REBCNT i;
REBCNT mt, t1, t0, t2;
t0 = VAL_LEN_AT(value);
t1 = VAL_LEN_AT(arg);
mt = MIN(t0, t1); // smaller array size
// For AND - result is size of shortest input:
// if (action == A_AND || (action == 0 && t1 >= t0))
// t2 = mt;
// else
t2 = MAX(t0, t1);
if (IS_BITSET(value)) {
//
// Although bitsets and binaries share some implementation here,
// they have distinct allocation functions...and bitsets need
// to set the REBSER.misc.negated union field (BITS_NOT) as
// it would be illegal to read it if it were cleared via another
// element of the union.
//
assert(IS_BITSET(arg));
series = Make_Bitset(t2 * 8);
}
else {
// Ordinary binary
//
series = Make_Binary(t2);
SET_SERIES_LEN(series, t2);
}
p2 = BIN_HEAD(series);
switch (action) {
case SYM_AND_T: // and~
for (i = 0; i < mt; i++) *p2++ = *p0++ & *p1++;
CLEAR(p2, t2 - mt);
return series;
case SYM_OR_T: // or~
for (i = 0; i < mt; i++) *p2++ = *p0++ | *p1++;
break;
case SYM_XOR_T: // xor~
for (i = 0; i < mt; i++) *p2++ = *p0++ ^ *p1++;
break;
default:
// special bit set case EXCLUDE:
for (i = 0; i < mt; i++) *p2++ = *p0++ & ~*p1++;
if (t0 > t1) memcpy(p2, p0, t0 - t1); // residual from first only
return series;
}
// Copy the residual:
memcpy(p2, ((t0 > t1) ? p0 : p1), t2 - mt);
return series;
}
*/ REBSER *Parse_String(REBSER *series, REBCNT index, REBVAL *rules, REBCNT flags)
/*
***********************************************************************/
{
REBCNT tail = series->tail;
REBSER *blk;
REBSER *set;
REBCNT begin;
REBCNT end;
REBOOL skip_spaces = !(flags & PF_ALL);
REBUNI uc;
blk = BUF_EMIT; // shared series
RESET_SERIES(blk);
// String of delimiters or single character:
if (IS_STRING(rules) || IS_CHAR(rules)) {
begin = Find_Max_Bit(rules);
if (begin <= ' ') begin = ' ' + 1;
set = Make_Bitset(begin);
Set_Bits(set, rules, TRUE);
}
// None, so use defaults ",;":
else {
set = Make_Bitset(1+MAX(',',';'));
Set_Bit(set, ',', TRUE);
Set_Bit(set, ';', TRUE);
}
SAVE_SERIES(set);
// If required, make space delimiters too:
if (skip_spaces) {
for (uc = 1; uc <= ' '; uc++) Set_Bit(set, uc, TRUE);
}
while (index < tail) {
if (--Eval_Count <= 0 || Eval_Signals) Do_Signals();
// Skip whitespace if not /all refinement:
if (skip_spaces) {
uc = 0;
for (; index < tail; index++) {
uc = GET_ANY_CHAR(series, index);
if (!IS_WHITE(uc)) break;
}
}
else
uc = GET_ANY_CHAR(series, index); // prefetch
if (index < tail) {
// Handle quoted strings (in a simple way):
if (uc == '"') {
begin = ++index; // eat quote
for (; index < tail; index++) {
uc = GET_ANY_CHAR(series, index);
if (uc == '"') break;
}
end = index;
if (index < tail) index++;
}
// All other tokens:
else {
begin = index;
for (; index < tail; index++) {
if (Check_Bit(set, GET_ANY_CHAR(series, index), !(flags & PF_CASE))) break;
}
end = index;
}
// Skip trailing spaces:
if (skip_spaces)
for (; index < tail; index++) {
uc = GET_ANY_CHAR(series, index);
if (!IS_WHITE(uc)) break;
}
// Check for and remove separator:
if (Check_Bit(set, GET_ANY_CHAR(series, index), !(flags & PF_CASE))) index++;
// Append new string:
Set_String(Append_Value(blk), Copy_String(series, begin, end - begin));
}
}
UNSAVE_SERIES(set);
return Copy_Block(blk, 0);
}
