*/ 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; }
*/ 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) {
*/ 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); }