FEAT: Including Atronix's source of struct! datatype implementation

Author: Oldes

make/rebol3.nest

@@ -109,7 +109,7 @@ core-files: [
 	%core/t-pair.c
 	%core/t-port.c
 	%core/t-string.c
-;	%core/t-struct.c          ;not implemented
+	%core/t-struct.c
 	%core/t-time.c
 	%core/t-tuple.c
 	%core/t-typeset.c

src/boot/actions.reb

@@ -311,7 +311,7 @@ remove: action [
 
 change: action [
 	{Replaces element(s); returns just past the change.}
-	series [series! gob! port!]{At position (modified)}
+	series [series! gob! port! struct!]{At position (modified)}
 	value [any-type!] {The new value}
 	/part {Limits the amount to change to a given length or position}
 	length [number! series! pair!]

src/boot/sysobj.reb

@@ -34,10 +34,10 @@ catalog: object [
 	errors:  none
 	; Reflectors are used on boot to create *-of functions
 	reflectors: [
-		spec   [any-function! any-object! vector! datatype!]
+		spec   [any-function! any-object! vector! datatype! struct!]
 		body   [any-function! any-object! map!]
 		words  [any-function! any-object! map! date!]
-		values [any-object! map!]
+		values [any-object! map! struct!]
 		types  [any-function!]
 		title  [any-function! datatype! module!]
 	]

src/boot/types.reb

@@ -99,7 +99,7 @@ REBOL [
 	gob         self        gob         *        *       *      *   -  
 	event       self        event       *        *       *      *   -  
 	handle      self        0           -        -       -      -   -  
-	struct      invalid     0           -        -       -      -   -  
+	struct      self        struct      *        *       *      *   -  
 	library     invalid     0           -        -       -      -   -  
 	utype       self        utype       -        -       -      -   -  
 

src/core/f-series.c

@@ -307,6 +307,9 @@
 	case REB_FUNCTION:
 		return VAL_FUNC_BODY(s) - VAL_FUNC_BODY(t);
 
+	case REB_STRUCT:
+		return Cmp_Struct(s, t);
+
 	case REB_NONE:
 	case REB_UNSET:
 	case REB_END:

src/core/m-gc.c

@@ -111,7 +111,7 @@ REBVAL *N_watch(REBFRM *frame, REBVAL **inter_block)
 #endif
 
 static void Mark_Series(REBSER *series, REBCNT depth);
-
+static void Mark_Value(REBVAL *val, REBCNT depth);
 
 /***********************************************************************
 **
@@ -149,6 +149,69 @@ static void Mark_Series(REBSER *series, REBCNT depth);
 	}
 }
 
+/***********************************************************************
+**
+*/	static void Mark_Struct_Field(REBSTU *stu, struct Struct_Field *field, REBCNT depth)
+/*
+***********************************************************************/
+{
+	if (field->type == STRUCT_TYPE_STRUCT) {
+		int len = 0;
+		REBSER *series = NULL;
+
+		CHECK_MARK(field->fields, depth);
+		CHECK_MARK(field->spec, depth);
+
+		series = field->fields;
+		for (len = 0; len < series->tail; len++) {
+			Mark_Struct_Field(stu, (struct Struct_Field *)SERIES_SKIP(series, len), depth + 1);
+		}
+	}
+	else if (field->type == STRUCT_TYPE_REBVAL) {
+		REBCNT i;
+		ASSERT2(field->size == sizeof(REBVAL), RP_BAD_SIZE);
+		for (i = 0; i < field->dimension; i++) {
+			REBVAL *data = (REBVAL *)SERIES_SKIP(STRUCT_DATA_BIN(stu),
+				STRUCT_OFFSET(stu) + field->offset + i * field->size);
+			if (field->done) {
+				Mark_Value(data, depth);
+			}
+		}
+	}
+
+	/* ignore primitive datatypes */
+}
+
+/***********************************************************************
+**
+*/	static void Mark_Struct(REBSTU *stu, REBCNT depth)
+/*
+***********************************************************************/
+{
+	int len = 0;
+	REBSER *series = NULL;
+	if (IS_MARK_SERIES(STRUCT_DATA_BIN(stu))) return;
+
+	CHECK_MARK(stu->spec, depth);
+	CHECK_MARK(stu->fields, depth);
+	CHECK_MARK(STRUCT_DATA_BIN(stu), depth);
+
+	Debug_Num("mark spec:  ", (int)stu->spec);
+	Debug_Num("mark fields:", (int)stu->fields);
+	Debug_Num("mark bin:   ", (int)STRUCT_DATA_BIN(stu));
+
+	ASSERT2(IS_BARE_SERIES(stu->data), RP_BAD_SERIES);
+	ASSERT2(!IS_EXT_SERIES(stu->data), RP_BAD_SERIES);
+	ASSERT2(SERIES_TAIL(stu->data) == 1, RP_BAD_SERIES);
+	CHECK_MARK(stu->data, depth);
+
+	series = stu->fields;
+	for (len = 0; len < series->tail; len++) {
+		struct Struct_Field *field = (struct Struct_Field *)SERIES_SKIP(series, len);
+		Mark_Struct_Field(stu, field, depth + 1);
+	}
+}
+
 
 /***********************************************************************
 **
@@ -426,9 +489,7 @@ static void Mark_Series(REBSER *series, REBCNT depth);
 			break;
 
 		case REB_STRUCT:
-			CHECK_MARK(VAL_STRUCT_SPEC(val), depth);  // is a block
-			CHECK_MARK(VAL_STRUCT_VALS(val), depth);  // "    "
-			MARK_SERIES(VAL_STRUCT_DATA(val));
+			Mark_Struct(&VAL_STRUCT(val), depth);
 			break;
 
 		case REB_GOB:

src/core/s-mold.c

@@ -1370,14 +1370,23 @@ STOID Mold_Error(REBVAL *value, REB_MOLD *mold, REBFLG molded)
 		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_HANDLE:
 		Mold_Handle(value, mold);
 		break;
 
 	case REB_REBCODE:
 	case REB_OP:
 	case REB_FRAME:
-	case REB_STRUCT:
 	case REB_LIBRARY:
 	case REB_UTYPE:
 		// Value has no printable form, so just print its name.