*/ REBINT Compare_String_Vals(REBVAL *v1, REBVAL *v2, REBOOL uncase)
/*
** Compare two string values. Either can be byte or unicode wide.
**
** Uncase: compare is case-insensitive.
**
** Used for: general string comparions (various places)
**
***********************************************************************/
{
REBCNT l1 = VAL_LEN(v1);
REBCNT l2 = VAL_LEN(v2);
REBCNT len = MIN(l1, l2);
REBINT n;
if (IS_BINARY(v1) || IS_BINARY(v2)) uncase = FALSE;
if (VAL_BYTE_SIZE(v1)) { // v1 is 8
if (VAL_BYTE_SIZE(v2))
n = Compare_Bytes(VAL_BIN_DATA(v1), VAL_BIN_DATA(v2), len, uncase);
else
n = -Compare_Uni_Byte(VAL_UNI_DATA(v2), VAL_BIN_DATA(v1), len, uncase);
}
else { // v1 is 16
if (VAL_BYTE_SIZE(v2))
n = Compare_Uni_Byte(VAL_UNI_DATA(v1), VAL_BIN_DATA(v2), len, uncase);
else
n = Compare_Uni_Str(VAL_UNI_DATA(v1), VAL_UNI_DATA(v2), len, uncase);
}
if (n != 0) return n;
return l1 - l2;
}
*/ REBSER *Xandor_Binary(REBCNT action, REBVAL *value, REBVAL *arg)
/*
** Only valid for BINARY data.
**
***********************************************************************/
{
REBSER *series;
REBYTE *p0 = VAL_BIN_DATA(value);
REBYTE *p1 = VAL_BIN_DATA(arg);
REBYTE *p2;
REBCNT i;
REBCNT mt, t1, t0, t2;
t0 = VAL_LEN(value);
t1 = VAL_LEN(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);
series = Make_Binary(t2);
SERIES_TAIL(series) = t2;
p2 = BIN_HEAD(series);
switch (action) {
case A_AND:
for (i = 0; i < mt; i++) *p2++ = *p0++ & *p1++;
CLEAR(p2, t2 - mt);
return series;
case A_OR:
for (i = 0; i < mt; i++) *p2++ = *p0++ | *p1++;
break;
case A_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;
}
*/ 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;
}
static int Check_Char_Range(REBVAL *val, REBINT limit)
{
REBCNT len;
if (IS_CHAR(val)) {
if (VAL_CHAR(val) > limit) return R_FALSE;
return R_TRUE;
}
if (IS_INTEGER(val)) {
if (VAL_INT64(val) > limit) return R_FALSE;
return R_TRUE;
}
len = VAL_LEN(val);
if (VAL_BYTE_SIZE(val)) {
REBYTE *bp = VAL_BIN_DATA(val);
if (limit == 0xff) return R_TRUE; // by definition
for (; len > 0; len--, bp++)
if (*bp > limit) return R_FALSE;
} else {
REBUNI *up = VAL_UNI_DATA(val);
for (; len > 0; len--, up++)
if (*up > limit) return R_FALSE;
}
return R_TRUE;
}
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;
}
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, '>');
}
*/ 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;
}
static REBSER *make_string(REBVAL *arg, REBOOL make)
{
REBSER *ser = 0;
// MAKE <type> 123
if (make && (IS_INTEGER(arg) || IS_DECIMAL(arg))) {
ser = Make_Binary(Int32s(arg, 0));
}
// MAKE/TO <type> <binary!>
else if (IS_BINARY(arg)) {
REBYTE *bp = VAL_BIN_DATA(arg);
REBCNT len = VAL_LEN(arg);
switch (What_UTF(bp, len)) {
case 0:
break;
case 8: // UTF-8 encoded
bp += 3;
len -= 3;
break;
default:
Trap0(RE_BAD_DECODE);
}
ser = Decode_UTF_String(bp, len, 8); // UTF-8
}
// MAKE/TO <type> <any-string>
else if (ANY_BINSTR(arg)) {
ser = Copy_String(VAL_SERIES(arg), VAL_INDEX(arg), VAL_LEN(arg));
}
// MAKE/TO <type> <any-word>
else if (ANY_WORD(arg)) {
ser = Copy_Mold_Value(arg, TRUE);
//ser = Append_UTF8(0, Get_Word_Name(arg), -1);
}
// MAKE/TO <type> #"A"
else if (IS_CHAR(arg)) {
ser = (VAL_CHAR(arg) > 0xff) ? Make_Unicode(2) : Make_Binary(2);
Append_Byte(ser, VAL_CHAR(arg));
}
// MAKE/TO <type> <any-value>
// else if (IS_NONE(arg)) {
// ser = Make_Binary(0);
// }
else
ser = Copy_Form_Value(arg, 1<<MOPT_TIGHT);
return ser;
}
*/ REBOOL Cloak(REBOOL decode, REBYTE *cp, REBCNT dlen, REBYTE *kp, REBCNT klen, REBFLG as_is)
/*
** Simple data scrambler. Quality depends on the key length.
** Result is made in place (data string).
**
** The key (kp) is passed as a REBVAL or REBYTE (when klen is !0).
**
***********************************************************************/
{
REBCNT i, n;
REBYTE src[20];
REBYTE dst[20];
if (dlen == 0) return TRUE;
// Decode KEY as VALUE field (binary, string, or integer)
if (klen == 0) {
REBVAL *val = (REBVAL*)kp;
REBSER *ser;
switch (VAL_TYPE(val)) {
case REB_BINARY:
kp = VAL_BIN_DATA(val);
klen = VAL_LEN(val);
break;
case REB_STRING:
ser = Temp_Bin_Str_Managed(val, &i, &klen);
kp = BIN_SKIP(ser, i);
break;
case REB_INTEGER:
INT_TO_STR(VAL_INT64(val), dst);
klen = LEN_BYTES(dst);
as_is = FALSE;
break;
}
if (klen == 0) return FALSE;
}
if (!as_is) {
for (i = 0; i < 20; i++) src[i] = kp[i % klen];
SHA1(src, 20, dst);
klen = 20;
kp = dst;
}
if (decode)
for (i = dlen-1; i > 0; i--) cp[i] ^= cp[i-1] ^ kp[i % klen];
// Change starting byte based all other bytes.
n = 0xa5;
for (i = 1; i < dlen; i++) n += cp[i];
cp[0] ^= (REBYTE)n;
if (!decode)
for (i = 1; i < dlen; i++) cp[i] ^= cp[i-1] ^ kp[i % klen];
return TRUE;
}
*/ static REBSER *Init_Loop(REBVAL *spec, REBVAL *body_blk, REBSER **fram)
/*
** Initialize standard for loops (copy block, make frame, bind).
** Spec: WORD or [WORD ...]
**
***********************************************************************/
{
REBSER *frame;
REBINT len;
REBVAL *word;
REBVAL *vals;
REBSER *body;
// For :WORD format, get the var's value:
if (IS_GET_WORD(spec)) spec = Get_Var(spec);
// Hand-make a FRAME (done for for speed):
len = IS_BLOCK(spec) ? VAL_LEN(spec) : 1;
if (len == 0) Trap_Arg(spec);
frame = Make_Frame(len);
SET_SELFLESS(frame);
SERIES_TAIL(frame) = len+1;
SERIES_TAIL(FRM_WORD_SERIES(frame)) = len+1;
// Setup for loop:
word = FRM_WORD(frame, 1); // skip SELF
vals = BLK_SKIP(frame, 1);
if (IS_BLOCK(spec)) spec = VAL_BLK_DATA(spec);
// Optimally create the FOREACH frame:
while (len-- > 0) {
if (!IS_WORD(spec) && !IS_SET_WORD(spec)) {
// Prevent inconsistent GC state:
Free_Series(FRM_WORD_SERIES(frame));
Free_Series(frame);
Trap_Arg(spec);
}
VAL_SET(word, VAL_TYPE(spec));
VAL_BIND_SYM(word) = VAL_WORD_SYM(spec);
VAL_BIND_TYPESET(word) = ALL_64;
word++;
SET_NONE(vals);
vals++;
spec++;
}
SET_END(word);
SET_END(vals);
body = Clone_Block_Value(body_blk);
Bind_Block(frame, BLK_HEAD(body), BIND_DEEP);
*fram = frame;
return body;
}
*/ static void replace_with(REBSER *ser, REBCNT index, REBCNT tail, REBVAL *with)
/*
** Replace whitespace chars that match WITH string.
**
** Resulting string is always smaller than it was to start.
**
***********************************************************************/
{
#define MAX_WITH 32
REBCNT wlen;
REBUNI with_chars[MAX_WITH]; // chars to be trimmed
REBUNI *up = with_chars;
REBYTE *bp;
REBCNT n;
REBUNI uc;
// Setup WITH array from arg or the default:
n = 0;
if (IS_NONE(with)) {
bp = "\n \r\t";
wlen = n = 4;
}
else if (IS_CHAR(with)) {
wlen = 1;
*up++ = VAL_CHAR(with);
}
else if (IS_INTEGER(with)) {
wlen = 1;
*up++ = Int32s(with, 0);
}
else if (ANY_BINSTR(with)) {
n = VAL_LEN(with);
if (n >= MAX_WITH) n = MAX_WITH-1;
wlen = n;
if (VAL_BYTE_SIZE(with)) {
bp = VAL_BIN_DATA(with);
} else {
memcpy(up, VAL_UNI_DATA(with), n * sizeof(REBUNI));
n = 0;
}
}
for (; n > 0; n--) *up++ = (REBUNI)*bp++;
// Remove all occurances of chars found in WITH string:
for (n = index; index < tail; index++) {
uc = GET_ANY_CHAR(ser, index);
if (!find_in_uni(with_chars, wlen, uc)) {
SET_ANY_CHAR(ser, n, uc);
n++;
}
}
SET_ANY_CHAR(ser, n, 0);
SERIES_TAIL(ser) = n;
}
*/ static REBSER *Init_Loop(const REBVAL *spec, REBVAL *body_blk, REBSER **fram)
/*
** Initialize standard for loops (copy block, make frame, bind).
** Spec: WORD or [WORD ...]
**
***********************************************************************/
{
REBSER *frame;
REBINT len;
REBVAL *word;
REBVAL *vals;
REBSER *body;
// For :WORD format, get the var's value:
if (IS_GET_WORD(spec)) spec = GET_VAR(spec);
// Hand-make a FRAME (done for for speed):
len = IS_BLOCK(spec) ? VAL_LEN(spec) : 1;
if (len == 0) raise Error_Invalid_Arg(spec);
frame = Make_Frame(len, FALSE);
SERIES_TAIL(frame) = len+1;
SERIES_TAIL(FRM_WORD_SERIES(frame)) = len+1;
// Setup for loop:
word = FRM_WORD(frame, 1); // skip SELF
vals = BLK_SKIP(frame, 1);
if (IS_BLOCK(spec)) spec = VAL_BLK_DATA(spec);
// Optimally create the FOREACH frame:
while (len-- > 0) {
if (!IS_WORD(spec) && !IS_SET_WORD(spec)) {
// Prevent inconsistent GC state:
Free_Series(FRM_WORD_SERIES(frame));
Free_Series(frame);
raise Error_Invalid_Arg(spec);
}
Val_Init_Word_Typed(word, VAL_TYPE(spec), VAL_WORD_SYM(spec), ALL_64);
word++;
SET_NONE(vals);
vals++;
spec++;
}
SET_END(word);
SET_END(vals);
body = Copy_Array_At_Deep_Managed(
VAL_SERIES(body_blk), VAL_INDEX(body_blk)
);
Bind_Values_Deep(BLK_HEAD(body), frame);
*fram = frame;
return body;
}
*/ REBSER *Copy_Sequence_At_Position(const REBVAL *position)
/*
** Copy a non-array series from its value structure, using the
** value's index as the location to start copying the data.
**
***********************************************************************/
{
return Copy_Sequence_At_Len(
VAL_SERIES(position), VAL_INDEX(position), VAL_LEN(position)
);
}
*/ REBSER *Temp_Bin_Str_Managed(REBVAL *val, REBCNT *index, REBCNT *length)
/*
** Determines if UTF8 conversion is needed for a series before it
** is used with a byte-oriented function.
**
** If conversion is needed, a UTF8 series will be created. Otherwise,
** the source series is returned as-is.
**
** Note: This routine should only be used to generate a value used
** for temporary purposes, because it has a "surprising variance"
** regarding its input. If the value's series can be reused, it is--
** and this depends on an implementation detail of internal encoding
** that the user should not be aware of (they need not know if the
** internal representation of an ASCII string uses 1, 2, or however
** many bytes). But copying vs. non-copying means the resulting
** data might or might not have previous values available to step
** back into from the originating series!
**
** !!! Should performance dictate it, the callsites could be
** adapted to know whether this produced a new series or not, and
** instead of managing a created result they could be responsible
** for freeing it if so.
**
***********************************************************************/
{
REBCNT len = (length && *length) ? *length : VAL_LEN(val);
REBSER *series;
assert(IS_BINARY(val) || ANY_STR(val));
if (len == 0 || IS_BINARY(val) || VAL_STR_IS_ASCII(val)) {
// If it's zero length, BINARY!, or an ANY-STRING! whose bytes are
// all values less than 128, we reuse the series.
series = VAL_SERIES(val);
ASSERT_SERIES_MANAGED(series);
if (index) *index = VAL_INDEX(val);
if (length) *length = len;
}
else {
// UTF-8 conversion is required, and we manage the result.
series = Make_UTF8_From_Any_String(val, len, OPT_ENC_CRLF_MAYBE);
MANAGE_SERIES(series);
if (index) *index = 0;
if (length) *length = SERIES_TAIL(series);
}
return series;
}
*/ REBINT Compare_Binary_Vals(REBVAL *v1, REBVAL *v2)
/*
** Compare two binary values.
**
** Compares bytes, not chars. Return the difference.
**
** Used for: Binary comparision function
**
***********************************************************************/
{
REBCNT l1 = VAL_LEN(v1);
REBCNT l2 = VAL_LEN(v2);
REBCNT len = MIN(l1, l2);
REBINT n;
if (IS_IMAGE(v1)) len *= 4;
n = memcmp(VAL_BIN_DATA(v1), VAL_BIN_DATA(v2), len);
if (n != 0) return n;
return l1 - l2;
}
*/ static void Binary_To_Decimal(REBVAL *bin, REBVAL *dec)
/*
***********************************************************************/
{
REBI64 n = 0;
REBSER *ser = VAL_SERIES(bin);
REBCNT idx = VAL_INDEX(bin);
REBCNT len = VAL_LEN(bin);
if (len > 8) len = 8;
for (; len; len--, idx++) n = (n << 8) | (REBI64)(GET_ANY_CHAR(ser, idx));
VAL_SET(dec, REB_DECIMAL);
VAL_INT64(dec) = n; // aliasing the bits!
}
*/ void Shuffle_Block(REBVAL *value, REBFLG secure)
/*
***********************************************************************/
{
REBCNT n;
REBCNT k;
REBCNT idx = VAL_INDEX(value);
REBVAL *data = VAL_BLK(value);
REBVAL swap;
for (n = VAL_LEN(value); n > 1;) {
k = idx + (REBCNT)Random_Int(secure) % n;
n--;
swap = data[k];
data[k] = data[n + idx];
data[n + idx] = swap;
}
}
STOID Mold_Issue(REBVAL *value, REB_MOLD *mold)
{
REBUNI *dp;
REBCNT n;
REBUNI c;
REBSER *ser = VAL_SERIES(value);
dp = Prep_Uni_Series(mold, VAL_LEN(value)+1); // '#' extra
*dp++ = '#';
for (n = VAL_INDEX(value); n < VAL_TAIL(value); n++) {
c = GET_ANY_CHAR(ser, n);
if (IS_LEX_DELIMIT(c)) c = '?';
*dp++ = c;
}
*dp = 0;
}
*/ REBSER *Complement_Binary(REBVAL *value)
/*
** Only valid for BINARY data.
**
***********************************************************************/
{
REBSER *series;
REBYTE *str = VAL_BIN_DATA(value);
REBINT len = VAL_LEN(value);
REBYTE *out;
series = Make_Binary(len);
SERIES_TAIL(series) = len;
out = BIN_HEAD(series);
for (; len > 0; len--)
*out++ = ~ *str++;
return series;
}
*/ REBCHR *Val_Str_To_OS_Managed(REBSER **out, REBVAL *val)
/*
** This is used to pass a REBOL value string to an OS API.
**
** The REBOL (input) string can be byte or wide sized.
** The OS (output) string is in the native OS format.
** On Windows, its a wide-char, but on Linux, its UTF-8.
**
** If we know that the string can be used directly as-is,
** (because it's in the OS size format), we can used it
** like that.
**
** !!! The series is created but just let up to the garbage
** collector to free. This is a "leaky" approach. You may
** optionally request to have the series returned if it is
** important for you to protect it from GC, but you cannot
** currently get a "freeable" series out of this.
**
***********************************************************************/
{
#ifdef OS_WIDE_CHAR
if (VAL_BYTE_SIZE(val)) {
// On windows, we need to convert byte to wide:
REBINT n = VAL_LEN(val);
REBSER *up = Make_Unicode(n);
// !!!"Leaks" in the sense that the GC has to take care of this
MANAGE_SERIES(up);
n = Decode_UTF8(UNI_HEAD(up), VAL_BIN_DATA(val), n, FALSE);
SERIES_TAIL(up) = abs(n);
UNI_TERM(up);
if (out) *out = up;
return cast(REBCHR*, UNI_HEAD(up));
}
else {
// Already wide, we can use it as-is:
// !Assumes the OS uses same wide format!
if (out) *out = VAL_SERIES(val);
*/ REBSER *Split_Lines(REBVAL *val)
/*
** Given a string series, split lines on CR-LF.
** Series can be bytes or Unicode.
**
***********************************************************************/
{
REBSER *ser = BUF_EMIT; // GC protected (because it is emit buffer)
REBSER *str = VAL_SERIES(val);
REBCNT len = VAL_LEN(val);
REBCNT idx = VAL_INDEX(val);
REBCNT start = idx;
REBSER *out;
REBUNI c;
BLK_RESET(ser);
while (idx < len) {
c = GET_ANY_CHAR(str, idx);
if (c == LF || c == CR) {
out = Copy_String(str, start, idx - start);
val = Alloc_Tail_Array(ser);
Val_Init_String(val, out);
VAL_SET_OPT(val, OPT_VALUE_LINE);
idx++;
if (c == CR && GET_ANY_CHAR(str, idx) == LF)
idx++;
start = idx;
}
else idx++;
}
// Possible remainder (no terminator)
if (idx > start) {
out = Copy_String(str, start, idx - start);
val = Alloc_Tail_Array(ser);
Val_Init_String(val, out);
VAL_SET_OPT(val, OPT_VALUE_LINE);
}
return Copy_Array_Shallow(ser);
}
*/ 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 Shuffle_String(REBVAL *value, REBFLG secure)
/*
** Randomize a string. Return a new string series.
** Handles both BYTE and UNICODE strings.
**
***********************************************************************/
{
REBCNT n;
REBCNT k;
REBSER *series = VAL_SERIES(value);
REBCNT idx = VAL_INDEX(value);
REBUNI swap;
for (n = VAL_LEN(value); n > 1;) {
k = idx + (REBCNT)Random_Int(secure) % n;
n--;
swap = GET_ANY_CHAR(series, k);
SET_ANY_CHAR(series, k, GET_ANY_CHAR(series, n + idx));
SET_ANY_CHAR(series, n + idx, swap);
}
}
*/ REBINT Partial1(REBVAL *sval, REBVAL *lval)
/*
** Process the /part (or /skip) and other length modifying
** arguments.
**
***********************************************************************/
{
REBI64 len;
REBINT maxlen;
REBINT is_ser = ANY_SERIES(sval);
// If lval = NONE, use the current len of the target value:
if (IS_NONE(lval)) {
if (!is_ser) return 1;
if (VAL_INDEX(sval) >= VAL_TAIL(sval)) return 0;
return (VAL_TAIL(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
Trap1(RE_INVALID_PART, lval);
}
if (is_ser) {
// Restrict length to the size available:
if (len >= 0) {
maxlen = (REBINT)VAL_LEN(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;
}
*/ static REBFLG Set_Struct_Var(REBSTU *stu, REBVAL *word, REBVAL *elem, REBVAL *val)
/*
***********************************************************************/
{
struct Struct_Field *field = NULL;
REBCNT i = 0;
field = (struct Struct_Field *)SERIES_DATA(stu->fields);
for (i = 0; i < SERIES_TAIL(stu->fields); i ++, field ++) {
if (VAL_WORD_CANON(word) == VAL_SYM_CANON(BLK_SKIP(PG_Word_Table.series, field->sym))) {
if (field->array) {
if (elem == NULL) { //set the whole array
REBCNT n = 0;
if ((!IS_BLOCK(val) || field->dimension != VAL_LEN(val))) {
return FALSE;
}
for(n = 0; n < field->dimension; n ++) {
if (!assign_scalar(stu, field, n, VAL_BLK_SKIP(val, n))) {
return FALSE;
}
}
} else {// set only one element
if (!IS_INTEGER(elem)
|| VAL_INT32(elem) <= 0
|| VAL_INT32(elem) > cast(REBINT, field->dimension)) {
return FALSE;
}
return assign_scalar(stu, field, VAL_INT32(elem) - 1, val);
}
return TRUE;
} else {
return assign_scalar(stu, field, 0, val);
}
return TRUE;
}
}
return FALSE;
}
*/ REBINT Bin_To_Money(REBVAL *result, REBVAL *val)
/*
***********************************************************************/
{
REBCNT len;
REBYTE buf[MAX_HEX_LEN+4] = {0}; // binary to convert
if (IS_BINARY(val)) {
len = VAL_LEN(val);
if (len > 12) len = 12;
memcpy(buf, VAL_BIN_DATA(val), len);
}
#ifdef removed
else if (IS_ISSUE(val)) {
//if (!(len = Scan_Hex_Bytes(val, 24, buf))) return FALSE;
REBYTE *ap = Get_Word_Name(val);
REBYTE *bp = &buf[0];
REBCNT alen;
REBUNI c;
len = LEN_BYTES(ap); // UTF-8 len
if (len & 1) return FALSE; // must have even # of chars
len /= 2;
if (len > 12) return FALSE; // valid even for UTF-8
for (alen = 0; alen < len; alen++) {
if (!Scan_Hex2(ap, &c, 0)) return FALSE;
*bp++ = (REBYTE)c;
ap += 2;
}
}
#endif
else
raise Error_Invalid_Arg(val);
memcpy(buf + 12 - len, buf, len); // shift to right side
memset(buf, 0, 12 - len);
VAL_MONEY_AMOUNT(result) = binary_to_deci(buf);
return TRUE;
}
*/ void Mold_Binary(REBVAL *value, REB_MOLD *mold)
/*
***********************************************************************/
{
REBCNT len = VAL_LEN(value);
REBSER *out;
switch (Get_System_Int(SYS_OPTIONS, OPTIONS_BINARY_BASE, 16)) {
default:
case 16:
out = Encode_Base16(value, 0, len > 32);
break;
case 64:
Append_Bytes(mold->series, "64");
out = Encode_Base64(value, 0, len > 64);
break;
case 2:
Append_Byte(mold->series, '2');
out = Encode_Base2(value, 0, len > 8);
break;
}
Emit(mold, "#{E}", out);
}
static void Mold_Url(const 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_URL_ESC(c)) len += 2;
}
dp = Prep_Uni_Series(mold, len);
for (n = VAL_INDEX(value); n < VAL_TAIL(value); n++) {
c = GET_ANY_CHAR(ser, n);
if (IS_URL_ESC(c)) dp = Form_Hex_Esc_Uni(dp, c); // c => %xx
else *dp++ = c;
}
*dp = 0;
}
*/ REBSER *At_Head(REBVAL *value)
/*
** Return the series for a value, but if it has an index
** offset, return a copy of the series from that position.
** Useful for functions that do not accept index offsets.
**
***********************************************************************/
{
REBCNT len;
REBSER *ser;
REBSER *src = VAL_SERIES(value);
REBCNT wide;
if (VAL_INDEX(value) == 0) return src;
len = VAL_LEN(value);
wide = SERIES_WIDE(src);
ser = Make_Series(len, wide, FALSE);
memcpy(ser->data, src->data + (VAL_INDEX(value) * wide), len * wide);
ser->tail = len;
return ser;
}
STOID Mold_String_Series(REBVAL *value, REB_MOLD *mold)
{
REBCNT len = VAL_LEN(value);
REBSER *ser = VAL_SERIES(value);
REBCNT idx = VAL_INDEX(value);
REB_STRF sf = {0};
REBYTE *bp;
REBUNI *up;
REBUNI *dp;
REBOOL uni = !BYTE_SIZE(ser);
REBCNT n;
REBUNI c;
// Empty string:
if (idx >= VAL_TAIL(value)) {
Append_Bytes(mold->series, "\"\""); //Trap0(RE_PAST_END);
return;
}
Sniff_String(ser, idx, &sf);
if (!GET_MOPT(mold, MOPT_ANSI_ONLY)) sf.paren = 0;
// Source can be 8 or 16 bits:
if (uni) up = UNI_HEAD(ser);
else bp = STR_HEAD(ser);
// If it is a short quoted string, emit it as "string":
if (len <= MAX_QUOTED_STR && sf.quote == 0 && sf.newline < 3) {
dp = Prep_Uni_Series(mold, len + sf.newline + sf.escape + sf.paren + sf.chr1e + 2);
*dp++ = '"';
for (n = idx; n < VAL_TAIL(value); n++) {
c = uni ? up[n] : (REBUNI)(bp[n]);
dp = Emit_Uni_Char(dp, c, (REBOOL)GET_MOPT(mold, MOPT_ANSI_ONLY)); // parened
}
*dp++ = '"';
*dp = 0;
return;
}
// It is a braced string, emit it as {string}:
if (!sf.malign) sf.brace_in = sf.brace_out = 0;
dp = Prep_Uni_Series(mold, len + sf.brace_in + sf.brace_out + sf.escape + sf.paren + sf.chr1e + 2);
*dp++ = '{';
for (n = idx; n < VAL_TAIL(value); n++) {
c = uni ? up[n] : (REBUNI)(bp[n]);
switch (c) {
case '{':
case '}':
if (sf.malign) {
*dp++ = '^';
*dp++ = c;
break;
}
case '\n':
case '"':
*dp++ = c;
break;
default:
dp = Emit_Uni_Char(dp, c, (REBOOL)GET_MOPT(mold, MOPT_ANSI_ONLY)); // parened
}
}
*dp++ = '}';
*dp = 0;
}