*/ REBSER *List_Func_Types(REBVAL *func)
/*
** Return a block of function arg types.
** Note: skips 0th entry.
**
***********************************************************************/
{
REBSER *block;
REBSER *words = VAL_FUNC_WORDS(func);
REBCNT n;
REBVAL *value;
REBVAL *word;
block = Make_Block(SERIES_TAIL(words));
word = BLK_SKIP(words, 1);
for (n = 1; n < SERIES_TAIL(words); word++, n++) {
value = Alloc_Tail_Blk(block);
VAL_SET(value, VAL_TYPE(word));
VAL_WORD_SYM(value) = VAL_BIND_SYM(word);
UNBIND(value);
}
return block;
}
static REBOOL same_fields(REBSER *tgt, REBSER *src)
{
struct Struct_Field *tgt_fields = (struct Struct_Field *) SERIES_DATA(tgt);
struct Struct_Field *src_fields = (struct Struct_Field *) SERIES_DATA(src);
REBCNT n;
if (SERIES_TAIL(tgt) != SERIES_TAIL(src)) {
return FALSE;
}
for(n = 0; n < SERIES_TAIL(src); n ++) {
if (tgt_fields[n].type != src_fields[n].type) {
return FALSE;
}
if (VAL_SYM_CANON(BLK_SKIP(PG_Word_Table.series, tgt_fields[n].sym))
!= VAL_SYM_CANON(BLK_SKIP(PG_Word_Table.series, src_fields[n].sym))
|| tgt_fields[n].offset != src_fields[n].offset
|| tgt_fields[n].dimension != src_fields[n].dimension
|| tgt_fields[n].size != src_fields[n].size) {
return FALSE;
}
if (tgt_fields[n].type == STRUCT_TYPE_STRUCT
&& ! same_fields(tgt_fields[n].fields, src_fields[n].fields)) {
return FALSE;
}
}
return TRUE;
}
*/ 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);
}
static REBSER *Trim_Object(REBSER *obj)
{
REBVAL *val;
REBINT cnt = 0;
REBSER *nobj;
REBVAL *nval;
REBVAL *word;
REBVAL *nwrd;
word = FRM_WORDS(obj)+1;
for (val = FRM_VALUES(obj)+1; NOT_END(val); val++, word++) {
if (VAL_TYPE(val) > REB_NONE && !VAL_GET_OPT(word, OPTS_HIDE))
cnt++;
}
nobj = Make_Frame(cnt);
nval = FRM_VALUES(nobj)+1;
word = FRM_WORDS(obj)+1;
nwrd = FRM_WORDS(nobj)+1;
for (val = FRM_VALUES(obj)+1; NOT_END(val); val++, word++) {
if (VAL_TYPE(val) > REB_NONE && !VAL_GET_OPT(word, OPTS_HIDE)) {
*nval++ = *val;
*nwrd++ = *word;
}
}
SET_END(nval);
SET_END(nwrd);
SERIES_TAIL(nobj) = cnt+1;
SERIES_TAIL(FRM_WORD_SERIES(nobj)) = cnt+1;
return nobj;
}
*/ REBSER *Collect_Block_Words(REBVAL *block, REBVAL *prior, REBCNT modes)
/*
** Collect words from a prior block and new block.
**
***********************************************************************/
{
REBSER *series;
REBCNT start;
REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
CHECK_BIND_TABLE;
if (SERIES_TAIL(BUF_WORDS)) Crash(RP_WORD_LIST); // still in use
if (prior)
Collect_Simple_Words(prior, BIND_ALL);
start = SERIES_TAIL(BUF_WORDS);
Collect_Simple_Words(block, modes);
// Reset word markers:
for (block = BLK_HEAD(BUF_WORDS); NOT_END(block); block++)
binds[VAL_WORD_CANON(block)] = 0;
series = Copy_Series_Part(BUF_WORDS, start, SERIES_TAIL(BUF_WORDS)-start);
RESET_TAIL(BUF_WORDS); // allow reuse
CHECK_BIND_TABLE;
return series;
}
*/ REBSER *Collect_End(REBSER *prior)
/*
** Finish collecting words, and free the Bind_Table for reuse.
**
***********************************************************************/
{
REBVAL *words;
REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
// Reset binding table (note BUF_WORDS may have expanded):
for (words = BLK_HEAD(BUF_WORDS); NOT_END(words); words++)
binds[VAL_WORD_CANON(words)] = 0;
// If no new words, prior frame:
if (prior && SERIES_TAIL(BUF_WORDS) == SERIES_TAIL(prior)) {
RESET_TAIL(BUF_WORDS); // allow reuse
return FRM_WORD_SERIES(prior);
}
prior = Copy_Series(BUF_WORDS);
RESET_TAIL(BUF_WORDS); // allow reuse
BARE_SERIES(prior); // No GC ever needed for word list
CHECK_BIND_TABLE;
return prior;
}
*/ void Enline_Uni(REBSER *ser, REBCNT idx, REBCNT len)
/*
***********************************************************************/
{
REBCNT cnt = 0;
REBUNI *bp;
REBUNI 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 = UNI_SKIP(ser, idx);
for (; len > 0; len--) {
if (*bp == LF && c != CR) cnt++;
c = *bp++;
}
if (cnt == 0) return;
// Extend series:
len = SERIES_TAIL(ser); // before expansion
EXPAND_SERIES_TAIL(ser, cnt);
tail = SERIES_TAIL(ser); // after expansion
bp = UNI_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 *Collect_Words(REBVAL value[], REBVAL prior_value[], REBCNT modes)
/*
** Collect words from a prior block and new block.
**
***********************************************************************/
{
REBSER *series;
REBCNT start;
REBINT *binds = WORDS_HEAD(Bind_Table); // GC safe to do here
CHECK_BIND_TABLE;
if (SERIES_TAIL(BUF_WORDS)) panic Error_0(RE_WORD_LIST); // still in use
if (prior_value)
Collect_Words_Inner_Loop(binds, &prior_value[0], BIND_ALL);
start = SERIES_TAIL(BUF_WORDS);
Collect_Words_Inner_Loop(binds, &value[0], modes);
// Reset word markers:
for (value = BLK_HEAD(BUF_WORDS); NOT_END(value); value++)
binds[VAL_WORD_CANON(value)] = 0;
series = Copy_Array_At_Max_Shallow(
BUF_WORDS, start, SERIES_TAIL(BUF_WORDS) - start
);
RESET_TAIL(BUF_WORDS); // allow reuse
CHECK_BIND_TABLE;
return series;
}
xx*/ REBSER *Make_Func_Words(REBSER *spec)
/*
** Make a word list part of a context block for a function spec.
** This series is stored in the ARGS field of the function value.
**
***********************************************************************/
{
REBVAL *word = BLK_HEAD(spec);
REBSER *words;
REBCNT n;
REBCNT len = 0;
// Count the number of words within the spec:
for (n = 0; n < SERIES_TAIL(spec); n++) {
if (ANY_WORD(word+n)) len++;
}
// Make the words table:
words = Make_Words(len+1);
// Skip 0th entry (because 0 is not valid for bind index).
len = 1;
WORDS_HEAD(words)[0] = 0;
// Initialize the words in the new table.
for (n = 0; n < SERIES_TAIL(spec); n++) {
if (ANY_WORD(word+n)) WORDS_HEAD(words)[len++] = n;
}
SERIES_TAIL(words) = len;
return words;
}
*/ void Set_Error_Type(ERROR_OBJ *error)
/*
** Sets error type and id fields based on code number.
**
***********************************************************************/
{
REBSER *cats; // Error catalog object
REBSER *cat; // Error category object
REBCNT n; // Word symbol number
REBCNT code;
code = VAL_INT32(&error->code);
// Set error category:
n = code / 100 + 1;
cats = VAL_OBJ_FRAME(Get_System(SYS_CATALOG, CAT_ERRORS));
if (code >= 0 && n < SERIES_TAIL(cats) &&
NZ(cat = VAL_SERIES(BLK_SKIP(cats, n)))
) {
Set_Word(&error->type, FRM_WORD_SYM(cats, n), cats, n);
// Find word related to the error itself:
n = code % 100 + 3;
if (n < SERIES_TAIL(cat))
Set_Word(&error->id, FRM_WORD_SYM(cat, n), cat, n);
}
}
*/ 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;
}
*/ REBSER *Merge_Frames(REBSER *parent1, REBSER *parent2)
/*
** Create a child frame from two parent frames. Merge common fields.
** Values from the second parent take precedence.
**
** Deep copy and rebind the child.
**
***********************************************************************/
{
REBSER *wrds;
REBSER *child;
REBVAL *words;
REBVAL *value;
REBCNT n;
REBINT *binds = WORDS_HEAD(Bind_Table);
// Merge parent1 and parent2 words.
// Keep the binding table.
Collect_Start(BIND_ALL);
// Setup binding table and BUF_WORDS with parent1 words:
if (parent1) Collect_Object(parent1);
// Add parent2 words to binding table and BUF_WORDS:
Collect_Words(BLK_SKIP(FRM_WORD_SERIES(parent2), 1), BIND_ALL);
// Allocate child (now that we know the correct size):
wrds = Copy_Series(BUF_WORDS);
child = Make_Block(SERIES_TAIL(wrds));
value = Append_Value(child);
VAL_SET(value, REB_FRAME);
VAL_FRM_WORDS(value) = wrds;
VAL_FRM_SPEC(value) = 0;
// Copy parent1 values:
COPY_VALUES(FRM_VALUES(parent1)+1, FRM_VALUES(child)+1, SERIES_TAIL(parent1)-1);
// Copy parent2 values:
words = FRM_WORDS(parent2)+1;
value = FRM_VALUES(parent2)+1;
for (; NOT_END(words); words++, value++) {
// no need to search when the binding table is available
n = binds[VAL_WORD_CANON(words)];
BLK_HEAD(child)[n] = *value;
}
// Terminate the child frame:
SERIES_TAIL(child) = SERIES_TAIL(wrds);
BLK_TERM(child);
// Deep copy the child
Copy_Deep_Values(child, 1, SERIES_TAIL(child), TS_CLONE);
// Rebind the child
Rebind_Block(parent1, child, BLK_SKIP(child, 1), REBIND_FUNC);
Rebind_Block(parent2, child, BLK_SKIP(child, 1), REBIND_FUNC | REBIND_TABLE);
// release the bind table
Collect_End(wrds);
return child;
}
*/ REBSER *Make_Object(REBSER *parent, REBVAL *block)
/*
** Create an object from a parent object and a spec block.
** The words within the resultant object are not bound.
**
***********************************************************************/
{
REBSER *words;
REBSER *object;
PG_Reb_Stats->Objects++;
if (!block || IS_END(block)) {
object = parent ? Copy_Block_Values(parent, 0, SERIES_TAIL(parent), TS_CLONE) : Make_Frame(0);
} else {
words = Collect_Frame(BIND_ONLY, parent, block); // GC safe
object = Create_Frame(words, 0); // GC safe
if (parent) {
if (Reb_Opts->watch_obj_copy)
Debug_Fmt(BOOT_STR(RS_WATCH, 2), SERIES_TAIL(parent) - 1, FRM_WORD_SERIES(object));
// Copy parent values and deep copy blocks and strings:
COPY_VALUES(FRM_VALUES(parent)+1, FRM_VALUES(object)+1, SERIES_TAIL(parent) - 1);
Copy_Deep_Values(object, 1, SERIES_TAIL(object), TS_CLONE);
}
}
//Dump_Frame(object);
return object;
}
*/ 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;
}
*/ 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;
}
*/ 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 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;
}
xx*/ void Dump_Bind_Table()
/*
***********************************************************************/
{
REBCNT n;
REBINT *binds = WORDS_HEAD(Bind_Table);
Debug_Fmt("Bind Table (Size: %d)", SERIES_TAIL(Bind_Table));
for (n = 1; n < SERIES_TAIL(Bind_Table); n++) {
if (binds[n])
Debug_Fmt("Bind: %3d to %3d (%s)", n, binds[n], Get_Sym_Name(n));
}
}
*/ REBCNT Find_Block_Simple(REBSER *series, REBCNT index, REBVAL *target)
/*
** Simple search for a value in a block. Return the index of
** the value or the TAIL index if not found.
**
***********************************************************************/
{
REBVAL *value = BLK_HEAD(series);
for (; index < SERIES_TAIL(series); index++) {
if (0 == Cmp_Value(value+index, target, FALSE)) return index;
}
return SERIES_TAIL(series);
}
*/ 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;
}
STOID Form_Block_Series(REBSER *blk, REBCNT index, REB_MOLD *mold, REBSER *frame)
{
// Form a series (part_mold means mold non-string values):
REBINT n;
REBINT len = SERIES_TAIL(blk) - index;
REBVAL *val;
REBVAL *wval;
if (len < 0) len = 0;
for (n = 0; n < len;) {
val = BLK_SKIP(blk, index+n);
wval = 0;
if (frame && (IS_WORD(val) || IS_GET_WORD(val))) {
wval = Find_Word_Value(frame, VAL_WORD_SYM(val));
if (wval) val = wval;
}
Mold_Value(mold, val, wval != 0);
n++;
if (GET_MOPT(mold, MOPT_LINES)) {
Append_Byte(mold->series, LF);
}
else {
// Add a space if needed:
if (n < len && mold->series->tail
&& *UNI_LAST(mold->series) != LF
&& !GET_MOPT(mold, MOPT_TIGHT)
)
Append_Byte(mold->series, ' ');
}
}
}
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++;
}
*/ 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;
}
*/ REBINT PD_Object(REBPVS *pvs)
/*
***********************************************************************/
{
REBINT n = 0;
if (!VAL_OBJ_FRAME(pvs->value)) {
return PE_NONE; // Error objects may not have a frame.
}
if (IS_WORD(pvs->select)) {
n = Find_Word_Index(VAL_OBJ_FRAME(pvs->value), VAL_WORD_SYM(pvs->select), FALSE);
}
// else if (IS_INTEGER(pvs->select)) {
// n = Int32s(pvs->select, 1);
// }
else return PE_BAD_SELECT;
if (n <= 0 || (REBCNT)n >= SERIES_TAIL(VAL_OBJ_FRAME(pvs->value)))
return PE_BAD_SELECT;
if (pvs->setval && IS_END(pvs->path+1) && VAL_PROTECTED(VAL_FRM_WORD(pvs->value, n)))
Trap1(RE_LOCKED_WORD, pvs->select);
pvs->value = VAL_OBJ_VALUES(pvs->value) + n;
return PE_SET;
// if setval, check PROTECT mode!!!
// VAL_FLAGS((VAL_OBJ_VALUES(value) + n)) &= ~FLAGS_CLEAN;
}
*/ 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));
}
}
//
// Find_Key: C
//
// Returns hash index (either the match or the new one).
// A return of zero is valid (as a hash index);
//
// Wide: width of record (normally 2, a key and a value).
//
// Modes:
// 0 - search, return hash if found or not
// 1 - search, return hash, else return -1 if not
// 2 - search, return hash, else append value and return -1
//
REBINT Find_Key(REBSER *series, REBSER *hser, const REBVAL *key, REBINT wide, REBCNT cased, REBYTE mode)
{
REBCNT *hashes;
REBCNT skip;
REBCNT hash;
REBCNT len;
REBCNT n;
REBVAL *val;
// Compute hash for value:
len = hser->tail;
hash = Hash_Value(key, len);
if (!hash) fail (Error_Has_Bad_Type(key));
// Determine skip and first index:
skip = (len == 0) ? 0 : (hash & 0x0000FFFF) % len;
if (skip == 0) skip = 1;
hash = (len == 0) ? 0 : (hash & 0x00FFFF00) % len;
// Scan hash table for match:
hashes = (REBCNT*)hser->data;
if (ANY_WORD(key)) {
while ((n = hashes[hash])) {
val = BLK_SKIP(series, (n-1) * wide);
if (
ANY_WORD(val) &&
(VAL_WORD_SYM(key) == VAL_WORD_SYM(val) ||
(!cased && VAL_WORD_CANON(key) == VAL_WORD_CANON(val)))
) return hash;
hash += skip;
if (hash >= len) hash -= len;
}
}
else if (ANY_BINSTR(key)) {
while ((n = hashes[hash])) {
val = BLK_SKIP(series, (n-1) * wide);
if (
VAL_TYPE(val) == VAL_TYPE(key)
&& 0 == Compare_String_Vals(key, val, (REBOOL)(!IS_BINARY(key) && !cased))
) return hash;
hash += skip;
if (hash >= len) hash -= len;
}
} else {
while ((n = hashes[hash])) {
val = BLK_SKIP(series, (n-1) * wide);
if (VAL_TYPE(val) == VAL_TYPE(key) && 0 == Cmp_Value(key, val, !cased)) return hash;
hash += skip;
if (hash >= len) hash -= len;
}
}
// Append new value the target series:
if (mode > 1) {
hashes[hash] = SERIES_TAIL(series) + 1;
Append_Values_Len(series, key, wide);
}
return (mode > 0) ? NOT_FOUND : hash;
}
*/ void Sieve_Ports(REBSER *ports)
/*
** Remove all ports not found in the WAKE list.
** ports could be NULL, in which case the WAKE list is cleared.
**
***********************************************************************/
{
REBVAL *port;
REBVAL *waked;
REBVAL *val;
REBCNT n;
port = Get_System(SYS_PORTS, PORTS_SYSTEM);
if (!IS_PORT(port)) return;
waked = VAL_OBJ_VALUE(port, STD_PORT_DATA);
if (!IS_BLOCK(waked)) return;
for (n = 0; ports && n < SERIES_TAIL(ports);) {
val = BLK_SKIP(ports, n);
if (IS_PORT(val)) {
assert(VAL_TAIL(waked) != 0);
if (VAL_TAIL(waked) == Find_Block_Simple(VAL_SERIES(waked), 0, val)) {//not found
Remove_Series(ports, n, 1);
continue;
}
}
n++;
}
//clear waked list
RESET_SERIES(VAL_SERIES(waked));
}
*/ static REBFLG Get_Struct_Var(REBSTU *stu, REBVAL *word, 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) {
REBSER *ser = Make_Array(field->dimension);
REBCNT n = 0;
for (n = 0; n < field->dimension; n ++) {
REBVAL elem;
get_scalar(stu, field, n, &elem);
Append_Value(ser, &elem);
}
Val_Init_Block(val, ser);
} else {
get_scalar(stu, field, 0, val);
}
return TRUE;
}
}
return FALSE;
}
*/ void Debug_Uni(const REBSER *ser)
/*
** Print debug unicode string followed by a newline.
**
***********************************************************************/
{
REBCNT ul;
REBCNT bl;
REBYTE buf[1024];
REBUNI *up = UNI_HEAD(ser);
REBINT size = Length_As_UTF8(up, SERIES_TAIL(ser), TRUE, OS_CRLF);
REBINT disabled = GC_Disabled;
GC_Disabled = 1;
while (size > 0) {
ul = Encode_UTF8(buf, MIN(size, 1020), up, &bl, TRUE, OS_CRLF);
Debug_String(buf, bl, 0, 0);
size -= ul;
up += ul;
}
Debug_Line();
assert(GC_Disabled == 1);
GC_Disabled = disabled;
}
*/ REBINT PD_File(REBPVS *pvs)
/*
***********************************************************************/
{
REBSER *ser;
REB_MOLD mo = {0};
REBCNT n;
REBUNI c;
REBSER *arg;
if (pvs->setval) return PE_BAD_SET;
ser = Copy_Series_Value(pvs->value);
n = SERIES_TAIL(ser);
if (n > 0) c = GET_ANY_CHAR(ser, n-1);
if (n == 0 || c != '/') Append_Byte(ser, '/');
if (ANY_STR(pvs->select))
arg = VAL_SERIES(pvs->select);
else {
Reset_Mold(&mo);
Mold_Value(&mo, pvs->select, 0);
arg = mo.series;
}
c = GET_ANY_CHAR(arg, 0);
n = (c == '/' || c == '\\') ? 1 : 0;
Append_String(ser, arg, n, arg->tail-n);
Set_Series(VAL_TYPE(pvs->value), pvs->store, ser);
return PE_USE;
}