// // Val_Init_Series_Index_Core: C // // Common function. // void Val_Init_Series_Index_Core( REBVAL *value, enum Reb_Kind type, REBSER *series, REBCNT index ) { assert(series); ENSURE_SERIES_MANAGED(series); if (type != REB_IMAGE && type != REB_VECTOR) { // Code in various places seemed to have different opinions of // whether a BINARY needed to be zero terminated. It doesn't // make a lot of sense to zero terminate a binary unless it // simplifies the code assumptions somehow--it's in the class // "ANY_BINSTR()" so that suggests perhaps it has a bit more // obligation to conform. Also, the original Make_Binary comment // from the open source release read: // // Make a binary string series. For byte, C, and UTF8 strings. // Add 1 extra for terminator. // // Until that is consciously overturned, check the REB_BINARY too ASSERT_SERIES_TERM(series); // doesn't apply to image/vector } VAL_RESET_HEADER(value, type); INIT_VAL_SERIES(value, series); VAL_INDEX(value) = index; }
*/ REBFLG MT_Struct(REBVAL *out, REBVAL *data, enum Reb_Kind type) /* * Format: * make struct! [ * field1 [type1] * field2: [type2] field2-init-value * field3: [struct [field1 [type1]]] * field4: [type1[3]] * ... * ] ***********************************************************************/ { //RL_Print("%s\n", __func__); REBINT max_fields = 16; VAL_STRUCT_FIELDS(out) = Make_Series( max_fields, sizeof(struct Struct_Field), MKS_NONE ); MANAGE_SERIES(VAL_STRUCT_FIELDS(out)); if (IS_BLOCK(data)) { //if (Reduce_Block_No_Set_Throws(VAL_SERIES(data), 0, NULL))... //data = DS_POP; REBVAL *blk = VAL_BLK_DATA(data); REBINT field_idx = 0; /* for field index */ u64 offset = 0; /* offset in data */ REBCNT eval_idx = 0; /* for spec block evaluation */ REBVAL *init = NULL; /* for result to save in data */ REBOOL expect_init = FALSE; REBINT raw_size = -1; REBUPT raw_addr = 0; REBCNT alignment = 0; VAL_STRUCT_SPEC(out) = Copy_Array_Shallow(VAL_SERIES(data)); VAL_STRUCT_DATA(out) = Make_Series( 1, sizeof(struct Struct_Data), MKS_NONE ); EXPAND_SERIES_TAIL(VAL_STRUCT_DATA(out), 1); VAL_STRUCT_DATA_BIN(out) = Make_Series(max_fields << 2, 1, MKS_NONE); VAL_STRUCT_OFFSET(out) = 0; // We tell the GC to manage this series, but it will not cause a // synchronous garbage collect. Still, when's the right time? ENSURE_SERIES_MANAGED(VAL_STRUCT_SPEC(out)); MANAGE_SERIES(VAL_STRUCT_DATA(out)); MANAGE_SERIES(VAL_STRUCT_DATA_BIN(out)); /* set type early such that GC will handle it correctly, i.e, not collect series in the struct */ SET_TYPE(out, REB_STRUCT); if (IS_BLOCK(blk)) { parse_attr(blk, &raw_size, &raw_addr); ++ blk; } while (NOT_END(blk)) { REBVAL *inner; struct Struct_Field *field = NULL; u64 step = 0; EXPAND_SERIES_TAIL(VAL_STRUCT_FIELDS(out), 1); DS_PUSH_NONE; inner = DS_TOP; /* save in stack so that it won't be GC'ed when MT_Struct is recursively called */ field = (struct Struct_Field *)SERIES_SKIP(VAL_STRUCT_FIELDS(out), field_idx); field->offset = (REBCNT)offset; if (IS_SET_WORD(blk)) { field->sym = VAL_WORD_SYM(blk); expect_init = TRUE; if (raw_addr) { /* initialization is not allowed for raw memory struct */ raise Error_Invalid_Arg(blk); } } else if (IS_WORD(blk)) { field->sym = VAL_WORD_SYM(blk); expect_init = FALSE; } else raise Error_Has_Bad_Type(blk); ++ blk; if (!IS_BLOCK(blk)) raise Error_Invalid_Arg(blk); if (!parse_field_type(field, blk, inner, &init)) { return FALSE; } ++ blk; STATIC_assert(sizeof(field->size) <= 4); STATIC_assert(sizeof(field->dimension) <= 4); step = (u64)field->size * (u64)field->dimension; if (step > VAL_STRUCT_LIMIT) raise Error_1(RE_SIZE_LIMIT, out); EXPAND_SERIES_TAIL(VAL_STRUCT_DATA_BIN(out), step); if (expect_init) { REBVAL safe; // result of reduce or do (GC saved during eval) init = &safe; if (IS_BLOCK(blk)) { if (Reduce_Block_Throws(init, VAL_SERIES(blk), 0, FALSE)) raise Error_No_Catch_For_Throw(init); ++ blk; } else { DO_NEXT_MAY_THROW( eval_idx, init, VAL_SERIES(data), blk - VAL_BLK_DATA(data) ); if (eval_idx == THROWN_FLAG) raise Error_No_Catch_For_Throw(init); blk = VAL_BLK_SKIP(data, eval_idx); } if (field->array) { if (IS_INTEGER(init)) { /* interpreted as a C pointer */ void *ptr = cast(void *, cast(REBUPT, VAL_INT64(init))); /* assuming it's an valid pointer and holding enough space */ memcpy(SERIES_SKIP(VAL_STRUCT_DATA_BIN(out), (REBCNT)offset), ptr, field->size * field->dimension); } else if (IS_BLOCK(init)) { REBCNT n = 0; if (VAL_LEN(init) != field->dimension) raise Error_Invalid_Arg(init); /* assign */ for (n = 0; n < field->dimension; n ++) { if (!assign_scalar(&VAL_STRUCT(out), field, n, VAL_BLK_SKIP(init, n))) { //RL_Print("Failed to assign element value\n"); goto failed; } } } else raise Error_Unexpected_Type(REB_BLOCK, VAL_TYPE(blk)); } else { /* scalar */ if (!assign_scalar(&VAL_STRUCT(out), field, 0, init)) { //RL_Print("Failed to assign scalar value\n"); goto failed; } } } else if (raw_addr == 0) {
*/ REBSER *Make_Object(REBSER *parent, REBVAL value[]) /* ** 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 (!value || IS_END(value)) { if (parent) { object = Copy_Array_Core_Managed( parent, 0, SERIES_TAIL(parent), TRUE, TS_CLONE ); } else { object = Make_Frame(0, TRUE); MANAGE_FRAME(object); } } else { words = Collect_Frame(parent, &value[0], BIND_ONLY); // GC safe object = Create_Frame(words, 0); // GC safe if (parent) { if (Reb_Opts->watch_obj_copy) Debug_Fmt(cs_cast(BOOT_STR(RS_WATCH, 2)), SERIES_TAIL(parent) - 1, FRM_WORD_SERIES(object)); // Bitwise copy parent values (will have bits fixed by Clonify) memcpy( FRM_VALUES(object) + 1, FRM_VALUES(parent) + 1, (SERIES_TAIL(parent) - 1) * sizeof(REBVAL) ); // For values we copied that were blocks and strings, replace // their series components with deep copies of themselves: Clonify_Values_Len_Managed( BLK_SKIP(object, 1), SERIES_TAIL(object) - 1, TRUE, TS_CLONE ); // The *word series* might have been reused from the parent, // based on whether any words were added, or we could have gotten // a fresh one back. Force our invariant here (as the screws // tighten...) ENSURE_SERIES_MANAGED(FRM_WORD_SERIES(object)); MANAGE_SERIES(object); } else { MANAGE_FRAME(object); } assert(words == FRM_WORD_SERIES(object)); } ASSERT_SERIES_MANAGED(object); ASSERT_SERIES_MANAGED(FRM_WORD_SERIES(object)); ASSERT_FRAME(object); return object; }