// // Make_OS_Error: C // void Make_OS_Error(REBVAL *out, int errnum) { REBCHR str[100]; OS_FORM_ERROR(errnum, str, 100); Val_Init_String(out, Copy_OS_Str(str, OS_STRLEN(str))); }
*/ ATTRIBUTE_NO_RETURN static void Error_Compression(const z_stream *strm, int ret) /* ** Zlib gives back string error messages. We use them or fall ** back on the integer code if there is no message. ** ***********************************************************************/ { REBVAL arg; if (ret == Z_MEM_ERROR) { // We do not technically know the amount of memory that zlib asked // for and did not get. Hence categorizing it as an "out of memory" // error might be less useful than leaving as a compression error, // but that is what the old code here historically did. raise Error_No_Memory(0); } if (strm->msg) Val_Init_String( &arg, Copy_Bytes(cb_cast(strm->msg), strlen(strm->msg)) ); else SET_INTEGER(&arg, ret); Error_1(RE_BAD_COMPRESSION, &arg); }
*/ 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); }
// // Split_Lines: C // // Given a string series, split lines on CR-LF. // Series can be bytes or Unicode. // REBARR *Split_Lines(REBVAL *val) { REBARR *array = BUF_EMIT; // GC protected (because it is emit buffer) REBSER *str = VAL_SERIES(val); REBCNT len = VAL_LEN_AT(val); REBCNT idx = VAL_INDEX(val); REBCNT start = idx; REBSER *out; REBUNI c; RESET_ARRAY(array); while (idx < len) { c = GET_ANY_CHAR(str, idx); if (c == LF || c == CR) { out = Copy_String_Slimming(str, start, idx - start); val = Alloc_Tail_Array(array); Val_Init_String(val, out); SET_VAL_FLAG(val, VALUE_FLAG_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_Slimming(str, start, idx - start); val = Alloc_Tail_Array(array); Val_Init_String(val, out); SET_VAL_FLAG(val, VALUE_FLAG_LINE); } return Copy_Array_Shallow(array, SPECIFIED); // no relative values }
*/ void Secure_Port(REBCNT kind, REBREQ *req, REBVAL *name, REBSER *path) /* ** kind: word that represents the type (e.g. 'file) ** req: I/O request ** name: value that holds the original user spec ** path: the local path to compare with ** ***********************************************************************/ { REBYTE *flags; REBVAL val; Val_Init_String(&val, path); flags = Security_Policy(kind, &val); // policy flags // Check policy integer: // Mask is [xxxx wwww rrrr] - each holds the action if (GET_FLAG(req->modes, RFM_READ)) Trap_Security(flags[POL_READ], kind, name); if (GET_FLAG(req->modes, RFM_WRITE)) Trap_Security(flags[POL_WRITE], kind, name); }
*/ static REBINT Do_Set_Operation(struct Reb_Call *call_, REBCNT flags) /* ** Do set operations on a series. ** ***********************************************************************/ { REBVAL *val; REBVAL *val1; REBVAL *val2 = 0; REBSER *ser; REBSER *hser = 0; // hash table for series REBSER *retser; // return series REBSER *hret; // hash table for return series REBCNT i; REBINT h = TRUE; REBCNT skip = 1; // record size REBCNT cased = 0; // case sensitive when TRUE SET_NONE(D_OUT); val1 = D_ARG(1); i = 2; // Check for second series argument: if (flags != SET_OP_UNIQUE) { val2 = D_ARG(i++); if (VAL_TYPE(val1) != VAL_TYPE(val2)) raise Error_Unexpected_Type(VAL_TYPE(val1), VAL_TYPE(val2)); } // Refinements /case and /skip N cased = D_REF(i++); // cased if (D_REF(i++)) skip = Int32s(D_ARG(i), 1); switch (VAL_TYPE(val1)) { case REB_BLOCK: i = VAL_LEN(val1); // Setup result block: if (GET_FLAG(flags, SOP_BOTH)) i += VAL_LEN(val2); retser = BUF_EMIT; // use preallocated shared block Resize_Series(retser, i); hret = Make_Hash_Sequence(i); // allocated // Optimization note: !! // This code could be optimized for small blocks by not hashing them // and extending Find_Key to do a FIND on the value itself w/o the hash. do { // Check what is in series1 but not in series2: if (GET_FLAG(flags, SOP_CHECK)) hser = Hash_Block(val2, cased); // Iterate over first series: ser = VAL_SERIES(val1); i = VAL_INDEX(val1); for (; val = BLK_SKIP(ser, i), i < SERIES_TAIL(ser); i += skip) { if (GET_FLAG(flags, SOP_CHECK)) { h = Find_Key(VAL_SERIES(val2), hser, val, skip, cased, 1) >= 0; if (GET_FLAG(flags, SOP_INVERT)) h = !h; } if (h) Find_Key(retser, hret, val, skip, cased, 2); } // Iterate over second series? if ((i = GET_FLAG(flags, SOP_BOTH))) { val = val1; val1 = val2; val2 = val; CLR_FLAG(flags, SOP_BOTH); } if (GET_FLAG(flags, SOP_CHECK)) Free_Series(hser); } while (i); if (hret) Free_Series(hret); Val_Init_Block(D_OUT, Copy_Array_Shallow(retser)); RESET_TAIL(retser); // required - allow reuse break; case REB_BINARY: cased = TRUE; SET_TYPE(D_OUT, REB_BINARY); case REB_STRING: i = VAL_LEN(val1); // Setup result block: if (GET_FLAG(flags, SOP_BOTH)) i += VAL_LEN(val2); retser = BUF_MOLD; Reset_Buffer(retser, i); RESET_TAIL(retser); do { REBUNI uc; cased = cased ? AM_FIND_CASE : 0; // Iterate over first series: ser = VAL_SERIES(val1); i = VAL_INDEX(val1); for (; i < SERIES_TAIL(ser); i += skip) { uc = GET_ANY_CHAR(ser, i); if (GET_FLAG(flags, SOP_CHECK)) { h = Find_Str_Char(VAL_SERIES(val2), 0, VAL_INDEX(val2), VAL_TAIL(val2), skip, uc, cased) != NOT_FOUND; if (GET_FLAG(flags, SOP_INVERT)) h = !h; } if (h && (Find_Str_Char(retser, 0, 0, SERIES_TAIL(retser), skip, uc, cased) == NOT_FOUND)) { Append_String(retser, ser, i, skip); } } // Iterate over second series? if ((i = GET_FLAG(flags, SOP_BOTH))) { val = val1; val1 = val2; val2 = val; CLR_FLAG(flags, SOP_BOTH); } } while (i); ser = Copy_String(retser, 0, -1); if (IS_BINARY(D_OUT)) Val_Init_Binary(D_OUT, ser); else Val_Init_String(D_OUT, ser); break; case REB_BITSET: switch (flags) { case SET_OP_UNIQUE: return R_ARG1; case SET_OP_UNION: i = A_OR; break; case SET_OP_INTERSECT: i = A_AND; break; case SET_OP_DIFFERENCE: i = A_XOR; break; case SET_OP_EXCLUDE: i = 0; // special case break; } ser = Xandor_Binary(i, val1, val2); Val_Init_Bitset(D_OUT, ser); break; case REB_TYPESET: switch (flags) { case SET_OP_UNIQUE: break; case SET_OP_UNION: VAL_TYPESET(val1) |= VAL_TYPESET(val2); break; case SET_OP_INTERSECT: VAL_TYPESET(val1) &= VAL_TYPESET(val2); break; case SET_OP_DIFFERENCE: VAL_TYPESET(val1) ^= VAL_TYPESET(val2); break; case SET_OP_EXCLUDE: VAL_TYPESET(val1) &= ~VAL_TYPESET(val2); break; } return R_ARG1; default: raise Error_Invalid_Arg(val1); } return R_OUT; }
// // 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; }
// // Clipboard_Actor: C // static REB_R Clipboard_Actor(struct Reb_Call *call_, REBSER *port, REBCNT action) { REBREQ *req; REBINT result; REBVAL *arg; REBCNT refs; // refinement argument flags REBINT len; REBSER *ser; Validate_Port(port, action); arg = DS_ARGC > 1 ? D_ARG(2) : NULL; req = cast(REBREQ*, Use_Port_State(port, RDI_CLIPBOARD, sizeof(REBREQ))); switch (action) { case A_UPDATE: // Update the port object after a READ or WRITE operation. // This is normally called by the WAKE-UP function. arg = OFV(port, STD_PORT_DATA); if (req->command == RDC_READ) { // this could be executed twice: // once for an event READ, once for the CLOSE following the READ if (!req->common.data) return R_NONE; len = req->actual; if (GET_FLAG(req->flags, RRF_WIDE)) { // convert to UTF8, so that it can be converted back to string! Val_Init_Binary(arg, Make_UTF8_Binary( req->common.data, len / sizeof(REBUNI), 0, OPT_ENC_UNISRC )); } else { REBSER *ser = Make_Binary(len); memcpy(BIN_HEAD(ser), req->common.data, len); SERIES_TAIL(ser) = len; Val_Init_Binary(arg, ser); } OS_FREE(req->common.data); // release the copy buffer req->common.data = 0; } else if (req->command == RDC_WRITE) { SET_NONE(arg); // Write is done. } return R_NONE; case A_READ: // This device is opened on the READ: if (!IS_OPEN(req)) { if (OS_DO_DEVICE(req, RDC_OPEN)) fail (Error_On_Port(RE_CANNOT_OPEN, port, req->error)); } // Issue the read request: CLR_FLAG(req->flags, RRF_WIDE); // allow byte or wide chars result = OS_DO_DEVICE(req, RDC_READ); if (result < 0) fail (Error_On_Port(RE_READ_ERROR, port, req->error)); if (result > 0) return R_NONE; /* pending */ // Copy and set the string result: arg = OFV(port, STD_PORT_DATA); len = req->actual; if (GET_FLAG(req->flags, RRF_WIDE)) { // convert to UTF8, so that it can be converted back to string! Val_Init_Binary(arg, Make_UTF8_Binary( req->common.data, len / sizeof(REBUNI), 0, OPT_ENC_UNISRC )); } else { REBSER *ser = Make_Binary(len); memcpy(BIN_HEAD(ser), req->common.data, len); SERIES_TAIL(ser) = len; Val_Init_Binary(arg, ser); } *D_OUT = *arg; return R_OUT; case A_WRITE: if (!IS_STRING(arg) && !IS_BINARY(arg)) fail (Error(RE_INVALID_PORT_ARG, arg)); // This device is opened on the WRITE: if (!IS_OPEN(req)) { if (OS_DO_DEVICE(req, RDC_OPEN)) fail (Error_On_Port(RE_CANNOT_OPEN, port, req->error)); } refs = Find_Refines(call_, ALL_WRITE_REFS); // Handle /part refinement: len = VAL_LEN(arg); if (refs & AM_WRITE_PART && VAL_INT32(D_ARG(ARG_WRITE_LIMIT)) < len) len = VAL_INT32(D_ARG(ARG_WRITE_LIMIT)); // If bytes, see if we can fit it: if (SERIES_WIDE(VAL_SERIES(arg)) == 1) { #ifdef ARG_STRINGS_ALLOWED if (!All_Bytes_ASCII(VAL_BIN_DATA(arg), len)) { Val_Init_String( arg, Copy_Bytes_To_Unicode(VAL_BIN_DATA(arg), len) ); } else req->common.data = VAL_BIN_DATA(arg); #endif // Temp conversion:!!! ser = Make_Unicode(len); len = Decode_UTF8(UNI_HEAD(ser), VAL_BIN_DATA(arg), len, FALSE); SERIES_TAIL(ser) = len = abs(len); UNI_TERM(ser); Val_Init_String(arg, ser); req->common.data = cast(REBYTE*, UNI_HEAD(ser)); SET_FLAG(req->flags, RRF_WIDE); } else // If unicode (may be from above conversion), handle it: if (SERIES_WIDE(VAL_SERIES(arg)) == sizeof(REBUNI)) { req->common.data = cast(REBYTE *, VAL_UNI_DATA(arg)); SET_FLAG(req->flags, RRF_WIDE); }