*/ static void Read_File_Port(REBVAL *out, REBSER *port, REBREQ *file, REBVAL *path, REBCNT args, REBCNT len)
/*
** Read from a file port.
**
***********************************************************************/
{
REBSER *ser;
// Allocate read result buffer:
ser = Make_Binary(len);
Set_Series(REB_BINARY, out, ser); //??? what if already set?
// Do the read, check for errors:
file->common.data = BIN_HEAD(ser);
file->length = len;
if (OS_DO_DEVICE(file, RDC_READ) < 0)
Trap_Port(RE_READ_ERROR, port, file->error);
SERIES_TAIL(ser) = file->actual;
STR_TERM(ser);
// Convert to string or block of strings.
// NOTE: This code is incorrect for files read in chunks!!!
if (args & (AM_READ_STRING | AM_READ_LINES)) {
REBSER *nser = Decode_UTF_String(BIN_HEAD(ser), file->actual, -1);
if (nser == NULL) {
Trap(RE_BAD_DECODE);
}
Set_String(out, nser);
if (args & AM_READ_LINES) Set_Block(out, Split_Lines(out));
}
}
*/ REBSER *Decompress(REBSER *input, REBCNT index, REBINT len, REBCNT limit, REBFLG use_crc)
/*
** Decompress a binary (only).
**
***********************************************************************/
{
REBCNT size;
REBSER *output;
REBINT err;
if (len < 0 || (index + len > BIN_LEN(input))) len = BIN_LEN(input) - index;
// Get the size from the end and make the output buffer that size.
if (len <= 4) Trap0(RE_PAST_END); // !!! better msg needed
size = Bytes_To_Long(BIN_SKIP(input, len) - 4);
if (limit && size > limit) Trap_Num(RE_SIZE_LIMIT, size);
output = Make_Binary(size + 20); // (Why 20 extra? -CS)
//DISABLE_GC;
err = Z_uncompress(BIN_HEAD(output), (uLongf*)&size, BIN_HEAD(input) + index, len, use_crc);
if (err) {
if (PG_Boot_Phase < 2) return 0;
if (err == Z_MEM_ERROR) Trap0(RE_NO_MEMORY);
SET_INTEGER(DS_RETURN, err);
Trap1(RE_BAD_PRESS, DS_RETURN); //!!!provide error string descriptions
}
SET_STR_END(output, size);
SERIES_TAIL(output) = size;
//ENABLE_GC;
return output;
}
//
// RL_Do_Binary: C
//
// Evaluate an encoded binary script such as compressed text.
//
// Returns:
// The datatype of the result or zero if error in the encoding.
// Arguments:
// bin - by default, a REBOL compressed UTF-8 (or ASCII) script.
// length - the length of the data.
// flags - special flags (set to zero at this time).
// key - encoding, encryption, or signature key.
// result - value returned from evaluation.
// Notes:
// As of A104, only compressed scripts are supported, however,
// rebin, cloaked, signed, and encrypted formats will be supported.
//
RL_API int RL_Do_Binary(
int *exit_status,
const REBYTE *bin,
REBINT length,
REBCNT flags,
REBCNT key,
RXIARG *out
) {
REBSER *text;
#ifdef DUMP_INIT_SCRIPT
int f;
#endif
int maybe_rxt; // could be REBRXT, or negative number for error :-/
text = Decompress(bin, length, -1, FALSE, FALSE);
if (!text) return 0;
Append_Codepoint_Raw(text, 0);
#ifdef DUMP_INIT_SCRIPT
f = _open("host-boot.r", _O_CREAT | _O_RDWR, _S_IREAD | _S_IWRITE );
_write(f, BIN_HEAD(text), LEN_BYTES(BIN_HEAD(text)));
_close(f);
#endif
PUSH_GUARD_SERIES(text);
maybe_rxt = RL_Do_String(exit_status, BIN_HEAD(text), flags, out);
DROP_GUARD_SERIES(text);
Free_Series(text);
return maybe_rxt;
}
*/ REBCNT Find_Byte_Str(REBSER *series, REBCNT index, REBYTE *b2, REBCNT l2, REBFLG uncase, REBFLG match)
/*
** Find a byte string within a byte string. Optimized for speed.
**
** Returns starting position or NOT_FOUND.
**
** Uncase: compare is case-insensitive.
** Match: compare to first position only.
**
** NOTE: Series tail must be > index.
**
***********************************************************************/
{
REBYTE *b1;
REBYTE *e1;
REBCNT l1;
REBYTE c;
REBCNT n;
// The pattern empty or is longer than the target:
if (l2 == 0 || (l2 + index) > SERIES_TAIL(series)) return NOT_FOUND;
b1 = BIN_SKIP(series, index);
l1 = SERIES_TAIL(series) - index;
e1 = b1 + (match ? 1 : l1 - (l2 - 1));
c = *b2; // first char
if (!uncase) {
while (b1 != e1) {
if (*b1 == c) { // matched first char
for (n = 1; n < l2; n++) {
if (b1[n] != b2[n]) break;
}
if (n == l2) return (b1 - BIN_HEAD(series));
}
b1++;
}
} else {
c = (REBYTE)LO_CASE(c); // OK! (never > 255)
while (b1 != e1) {
if (LO_CASE(*b1) == c) { // matched first char
for (n = 1; n < l2; n++) {
if (LO_CASE(b1[n]) != LO_CASE(b2[n])) break;
}
if (n == l2) return (b1 - BIN_HEAD(series));
}
b1++;
}
}
return NOT_FOUND;
}
//
// 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);
}
*/ REBSER *Compress(REBSER *input, REBINT index, REBINT len, REBFLG use_crc)
/*
** Compress a binary (only).
** data
** /part
** length
** /crc32
**
** Note: If the file length is "small", it can't overrun on
** compression too much so we use our magic numbers; otherwise,
** we'll just be safe by a percentage of the file size. This may
** be a bit much, though.
**
***********************************************************************/
{
// NOTE: The use_crc flag is not present in Zlib 1.2.8
// Instead, compress's fifth paramter is the compression level
// It can be a value from 1 to 9, or Z_DEFAULT_COMPRESSION if you
// want it to pick what the library author considers the "worth it"
// tradeoff of time to generally suggest.
uLongf size;
REBSER *output;
REBINT err;
REBYTE out_size[sizeof(REBCNT)];
if (len < 0) Trap_DEAD_END(RE_PAST_END); // !!! better msg needed
size = len + (len > STERLINGS_MAGIC_NUMBER ? len / 10 + 12 : STERLINGS_MAGIC_FIX);
output = Make_Binary(size);
//DISABLE_GC; // !!! why??
// dest, dest-len, src, src-len, level
err = z_compress2(BIN_HEAD(output), &size, BIN_HEAD(input) + index, len, Z_DEFAULT_COMPRESSION);
if (err) {
REBVAL arg;
if (err == Z_MEM_ERROR) Trap_DEAD_END(RE_NO_MEMORY);
SET_INTEGER(&arg, err);
Trap1_DEAD_END(RE_BAD_PRESS, &arg); //!!!provide error string descriptions
}
SET_STR_END(output, size);
SERIES_TAIL(output) = size;
REBCNT_To_Bytes(out_size, (REBCNT)len); // Tag the size to the end.
Append_Series(output, (REBYTE*)out_size, sizeof(REBCNT));
if (SERIES_AVAIL(output) > 1024) // Is there wasted space?
output = Copy_Series(output); // Trim it down if too big. !!! Revisit this based on mem alloc alg.
//ENABLE_GC;
return output;
}
//
// Enline_Bytes: C
//
void Enline_Bytes(REBSER *ser, REBCNT idx, REBCNT len)
{
REBCNT cnt = 0;
REBYTE *bp;
REBYTE c = 0;
REBCNT tail;
// Calculate the size difference by counting the number of LF's
// that have no CR's in front of them.
bp = BIN_AT(ser, idx);
for (; len > 0; len--) {
if (*bp == LF && c != CR) cnt++;
c = *bp++;
}
if (cnt == 0) return;
// Extend series:
len = SER_LEN(ser); // before expansion
EXPAND_SERIES_TAIL(ser, cnt);
tail = SER_LEN(ser); // after expansion
bp = BIN_HEAD(ser); // expand may change it
// Add missing CRs:
while (cnt > 0) {
bp[tail--] = bp[len]; // Copy src to dst.
if (bp[len] == LF && (len == 0 || bp[len - 1] != CR)) {
bp[tail--] = CR;
cnt--;
}
len--;
}
}
*/ REBSER *Copy_Wide_Str(void *src, REBINT len)
/*
** Create a REBOL string series from a wide char string.
** Minimize to bytes if possible
*/
{
REBSER *dst;
REBUNI *str = (REBUNI*)src;
if (Is_Wide(str, len)) {
REBUNI *up;
dst = Make_Unicode(len);
SERIES_TAIL(dst) = len;
up = UNI_HEAD(dst);
while (len-- > 0) *up++ = *str++;
*up = 0;
}
else {
REBYTE *bp;
dst = Make_Binary(len);
SERIES_TAIL(dst) = len;
bp = BIN_HEAD(dst);
while (len-- > 0) *bp++ = (REBYTE)*str++;
*bp = 0;
}
return dst;
}
*/ REBFLG Check_Bit(REBSER *bset, REBCNT c, REBFLG uncased)
/*
** Check bit indicated. Returns TRUE if set.
** If uncased is TRUE, try to match either upper or lower case.
**
***********************************************************************/
{
REBCNT i, n = c;
REBCNT tail = SERIES_TAIL(bset);
REBFLG flag = 0;
if (uncased) {
if (n >= UNICODE_CASES) uncased = FALSE; // no need to check
else n = LO_CASE(c);
}
// Check lowercase char:
retry:
i = n >> 3;
if (i < tail)
flag = (0 != (BIN_HEAD(bset)[i] & (1 << (7 - ((n) & 7)))));
// Check uppercase if needed:
if (uncased && !flag) {
n = UP_CASE(c);
uncased = FALSE;
goto retry;
}
return (BITS_NOT(bset)) ? !flag : flag;
}
//
// Check_Bit: C
//
// Check bit indicated. Returns TRUE if set.
// If uncased is TRUE, try to match either upper or lower case.
//
REBOOL Check_Bit(REBSER *bset, REBCNT c, REBOOL uncased)
{
REBCNT i, n = c;
REBCNT tail = SER_LEN(bset);
REBOOL flag = FALSE;
if (uncased) {
if (n >= UNICODE_CASES) uncased = FALSE; // no need to check
else n = LO_CASE(c);
}
// Check lowercase char:
retry:
i = n >> 3;
if (i < tail)
flag = LOGICAL(BIN_HEAD(bset)[i] & (1 << (7 - ((n) & 7))));
// Check uppercase if needed:
if (uncased && !flag) {
n = UP_CASE(c);
uncased = FALSE;
goto retry;
}
return BITS_NOT(bset) ? NOT(flag) : flag;
}
*/ static void Write_File_Port(REBREQ *file, REBVAL *data, REBCNT len, REBCNT args)
/*
***********************************************************************/
{
REBSER *ser;
if (IS_BLOCK(data)) {
// Form the values of the block
// !! Could be made more efficient if we broke the FORM
// into 32K chunks for writing.
REB_MOLD mo;
CLEARS(&mo);
Reset_Mold(&mo);
if (args & AM_WRITE_LINES) {
mo.opts = 1 << MOPT_LINES;
}
Mold_Value(&mo, data, 0);
Set_String(data, mo.series); // fall into next section
len = SERIES_TAIL(mo.series);
}
// Auto convert string to UTF-8
if (IS_STRING(data)) {
ser = Encode_UTF8_Value(data, len, ENCF_OS_CRLF);
file->common.data = ser? BIN_HEAD(ser) : VAL_BIN_DATA(data); // No encoding may be needed
len = SERIES_TAIL(ser);
}
else {
file->common.data = VAL_BIN_DATA(data);
}
file->length = len;
OS_DO_DEVICE(file, RDC_WRITE);
}
//
// Decode_Base2: C
//
static REBSER *Decode_Base2(const REBYTE **src, REBCNT len, REBYTE delim)
{
REBYTE *bp;
const REBYTE *cp;
REBCNT count = 0;
REBCNT accum = 0;
REBYTE lex;
REBSER *ser;
ser = Make_Binary(len >> 3);
bp = BIN_HEAD(ser);
cp = *src;
for (; len > 0; cp++, len--) {
if (delim && *cp == delim) break;
lex = Lex_Map[*cp];
if (lex >= LEX_NUMBER) {
if (*cp == '0') accum *= 2;
else if (*cp == '1') accum = (accum * 2) + 1;
else goto err;
if (count++ >= 7) {
*bp++ = cast(REBYTE, accum);
count = 0;
accum = 0;
}
}
else if (!*cp || lex > LEX_DELIMIT_RETURN) goto err;
}
if (count) goto err; // improper modulus
*bp = 0;
SET_SERIES_LEN(ser, bp - BIN_HEAD(ser));
ASSERT_SERIES_TERM(ser);
return ser;
err:
Free_Series(ser);
*src = cp;
return 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;
}
*/ REBSER *Compress(REBSER *input, REBINT index, REBINT len, REBFLG use_crc)
/*
** Compress a binary (only).
** data
** /part
** length
** /crc32
**
** Note: If the file length is "small", it can't overrun on
** compression too much so we use our magic numbers; otherwise,
** we'll just be safe by a percentage of the file size. This may
** be a bit much, though.
**
***********************************************************************/
{
REBCNT size;
REBSER *output;
REBINT err;
REBYTE out_size[4];
if (len < 0) Trap0(RE_PAST_END); // !!! better msg needed
size = len + (len > STERLINGS_MAGIC_NUMBER ? len / 10 + 12 : STERLINGS_MAGIC_FIX);
output = Make_Binary(size);
//DISABLE_GC; // !!! why??
// dest, dest-len, src, src-len, level
err = Z_compress2(BIN_HEAD(output), (uLongf*)&size, BIN_HEAD(input) + index, len, use_crc);
if (err) {
if (err == Z_MEM_ERROR) Trap0(RE_NO_MEMORY);
SET_INTEGER(DS_RETURN, err);
Trap1(RE_BAD_PRESS, DS_RETURN); //!!!provide error string descriptions
}
SET_STR_END(output, size);
SERIES_TAIL(output) = size;
Long_To_Bytes(out_size, (REBCNT)len); // Tag the size to the end.
Append_Series(output, (REBYTE*)out_size, 4);
if (SERIES_AVAIL(output) > 1024) // Is there wasted space?
output = Copy_Series(output); // Trim it down if too big. !!! Revisit this based on mem alloc alg.
//ENABLE_GC;
return output;
}
//
// Decode_Base16: C
//
static REBSER *Decode_Base16(const REBYTE **src, REBCNT len, REBYTE delim)
{
REBYTE *bp;
const REBYTE *cp;
REBCNT count = 0;
REBCNT accum = 0;
REBYTE lex;
REBINT val;
REBSER *ser;
ser = Make_Binary(len / 2);
bp = BIN_HEAD(ser);
cp = *src;
for (; len > 0; cp++, len--) {
if (delim && *cp == delim) break;
lex = Lex_Map[*cp];
if (lex > LEX_WORD) {
val = lex & LEX_VALUE; // char num encoded into lex
if (!val && lex < LEX_NUMBER) goto err; // invalid char (word but no val)
accum = (accum << 4) + val;
if (count++ & 1) *bp++ = cast(REBYTE, accum);
}
else if (!*cp || lex > LEX_DELIMIT_RETURN) goto err;
}
if (count & 1) goto err; // improper modulus
*bp = 0;
SET_SERIES_LEN(ser, bp - BIN_HEAD(ser));
ASSERT_SERIES_TERM(ser);
return ser;
err:
Free_Series(ser);
*src = cp;
return 0;
}
//
// Complement_Binary: C
//
// Only valid for BINARY data.
//
REBSER *Complement_Binary(REBVAL *value)
{
const REBYTE *bp = VAL_BIN_AT(value);
REBCNT len = VAL_LEN_AT(value);
REBSER *bin = Make_Binary(len);
TERM_SEQUENCE_LEN(bin, len);
REBYTE *dp = BIN_HEAD(bin);
for (; len > 0; len--, ++bp, ++dp)
*dp = ~(*bp);
return bin;
}
*/ 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;
}
*/ int Encode_UTF8_Line(REBSER *dst, REBSER *src, REBCNT idx)
/*
** Encode a unicode source buffer into a binary line of UTF8.
** Include the LF terminator in the result.
** Return the length of the line buffer.
**
***********************************************************************/
{
REBUNI *up = UNI_HEAD(src);
REBCNT len = SERIES_TAIL(src);
REBCNT tail;
REBUNI c;
REBINT n;
REBYTE buf[8];
tail = RESET_TAIL(dst);
while (idx < len) {
if ((c = up[idx]) < 0x80) {
EXPAND_SERIES_TAIL(dst, 1);
BIN_HEAD(dst)[tail++] = (REBYTE)c;
}
else {
n = Encode_UTF8_Char(buf, c);
EXPAND_SERIES_TAIL(dst, n);
memcpy(BIN_SKIP(dst, tail), buf, n);
tail += n;
}
idx++;
if (c == LF) break;
}
BIN_HEAD(dst)[tail] = 0;
SERIES_TAIL(dst) = tail;
return idx;
}
static REBSER *Make_Binary_BE64(REBVAL *arg)
{
REBSER *ser = Make_Binary(9);
REBI64 n = VAL_INT64(arg);
REBINT count;
REBYTE *bp = BIN_HEAD(ser);
for (count = 7; count >= 0; count--) {
bp[count] = (REBYTE)(n & 0xff);
n >>= 8;
}
bp[8] = 0;
ser->tail = 8;
return ser;
}
//
// Complement_Binary: C
//
// Only valid for BINARY data.
//
REBSER *Complement_Binary(REBVAL *value)
{
REBSER *series;
REBYTE *str = VAL_BIN_AT(value);
REBINT len = VAL_LEN_AT(value);
REBYTE *out;
series = Make_Binary(len);
SET_SERIES_LEN(series, len);
out = BIN_HEAD(series);
for (; len > 0; len--) {
*out++ = ~(*str);
++str;
}
return series;
}
*/ 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;
}
*/ REBSER *Parse_Lines(REBSER *src)
/*
** Convert a string buffer to a block of strings.
** Note that the string must already be converted
** to REBOL LF format (no CRs).
**
***********************************************************************/
{
REBSER *blk;
REBUNI c;
REBCNT i;
REBCNT s;
REBVAL *val;
REBOOL uni = !BYTE_SIZE(src);
REBYTE *bp = BIN_HEAD(src);
REBUNI *up = UNI_HEAD(src);
blk = BUF_EMIT;
RESET_SERIES(blk);
// Scan string, looking for LF and CR terminators:
for (i = s = 0; i < SERIES_TAIL(src); i++) {
c = uni ? up[i] : bp[i];
if (c == LF || c == CR) {
val = Append_Value(blk);
Set_String(val, Copy_String(src, s, i - s));
VAL_SET_LINE(val);
// Skip CRLF if found:
if (c == CR && LF == uni ? up[i] : bp[i]) i++;
s = i;
}
}
// Partial line (no linefeed):
if (s + 1 != i) {
val = Append_Value(blk);
Set_String(val, Copy_String(src, s, i - s));
VAL_SET_LINE(val);
}
return Copy_Block(blk, 0);
}
*/ REBSER *Decompress(const REBYTE *data, REBCNT len, REBCNT limit, REBFLG use_crc)
/*
** Decompress a binary (only).
**
** Rebol's compress/decompress functions store an extra length
** at the tail of the data, to double-check the zlib result
**
***********************************************************************/
{
// NOTE: The use_crc flag is not present in Zlib 1.2.8
// There is no fifth parameter to uncompress matching the fifth to compress
uLongf size;
REBSER *output;
REBINT err;
// Get the size from the end and make the output buffer that size.
if (len <= 4) Trap_DEAD_END(RE_PAST_END); // !!! better msg needed
size = Bytes_To_REBCNT(data + len - sizeof(REBCNT));
// NOTE: You can hit this if you 'make prep' without doing a full rebuild
// (If you 'make clean' and build again and this goes away, it was that)
if (limit && size > limit) Trap_Num(RE_SIZE_LIMIT, size);
output = Make_Binary(size);
//DISABLE_GC;
err = z_uncompress(BIN_HEAD(output), &size, data, len);
if (err) {
REBVAL arg;
if (PG_Boot_Phase < 2) return 0;
if (err == Z_MEM_ERROR) Trap_DEAD_END(RE_NO_MEMORY);
SET_INTEGER(&arg, err);
Trap1_DEAD_END(RE_BAD_PRESS, &arg); //!!!provide error string descriptions
}
SET_STR_END(output, size);
SERIES_TAIL(output) = size;
//ENABLE_GC;
return output;
}
//
// Decode_Base64: C
//
static REBSER *Decode_Base64(const REBYTE **src, REBCNT len, REBYTE delim)
{
REBYTE *bp;
const REBYTE *cp;
REBCNT flip = 0;
REBCNT accum = 0;
REBYTE lex;
REBSER *ser;
// Allocate buffer large enough to hold result:
// Accounts for e bytes decoding into 3 bytes.
ser = Make_Binary(((len + 3) * 3) / 4);
bp = BIN_HEAD(ser);
cp = *src;
for (; len > 0; cp++, len--) {
// Check for terminating delimiter (optional):
if (delim && *cp == delim) break;
// Check for char out of range:
if (*cp > 127) {
if (*cp == 0xA0) continue; // hard space
goto err;
}
lex = Debase64[*cp];
if (lex < BIN_SPACE) {
if (*cp != '=') {
accum = (accum << 6) + lex;
if (flip++ == 3) {
*bp++ = cast(REBYTE, accum >> 16);
*bp++ = cast(REBYTE, accum >> 8);
*bp++ = cast(REBYTE, accum);
accum = 0;
flip = 0;
}
} else {
*/ void Debug_Series(const REBSER *ser)
/*
***********************************************************************/
{
REBINT disabled = GC_Disabled;
GC_Disabled = 1;
// This routine is also a little catalog of the outlying series
// types in terms of sizing, just to know what they are.
if (BYTE_SIZE(ser))
Debug_Str(s_cast(BIN_HEAD(ser)));
else if (IS_BLOCK_SERIES(ser)) {
REBVAL value;
// May not actually be a REB_BLOCK, but we put it in a value
// container for now saying it is so we can output it. Because
// it may be a frame or otherwise, we use a raw VAL_SET
VAL_SET(&value, REB_BLOCK);
VAL_SERIES(&value) = m_cast(REBSER *, ser); // not actually modifying
VAL_INDEX(&value) = 0;
Debug_Fmt("%r", &value);
} else if (SERIES_WIDE(ser) == sizeof(REBUNI))
*/ REBSER *Encode_UTF8_String(void *src, REBCNT len, REBFLG uni, REBFLG opts)
/*
** Do all the details to encode a string as UTF8.
** No_copy means do not make a copy.
** Result can be a shared buffer!
**
***********************************************************************/
{
REBSER *ser = BUF_FORM; // a shared buffer
REBCNT size;
REBYTE *cp;
REBFLG ccr = GET_FLAG(opts, ENC_OPT_CRLF);
if (uni) {
REBUNI *up = (REBUNI*)src;
size = Length_As_UTF8(up, len, TRUE, (REBOOL)ccr);
cp = Reset_Buffer(ser, size + (GET_FLAG(opts, ENC_OPT_BOM) ? 3 : 0));
UNUSED(cp);
Encode_UTF8(Reset_Buffer(ser, size), size, up, &len, TRUE, ccr);
}
else {
REBYTE *bp = (REBYTE*)src;
if (Is_Not_ASCII(bp, len)) {
size = Length_As_UTF8((REBUNI*)bp, len, FALSE, (REBOOL)ccr);
cp = Reset_Buffer(ser, size + (GET_FLAG(opts, ENC_OPT_BOM) ? 3 : 0));
Encode_UTF8(cp, size, bp, &len, FALSE, ccr);
}
else if (GET_FLAG(opts, ENC_OPT_NO_COPY)) return 0;
else return Copy_Bytes(bp, len);
}
SERIES_TAIL(ser) = len;
STR_TERM(ser);
return Copy_Bytes(BIN_HEAD(ser), len);
}
*/ void Debug_Series(const REBSER *ser)
/*
***********************************************************************/
{
REBINT disabled = GC_Disabled;
GC_Disabled = 1;
// This routine is also a little catalog of the outlying series
// types in terms of sizing, just to know what they are.
if (BYTE_SIZE(ser))
Debug_Str(s_cast(BIN_HEAD(ser)));
else if (Is_Array_Series(ser)) {
REBVAL value;
// May not actually be a REB_BLOCK, but we put it in a value
// container for now saying it is so we can output it. It may be
// a frame and we may not want to Manage_Series here, so we use a
// raw VAL_SET instead of Val_Init_Block
VAL_SET(&value, REB_BLOCK);
VAL_SERIES(&value) = m_cast(REBSER *, ser); // not actually modifying
VAL_INDEX(&value) = 0;
Debug_Fmt("%r", &value);
} else if (SERIES_WIDE(ser) == sizeof(REBUNI))
static REBSER *Make_Binary_BE64(const REBVAL *arg)
{
REBSER *ser = Make_Binary(9);
REBI64 n;
REBINT count;
REBYTE *bp = BIN_HEAD(ser);
if (IS_INTEGER(arg)) {
n = VAL_INT64(arg);
}
else {
assert(IS_DECIMAL(arg));
n = VAL_DECIMAL_BITS(arg);
}
for (count = 7; count >= 0; count--) {
bp[count] = (REBYTE)(n & 0xff);
n >>= 8;
}
bp[8] = 0;
SET_SERIES_LEN(ser, 8);
return ser;
}
*/ REBSER *Copy_Buffer(REBSER *buf, void *end)
/*
** Copy a shared buffer. Set tail and termination.
**
***********************************************************************/
{
REBSER *ser;
REBCNT len;
len = BYTE_SIZE(buf) ? ((REBYTE *)end) - BIN_HEAD(buf)
: ((REBUNI *)end) - UNI_HEAD(buf);
ser = Make_Series(
len + 1,
SERIES_WIDE(buf),
Is_Array_Series(buf) ? MKS_ARRAY : MKS_NONE
);
memcpy(ser->data, buf->data, SERIES_WIDE(buf) * len);
ser->tail = len;
TERM_SERIES(ser);
return ser;
}
static REBSER *make_binary(REBVAL *arg, REBOOL make)
{
REBSER *ser;
// MAKE BINARY! 123
switch (VAL_TYPE(arg)) {
case REB_INTEGER:
case REB_DECIMAL:
if (make) ser = Make_Binary(Int32s(arg, 0));
else ser = Make_Binary_BE64(arg);
break;
// MAKE/TO BINARY! BINARY!
case REB_BINARY:
ser = Copy_Bytes(VAL_BIN_DATA(arg), VAL_LEN(arg));
break;
// MAKE/TO BINARY! <any-string>
case REB_STRING:
case REB_FILE:
case REB_EMAIL:
case REB_URL:
case REB_TAG:
// case REB_ISSUE:
ser = Encode_UTF8_Value(arg, VAL_LEN(arg), 0);
break;
case REB_BLOCK:
ser = Join_Binary(arg);
break;
// MAKE/TO BINARY! <tuple!>
case REB_TUPLE:
ser = Copy_Bytes(VAL_TUPLE(arg), VAL_TUPLE_LEN(arg));
break;
// MAKE/TO BINARY! <char!>
case REB_CHAR:
ser = Make_Binary(6);
ser->tail = Encode_UTF8_Char(BIN_HEAD(ser), VAL_CHAR(arg));
break;
// MAKE/TO BINARY! <bitset!>
case REB_BITSET:
ser = Copy_Bytes(VAL_BIN(arg), VAL_TAIL(arg));
break;
// MAKE/TO BINARY! <image!>
case REB_IMAGE:
ser = Make_Image_Binary(arg);
break;
case REB_MONEY:
ser = Make_Binary(12);
ser->tail = 12;
deci_to_binary(ser->data, VAL_DECI(arg));
ser->data[12] = 0;
break;
default:
ser = 0;
}
return ser;
}
