*/ 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)); }