*/ 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 *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;
}
*/ 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;
}
*/ 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;
}
*/ REBSER *Block_To_String_List(REBVAL *blk)
/*
** Convert block of values to a string that holds
** a series of null terminated strings, followed
** by a final terminating string.
**
***********************************************************************/
{
REB_MOLD mo = {0};
REBVAL *value;
Reset_Mold(&mo);
for (value = VAL_BLK_DATA(blk); NOT_END(value); value++) {
Mold_Value(&mo, value, 0);
Append_Byte(mo.series, 0);
}
Append_Byte(mo.series, 0);
return Copy_Series(mo.series); // Unicode
}
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:
// Join_Binary returns a shared buffer, so produce a copy:
ser = Copy_Series(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;
}
