*/ void Insert_String(REBSER *dst, REBCNT idx, const REBSER *src, REBCNT pos, REBCNT len, REBFLG no_expand)
/*
** Insert a non-encoded string into a series at given index.
** Source and/or destination can be 1 or 2 bytes wide.
** If destination is not wide enough, it will be widened.
**
***********************************************************************/
{
REBUNI *up;
REBYTE *bp;
REBCNT n;
if (idx > dst->tail) idx = dst->tail;
if (!no_expand) Expand_Series(dst, idx, len); // tail changed too
// Src and dst have same width (8 or 16):
if (SERIES_WIDE(dst) == SERIES_WIDE(src)) {
cp_same:
if (BYTE_SIZE(dst))
memcpy(BIN_SKIP(dst, idx), BIN_SKIP(src, pos), len);
else
memcpy(UNI_SKIP(dst, idx), UNI_SKIP(src, pos), sizeof(REBUNI) * len);
return;
}
// Src is 8 and dst is 16:
if (!BYTE_SIZE(dst)) {
bp = BIN_SKIP(src, pos);
up = UNI_SKIP(dst, idx);
for (n = 0; n < len; n++) up[n] = (REBUNI)bp[n];
return;
}
// Src is 16 and dst is 8:
bp = BIN_SKIP(dst, idx);
up = UNI_SKIP(src, pos);
for (n = 0; n < len; n++) {
if (up[n] > 0xFF) {
//Debug_Num("##Widen-series because char value is:", up[n]);
// Expand dst and restart:
idx += n;
pos += n;
len -= n;
Widen_String(dst, TRUE);
goto cp_same;
}
bp[n] = (REBYTE)up[n];
}
}
*/ RL_API int RL_Get_String(REBSER *series, u32 index, void **str)
/*
** Obtain a pointer into a string (bytes or unicode).
**
** Returns:
** The length and type of string. When len > 0, string is unicode.
** When len < 0, string is bytes.
** Arguments:
** series - string series pointer
** index - index from beginning (zero-based)
** str - pointer to first character
** Notes:
** If the len is less than zero, then the string is optimized to
** codepoints (chars) 255 or less for ASCII and LATIN-1 charsets.
** Strings are allowed to move in memory. Therefore, you will want
** to make a copy of the string if needed.
**
***********************************************************************/
{ // ret: len or -len
int len = (index >= series->tail) ? 0 : series->tail - index;
if (BYTE_SIZE(series)) {
*str = BIN_SKIP(series, index);
len = -len;
}
else {
*str = UNI_SKIP(series, index);
}
return len;
}
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);
}
STOID Sniff_String(REBSER *ser, REBCNT idx, REB_STRF *sf)
{
// Scan to find out what special chars the string contains?
REBYTE *bp = STR_HEAD(ser);
REBUNI *up = (REBUNI*)bp;
REBUNI c;
REBCNT n;
for (n = idx; n < SERIES_TAIL(ser); n++) {
c = (BYTE_SIZE(ser)) ? (REBUNI)(bp[n]) : up[n];
switch (c) {
case '{':
sf->brace_in++;
break;
case '}':
sf->brace_out++;
if (sf->brace_out > sf->brace_in) sf->malign++;
break;
case '"':
sf->quote++;
break;
case '\n':
sf->newline++;
break;
default:
if (c == 0x1e) sf->chr1e += 4; // special case of ^(1e)
else if (IS_CHR_ESC(c)) sf->escape++;
else if (c >= 0x1000) sf->paren += 6; // ^(1234)
else if (c >= 0x100) sf->paren += 5; // ^(123)
else if (c >= 0x80) sf->paren += 4; // ^(12)
}
}
if (sf->brace_in != sf->brace_out) sf->malign++;
}
*/ REBSER *Copy_String(REBSER *src, REBCNT index, REBINT length)
/*
** Copies a portion of any string (byte or unicode).
** Will slim the string, if needed.
**
** The index + length must be in range unsigned int 32.
**
***********************************************************************/
{
REBUNI *up;
REBYTE wide = 1;
REBSER *dst;
REBINT n;
if (length < 0) length = src->tail;
// Can it be slimmed down?
if (!BYTE_SIZE(src)) {
up = UNI_SKIP(src, index);
for (n = 0; n < length; n++)
if (up[n] > 0xff) break;
if (n < length) wide = sizeof(REBUNI);
}
dst = Make_Series(length + 1, wide, MKS_NONE);
Insert_String(dst, 0, src, index, length, TRUE);
SERIES_TAIL(dst) = length;
TERM_SEQUENCE(dst);
return dst;
}
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;
}
*/ 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;
}
*/ void Insert_Char(REBSER *dst, REBCNT index, REBCNT chr)
/*
** Insert a Char (byte or unicode) into a string.
**
***********************************************************************/
{
if (index > dst->tail) index = dst->tail;
if (chr > 0xFF && BYTE_SIZE(dst)) Widen_String(dst, TRUE);
Expand_Series(dst, index, 1);
SET_ANY_CHAR(dst, index, chr);
}
//
// Trim_Tail: C
//
// Used to trim off hanging spaces during FORM and MOLD.
//
void Trim_Tail(REBSER *src, REBYTE chr)
{
REBOOL unicode = NOT(BYTE_SIZE(src));
REBCNT tail;
REBUNI c;
assert(!Is_Array_Series(src));
for (tail = SER_LEN(src); tail > 0; tail--) {
c = unicode ? *UNI_AT(src, tail - 1) : *BIN_AT(src, tail - 1);
if (c != chr) break;
}
SET_SERIES_LEN(src, tail);
TERM_SEQUENCE(src);
}
//
// RL_Get_String: C
//
// Obtain a pointer into a string (bytes or unicode).
//
// Returns:
// The length and type of string. When len > 0, string is unicode.
// When len < 0, string is bytes.
// Arguments:
// series - string series pointer
// index - index from beginning (zero-based)
// str - pointer to first character
// Notes:
// If the len is less than zero, then the string is optimized to
// codepoints (chars) 255 or less for ASCII and LATIN-1 charsets.
// Strings are allowed to move in memory. Therefore, you will want
// to make a copy of the string if needed.
//
RL_API int RL_Get_String(REBSER *series, u32 index, void **str)
{ // ret: len or -len
int len;
if (index >= SER_LEN(series))
len = 0;
else
len = SER_LEN(series) - index;
if (BYTE_SIZE(series)) {
*str = BIN_AT(series, index);
len = -len;
}
else {
*str = UNI_AT(series, index);
}
return len;
}
*/ void Trim_Tail(REBSER *src, REBYTE chr)
/*
** Used to trim off hanging spaces during FORM and MOLD.
**
***********************************************************************/
{
REBOOL is_uni = !BYTE_SIZE(src);
REBCNT tail;
REBUNI c;
assert(!Is_Array_Series(src));
for (tail = SERIES_TAIL(src); tail > 0; tail--) {
c = is_uni ? *UNI_SKIP(src, tail - 1) : *BIN_SKIP(src, tail - 1);
if (c != chr) break;
}
SERIES_TAIL(src) = tail;
TERM_SEQUENCE(src);
}
*/ 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);
}
*/ 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))
*/ 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))
*/ 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;
}
//
// Temp_Bin_Str_Managed: C
//
// 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.
//
REBSER *Temp_Bin_Str_Managed(const REBVAL *val, REBCNT *index, REBCNT *length)
{
REBCNT len = (length && *length) ? *length : VAL_LEN_AT(val);
REBSER *series;
assert(IS_BINARY(val) || ANY_STRING(val));
// !!! This used to check `len == 0` and reuse a zero length string.
// However, the zero length string could have the wrong width. We are
// expected to be returning a BYTE_SIZE() string, and that confused
// things. It's not a good idea to mutate the source string (e.g.
// reallocate under a new width) so consider having an EMPTY_BYTE_STRING
// like EMPTY_ARRAY which is protected to hand back.
//
if (
IS_BINARY(val)
|| (
VAL_BYTE_SIZE(val)
&& All_Bytes_ASCII(VAL_BIN_AT(val), VAL_LEN_AT(val))
)
){
//
// It's BINARY!, or an ANY-STRING! whose codepoints are all values in
// ASCII (0x00 => 0x7F), hence not needing any UTF-8 encoding.
//
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 !defined(NDEBUG)
//
// Also, PROTECT the result in the debug build...because since the
// caller doesn't know if a new series was created or if the initial
// data is being used, they should not be modifying it! (We don't
// want to protect the original data, because we wouldn't know when
// we were allowed to unlock it...there's no later call in this
// model to clean up the series.)
{
REBVAL protect;
Val_Init_String(&protect, series);
Protect_Value(&protect, FLAGIT(PROT_SET));
// just a string...not /DEEP...shouldn't need to Unmark()
}
#endif
if (index)
*index = 0;
if (length)
*length = SER_LEN(series);
}
assert(BYTE_SIZE(series));
return series;
}
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;
}
static REBCNT find_string(
REBSER *series,
REBCNT index,
REBCNT end,
REBVAL *target,
REBCNT target_len,
REBCNT flags,
REBINT skip
) {
assert(end >= index);
if (target_len > end - index) // series not long enough to have target
return NOT_FOUND;
REBCNT start = index;
if (flags & (AM_FIND_REVERSE | AM_FIND_LAST)) {
skip = -1;
start = 0;
if (flags & AM_FIND_LAST) index = end - target_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_AT(target),
target_len,
NOT(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),
target_len,
flags & (AM_FIND_MATCH|AM_FIND_CASE)
);
}
}
else if (IS_BINARY(target)) {
const REBOOL uncase = FALSE;
return Find_Byte_Str(
series,
start,
VAL_BIN_AT(target),
target_len,
uncase, // "don't treat case insensitively"
GET_FLAG(flags, ARG_FIND_MATCH - 1)
);
}
else if (IS_CHAR(target)) {
return Find_Str_Char(
VAL_CHAR(target),
series,
start,
index,
end,
skip,
flags
);
}
else if (IS_INTEGER(target)) {
return Find_Str_Char(
cast(REBUNI, VAL_INT32(target)),
series,
start,
index,
end,
skip,
flags
);
}
else if (IS_BITSET(target)) {
return Find_Str_Bitset(
series,
start,
index,
end,
skip,
VAL_SERIES(target),
flags
);
}
return NOT_FOUND;
}
//
// Serial_Actor: C
//
static REB_R Serial_Actor(REBFRM *frame_, REBCTX *port, REBSYM action)
{
REBREQ *req; // IO request
REBVAL *spec; // port spec
REBVAL *arg; // action argument value
REBVAL *val; // e.g. port number value
REBINT result; // IO result
REBCNT refs; // refinement argument flags
REBCNT len; // generic length
REBSER *ser; // simplifier
REBVAL *path;
Validate_Port(port, action);
*D_OUT = *D_ARG(1);
// Validate PORT fields:
spec = CTX_VAR(port, STD_PORT_SPEC);
if (!IS_OBJECT(spec)) fail (Error(RE_INVALID_PORT));
path = Obj_Value(spec, STD_PORT_SPEC_HEAD_REF);
if (!path) fail (Error(RE_INVALID_SPEC, spec));
//if (!IS_FILE(path)) fail (Error(RE_INVALID_SPEC, path));
req = cast(REBREQ*, Use_Port_State(port, RDI_SERIAL, sizeof(*req)));
// Actions for an unopened serial port:
if (!IS_OPEN(req)) {
switch (action) {
case SYM_OPEN:
arg = Obj_Value(spec, STD_PORT_SPEC_SERIAL_PATH);
if (! (IS_FILE(arg) || IS_STRING(arg) || IS_BINARY(arg)))
fail (Error(RE_INVALID_PORT_ARG, arg));
req->special.serial.path = ALLOC_N(REBCHR, MAX_SERIAL_DEV_PATH);
OS_STRNCPY(
req->special.serial.path,
//
// !!! This is assuming VAL_DATA contains native chars.
// Should it? (2 bytes on windows, 1 byte on linux/mac)
//
SER_AT(REBCHR, VAL_SERIES(arg), VAL_INDEX(arg)),
MAX_SERIAL_DEV_PATH
);
arg = Obj_Value(spec, STD_PORT_SPEC_SERIAL_SPEED);
if (! IS_INTEGER(arg))
fail (Error(RE_INVALID_PORT_ARG, arg));
req->special.serial.baud = VAL_INT32(arg);
//Secure_Port(SYM_SERIAL, ???, path, ser);
arg = Obj_Value(spec, STD_PORT_SPEC_SERIAL_DATA_SIZE);
if (!IS_INTEGER(arg)
|| VAL_INT64(arg) < 5
|| VAL_INT64(arg) > 8
) {
fail (Error(RE_INVALID_PORT_ARG, arg));
}
req->special.serial.data_bits = VAL_INT32(arg);
arg = Obj_Value(spec, STD_PORT_SPEC_SERIAL_STOP_BITS);
if (!IS_INTEGER(arg)
|| VAL_INT64(arg) < 1
|| VAL_INT64(arg) > 2
) {
fail (Error(RE_INVALID_PORT_ARG, arg));
}
req->special.serial.stop_bits = VAL_INT32(arg);
arg = Obj_Value(spec, STD_PORT_SPEC_SERIAL_PARITY);
if (IS_BLANK(arg)) {
req->special.serial.parity = SERIAL_PARITY_NONE;
} else {
if (!IS_WORD(arg))
fail (Error(RE_INVALID_PORT_ARG, arg));
switch (VAL_WORD_SYM(arg)) {
case SYM_ODD:
req->special.serial.parity = SERIAL_PARITY_ODD;
break;
case SYM_EVEN:
req->special.serial.parity = SERIAL_PARITY_EVEN;
break;
default:
fail (Error(RE_INVALID_PORT_ARG, arg));
}
}
arg = Obj_Value(spec, STD_PORT_SPEC_SERIAL_FLOW_CONTROL);
if (IS_BLANK(arg)) {
req->special.serial.flow_control = SERIAL_FLOW_CONTROL_NONE;
} else {
if (!IS_WORD(arg))
fail (Error(RE_INVALID_PORT_ARG, arg));
switch (VAL_WORD_SYM(arg)) {
case SYM_HARDWARE:
req->special.serial.flow_control = SERIAL_FLOW_CONTROL_HARDWARE;
break;
case SYM_SOFTWARE:
req->special.serial.flow_control = SERIAL_FLOW_CONTROL_SOFTWARE;
break;
default:
fail (Error(RE_INVALID_PORT_ARG, arg));
}
}
if (OS_DO_DEVICE(req, RDC_OPEN))
fail (Error_On_Port(RE_CANNOT_OPEN, port, -12));
SET_OPEN(req);
return R_OUT;
case SYM_CLOSE:
return R_OUT;
case SYM_OPEN_Q:
return R_FALSE;
default:
fail (Error_On_Port(RE_NOT_OPEN, port, -12));
}
}
// Actions for an open socket:
switch (action) {
case SYM_READ:
refs = Find_Refines(frame_, ALL_READ_REFS);
// Setup the read buffer (allocate a buffer if needed):
arg = CTX_VAR(port, STD_PORT_DATA);
if (!IS_STRING(arg) && !IS_BINARY(arg)) {
Val_Init_Binary(arg, Make_Binary(32000));
}
ser = VAL_SERIES(arg);
req->length = SER_AVAIL(ser); // space available
if (req->length < 32000/2) Extend_Series(ser, 32000);
req->length = SER_AVAIL(ser);
// This used STR_TAIL (obsolete, equivalent to BIN_TAIL) but was it
// sure the series was byte sized? Added in a check.
assert(BYTE_SIZE(ser));
req->common.data = BIN_TAIL(ser); // write at tail
//if (SER_LEN(ser) == 0)
req->actual = 0; // Actual for THIS read, not for total.
#ifdef DEBUG_SERIAL
printf("(max read length %d)", req->length);
#endif
result = OS_DO_DEVICE(req, RDC_READ); // recv can happen immediately
if (result < 0) fail (Error_On_Port(RE_READ_ERROR, port, req->error));
#ifdef DEBUG_SERIAL
for (len = 0; len < req->actual; len++) {
if (len % 16 == 0) printf("\n");
printf("%02x ", req->common.data[len]);
}
printf("\n");
#endif
*D_OUT = *arg;
return R_OUT;
case SYM_WRITE:
refs = Find_Refines(frame_, ALL_WRITE_REFS);
// Determine length. Clip /PART to size of string if needed.
spec = D_ARG(2);
len = VAL_LEN_AT(spec);
if (refs & AM_WRITE_PART) {
REBCNT n = Int32s(D_ARG(ARG_WRITE_LIMIT), 0);
if (n <= len) len = n;
}
// Setup the write:
*CTX_VAR(port, STD_PORT_DATA) = *spec; // keep it GC safe
req->length = len;
req->common.data = VAL_BIN_AT(spec);
req->actual = 0;
//Print("(write length %d)", len);
result = OS_DO_DEVICE(req, RDC_WRITE); // send can happen immediately
if (result < 0) fail (Error_On_Port(RE_WRITE_ERROR, port, req->error));
break;
case SYM_UPDATE:
// Update the port object after a READ or WRITE operation.
// This is normally called by the WAKE-UP function.
arg = CTX_VAR(port, STD_PORT_DATA);
if (req->command == RDC_READ) {
if (ANY_BINSTR(arg)) {
SET_SERIES_LEN(
VAL_SERIES(arg),
VAL_LEN_HEAD(arg) + req->actual
);
}
}
else if (req->command == RDC_WRITE) {
SET_BLANK(arg); // Write is done.
}
return R_BLANK;
case SYM_OPEN_Q:
return R_TRUE;
case SYM_CLOSE:
if (IS_OPEN(req)) {
OS_DO_DEVICE(req, RDC_CLOSE);
SET_CLOSED(req);
}
break;
default:
fail (Error_Illegal_Action(REB_PORT, action));
}
return R_OUT;
}
*/ REBSER *Compress(REBSER *input, REBINT index, REBCNT len, REBFLG gzip, REBFLG raw)
/*
** This is a wrapper over Zlib which will compress a BINARY!
** series to produce another BINARY!. It can use either gzip
** or zlib envelopes, and has a "raw" option for no header.
**
** !!! Adds 32-bit size info to zlib non-raw compressions for
** compatibility with Rebol2 and R3-Alpha, at the cost of
** inventing yet-another-format. Consider removing.
**
** !!! Does not expose the "streaming" ability of zlib.
**
***********************************************************************/
{
REBCNT buf_size;
REBSER *output;
int ret;
z_stream strm;
assert(BYTE_SIZE(input)); // must be BINARY!
// compression level 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.
//
strm.zalloc = Z_NULL;
strm.zfree = Z_NULL;
strm.opaque = Z_NULL;
ret = deflateInit2(
&strm,
Z_DEFAULT_COMPRESSION,
Z_DEFLATED,
raw
? (gzip ? window_bits_gzip_raw : window_bits_zlib_raw)
: (gzip ? window_bits_gzip : window_bits_zlib),
8,
Z_DEFAULT_STRATEGY
);
if (ret != Z_OK)
raise Error_Compression(&strm, ret);
// http://stackoverflow.com/a/4938401/211160
buf_size = deflateBound(&strm, len);
strm.avail_in = len;
strm.next_in = BIN_HEAD(input) + index;
output = Make_Binary(buf_size);
strm.avail_out = buf_size;
strm.next_out = BIN_HEAD(output);
ret = deflate(&strm, Z_FINISH);
deflateEnd(&strm);
if (ret != Z_STREAM_END)
raise Error_Compression(&strm, ret);
SET_STR_END(output, buf_size - strm.avail_out);
SERIES_TAIL(output) = buf_size - strm.avail_out;
if (gzip) {
// GZIP contains its own CRC. It also has a 32-bit uncompressed
// length (and CRC), conveniently (and perhaps confusingly) at the
// tail in the same format that Rebol used.
REBCNT gzip_len = Bytes_To_REBCNT(
SERIES_DATA(output) + buf_size - strm.avail_out - sizeof(REBCNT)
);
assert(len == gzip_len);
}
else if (!raw) {
// Add 32-bit length to the end.
//
// !!! In ZLIB format the length can be found by decompressing, but
// not known a priori. So this is for efficiency. It would likely be
// better to not include this as it only confuses matters for those
// expecting the data to be in a known format...though it means that
// clients who wanted to decompress to a known allocation size would
// have to save the size somewhere.
REBYTE out_size[sizeof(REBCNT)];
REBCNT_To_Bytes(out_size, cast(REBCNT, len));
Append_Series(output, cast(REBYTE*, out_size), sizeof(REBCNT));
}
