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 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;
}
*/ static REBFLG Set_Struct_Var(REBSTU *stu, REBVAL *word, REBVAL *elem, 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) {
if (elem == NULL) { //set the whole array
REBCNT n = 0;
if ((!IS_BLOCK(val) || field->dimension != VAL_LEN(val))) {
return FALSE;
}
for(n = 0; n < field->dimension; n ++) {
if (!assign_scalar(stu, field, n, VAL_BLK_SKIP(val, n))) {
return FALSE;
}
}
} else {// set only one element
if (!IS_INTEGER(elem)
|| VAL_INT32(elem) <= 0
|| VAL_INT32(elem) > cast(REBINT, field->dimension)) {
return FALSE;
}
return assign_scalar(stu, field, VAL_INT32(elem) - 1, val);
}
return TRUE;
} else {
return assign_scalar(stu, field, 0, val);
}
return TRUE;
}
}
return FALSE;
}
RL_API int RL_Series(REBSER *series, REBCNT what)
/*
** Get series information.
**
** Returns:
** Returns information related to a series.
** Arguments:
** series - any series pointer (string or block)
** what - indicates what information to return (see RXI_SER enum)
** Notes:
** Invalid what arg nums will return zero.
*/
{
switch (what) {
case RXI_SER_DATA: return (int)SERIES_DATA(series); // problem for 64 bit !!
case RXI_SER_TAIL: return SERIES_TAIL(series);
case RXI_SER_LEFT: return SERIES_AVAIL(series);
case RXI_SER_SIZE: return SERIES_REST(series);
case RXI_SER_WIDE: return SERIES_WIDE(series);
}
return 0;
}
static REBOOL get_scalar(const REBSTU *stu,
const struct Struct_Field *field,
REBCNT n, /* element index, starting from 0 */
REBVAL *val)
{
REBYTE *data = SERIES_SKIP(STRUCT_DATA_BIN(stu),
STRUCT_OFFSET(stu) + field->offset + n * field->size);
switch (field->type) {
case STRUCT_TYPE_UINT8:
SET_INTEGER(val, *(u8*)data);
break;
case STRUCT_TYPE_INT8:
SET_INTEGER(val, *(i8*)data);
break;
case STRUCT_TYPE_UINT16:
SET_INTEGER(val, *(u16*)data);
break;
case STRUCT_TYPE_INT16:
SET_INTEGER(val, *(i8*)data);
break;
case STRUCT_TYPE_UINT32:
SET_INTEGER(val, *(u32*)data);
break;
case STRUCT_TYPE_INT32:
SET_INTEGER(val, *(i32*)data);
break;
case STRUCT_TYPE_UINT64:
SET_INTEGER(val, *(u64*)data);
break;
case STRUCT_TYPE_INT64:
SET_INTEGER(val, *(i64*)data);
break;
case STRUCT_TYPE_FLOAT:
SET_DECIMAL(val, *(float*)data);
break;
case STRUCT_TYPE_DOUBLE:
SET_DECIMAL(val, *(double*)data);
break;
case STRUCT_TYPE_POINTER:
SET_INTEGER(val, cast(REBUPT, *cast(void**, data)));
break;
case STRUCT_TYPE_STRUCT:
{
SET_TYPE(val, REB_STRUCT);
VAL_STRUCT_FIELDS(val) = field->fields;
VAL_STRUCT_SPEC(val) = field->spec;
VAL_STRUCT_DATA(val) = Make_Series(
1, sizeof(struct Struct_Data), MKS_NONE
);
MANAGE_SERIES(VAL_STRUCT_DATA(val));
VAL_STRUCT_DATA_BIN(val) = STRUCT_DATA_BIN(stu);
VAL_STRUCT_OFFSET(val) = data - SERIES_DATA(VAL_STRUCT_DATA_BIN(val));
VAL_STRUCT_LEN(val) = field->size;
}
break;
case STRUCT_TYPE_REBVAL:
memcpy(val, data, sizeof(REBVAL));
break;
default:
/* should never be here */
return FALSE;
}
return TRUE;
}
*/ REBSER *Struct_To_Block(const REBSTU *stu)
/*
** Used by MOLD to create a block.
**
***********************************************************************/
{
REBSER *ser = Make_Array(10);
struct Struct_Field *field = (struct Struct_Field*) SERIES_DATA(stu->fields);
REBCNT i;
// We are building a recursive structure. So if we did not hand each
// sub-series over to the GC then a single Free_Series() would not know
// how to free them all. There would have to be a specialized walk to
// free the resulting structure. Hence, don't invoke the GC until the
// root series being returned is done being used or is safe from GC!
MANAGE_SERIES(ser);
for(i = 0; i < SERIES_TAIL(stu->fields); i ++, field ++) {
REBVAL *val = NULL;
REBVAL *type_blk = NULL;
/* required field name */
val = Alloc_Tail_Array(ser);
Val_Init_Word_Unbound(val, REB_SET_WORD, field->sym);
/* required type */
type_blk = Alloc_Tail_Array(ser);
Val_Init_Block(type_blk, Make_Array(1));
val = Alloc_Tail_Array(VAL_SERIES(type_blk));
if (field->type == STRUCT_TYPE_STRUCT) {
REBVAL *nested = NULL;
DS_PUSH_NONE;
nested = DS_TOP;
Val_Init_Word_Unbound(val, REB_WORD, SYM_STRUCT_TYPE);
get_scalar(stu, field, 0, nested);
val = Alloc_Tail_Array(VAL_SERIES(type_blk));
Val_Init_Block(val, Struct_To_Block(&VAL_STRUCT(nested)));
DS_DROP;
} else
Val_Init_Word_Unbound(val, REB_WORD, type_to_sym[field->type]);
/* optional dimension */
if (field->dimension > 1) {
REBSER *dim = Make_Array(1);
REBVAL *dv = NULL;
val = Alloc_Tail_Array(VAL_SERIES(type_blk));
Val_Init_Block(val, dim);
dv = Alloc_Tail_Array(dim);
SET_INTEGER(dv, field->dimension);
}
/* optional initialization */
if (field->dimension > 1) {
REBSER *dim = Make_Array(1);
REBCNT n = 0;
val = Alloc_Tail_Array(ser);
Val_Init_Block(val, dim);
for (n = 0; n < field->dimension; n ++) {
REBVAL *dv = Alloc_Tail_Array(dim);
get_scalar(stu, field, n, dv);
}
} else {
val = Alloc_Tail_Array(ser);
get_scalar(stu, field, 0, val);
}
}
return ser;
}
*/ 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));
}
*/ void Mold_Value(REB_MOLD *mold, const REBVAL *value, REBFLG molded)
/*
** Mold or form any value to string series tail.
**
***********************************************************************/
{
REBYTE buf[60];
REBINT len;
REBSER *ser = mold->series;
CHECK_C_STACK_OVERFLOW(&len);
assert(SERIES_WIDE(mold->series) == sizeof(REBUNI));
assert(ser);
// Special handling of string series: {
if (ANY_STR(value) && !IS_TAG(value)) {
// Forming a string:
if (!molded) {
Insert_String(ser, -1, VAL_SERIES(value), VAL_INDEX(value), VAL_LEN(value), 0);
return;
}
// Special format for ALL string series when not at head:
if (GET_MOPT(mold, MOPT_MOLD_ALL) && VAL_INDEX(value) != 0) {
Mold_All_String(value, mold);
return;
}
}
switch (VAL_TYPE(value)) {
case REB_NONE:
Emit(mold, "+N", SYM_NONE);
break;
case REB_LOGIC:
// if (!molded || !VAL_LOGIC_WORDS(value) || !GET_MOPT(mold, MOPT_MOLD_ALL))
Emit(mold, "+N", VAL_LOGIC(value) ? SYM_TRUE : SYM_FALSE);
// else
// Mold_Logic(mold, value);
break;
case REB_INTEGER:
len = Emit_Integer(buf, VAL_INT64(value));
goto append;
case REB_DECIMAL:
case REB_PERCENT:
len = Emit_Decimal(buf, VAL_DECIMAL(value), IS_PERCENT(value)?DEC_MOLD_PERCENT:0,
Punctuation[GET_MOPT(mold, MOPT_COMMA_PT) ? PUNCT_COMMA : PUNCT_DOT], mold->digits);
goto append;
case REB_MONEY:
len = Emit_Money(value, buf, mold->opts);
goto append;
case REB_CHAR:
Mold_Uni_Char(ser, VAL_CHAR(value), (REBOOL)molded, (REBOOL)GET_MOPT(mold, MOPT_MOLD_ALL));
break;
case REB_PAIR:
len = Emit_Decimal(buf, VAL_PAIR_X(value), DEC_MOLD_MINIMAL, Punctuation[PUNCT_DOT], mold->digits/2);
Append_Unencoded_Len(ser, s_cast(buf), len);
Append_Byte(ser, 'x');
len = Emit_Decimal(buf, VAL_PAIR_Y(value), DEC_MOLD_MINIMAL, Punctuation[PUNCT_DOT], mold->digits/2);
Append_Unencoded_Len(ser, s_cast(buf), len);
//Emit(mold, "IxI", VAL_PAIR_X(value), VAL_PAIR_Y(value));
break;
case REB_TUPLE:
len = Emit_Tuple(value, buf);
goto append;
case REB_TIME:
//len = Emit_Time(value, buf, Punctuation[GET_MOPT(mold, MOPT_COMMA_PT) ? PUNCT_COMMA : PUNCT_DOT]);
Emit_Time(mold, value);
break;
case REB_DATE:
Emit_Date(mold, value);
break;
case REB_STRING:
// FORM happens in top section.
Mold_String_Series(value, mold);
break;
case REB_BINARY:
if (GET_MOPT(mold, MOPT_MOLD_ALL) && VAL_INDEX(value) != 0) {
Mold_All_String(value, mold);
return;
}
Mold_Binary(value, mold);
break;
case REB_FILE:
if (VAL_LEN(value) == 0) {
Append_Unencoded(ser, "%\"\"");
break;
}
Mold_File(value, mold);
break;
case REB_EMAIL:
case REB_URL:
Mold_Url(value, mold);
break;
case REB_TAG:
if (GET_MOPT(mold, MOPT_MOLD_ALL) && VAL_INDEX(value) != 0) {
Mold_All_String(value, mold);
return;
}
Mold_Tag(value, mold);
break;
// Mold_Issue(value, mold);
// break;
case REB_BITSET:
Pre_Mold(value, mold); // #[bitset! or make bitset!
Mold_Bitset(value, mold);
End_Mold(mold);
break;
case REB_IMAGE:
Pre_Mold(value, mold);
if (!GET_MOPT(mold, MOPT_MOLD_ALL)) {
Append_Byte(ser, '[');
Mold_Image_Data(value, mold);
Append_Byte(ser, ']');
End_Mold(mold);
}
else {
REBVAL val = *value;
VAL_INDEX(&val) = 0; // mold all of it
Mold_Image_Data(&val, mold);
Post_Mold(value, mold);
}
break;
case REB_BLOCK:
case REB_PAREN:
if (!molded)
Form_Block_Series(VAL_SERIES(value), VAL_INDEX(value), mold, 0);
else
Mold_Block(value, mold);
break;
case REB_PATH:
case REB_SET_PATH:
case REB_GET_PATH:
case REB_LIT_PATH:
Mold_Block(value, mold);
break;
case REB_VECTOR:
Mold_Vector(value, mold, molded);
break;
case REB_DATATYPE:
if (!molded)
Emit(mold, "N", VAL_DATATYPE(value) + 1);
else
Emit(mold, "+DN", SYM_DATATYPE_TYPE, VAL_DATATYPE(value) + 1);
break;
case REB_TYPESET:
Mold_Typeset(value, mold, molded);
break;
case REB_WORD:
// This is a high frequency function, so it is optimized.
Append_UTF8(ser, Get_Sym_Name(VAL_WORD_SYM(value)), -1);
break;
case REB_SET_WORD:
Emit(mold, "W:", value);
break;
case REB_GET_WORD:
Emit(mold, ":W", value);
break;
case REB_LIT_WORD:
Emit(mold, "\'W", value);
break;
case REB_REFINEMENT:
Emit(mold, "/W", value);
break;
case REB_ISSUE:
Emit(mold, "#W", value);
break;
case REB_CLOSURE:
case REB_FUNCTION:
case REB_NATIVE:
case REB_ACTION:
case REB_COMMAND:
Mold_Function(value, mold);
break;
case REB_OBJECT:
case REB_MODULE:
case REB_PORT:
if (!molded) Form_Object(value, mold);
else Mold_Object(value, mold);
break;
case REB_TASK:
Mold_Object(value, mold); //// | (1<<MOPT_NO_NONE));
break;
case REB_ERROR:
Mold_Error(value, mold, molded);
break;
case REB_MAP:
Mold_Map(value, mold, molded);
break;
case REB_GOB:
{
REBSER *blk;
Pre_Mold(value, mold);
blk = Gob_To_Block(VAL_GOB(value));
Mold_Block_Series(mold, blk, 0, 0);
End_Mold(mold);
}
break;
case REB_EVENT:
Mold_Event(value, mold);
break;
case REB_STRUCT:
{
REBSER *blk;
Pre_Mold(value, mold);
blk = Struct_To_Block(&VAL_STRUCT(value));
Mold_Block_Series(mold, blk, 0, 0);
End_Mold(mold);
}
break;
case REB_ROUTINE:
Pre_Mold(value, mold);
Mold_Block_Series(mold, VAL_ROUTINE_SPEC(value), 0, NULL);
End_Mold(mold);
break;
case REB_LIBRARY:
Pre_Mold(value, mold);
DS_PUSH_NONE;
*DS_TOP = *(REBVAL*)SERIES_DATA(VAL_LIB_SPEC(value));
Mold_File(DS_TOP, mold);
DS_DROP;
End_Mold(mold);
break;
case REB_CALLBACK:
Pre_Mold(value, mold);
Mold_Block_Series(mold, VAL_ROUTINE_SPEC(value), 0, NULL);
End_Mold(mold);
break;
case REB_REBCODE:
case REB_OP:
case REB_FRAME:
case REB_HANDLE:
case REB_UTYPE:
// Value has no printable form, so just print its name.
if (!molded) Emit(mold, "?T?", value);
else Emit(mold, "+T", value);
break;
case REB_END:
case REB_UNSET:
if (molded) Emit(mold, "+T", value);
break;
default:
assert(FALSE);
Panic_Core(RP_DATATYPE+5, VAL_TYPE(value));
}
return;
append:
Append_Unencoded_Len(ser, s_cast(buf), len);
}
