FIX: avoid a stack overflow in case of deep recursion recycle

resolves: Oldes/Rebol-issues#2072

Author: Oldes

src/core/m-gc.c

@@ -274,6 +274,19 @@ static void Mark_Series(REBSER *series, REBCNT depth);
 	}
 }
 
+/***********************************************************************
+**
+*/	static void Queue_Mark_Series(REBSER* series)
+/*
+**		Instead of directly marking all series, queue them for later
+**		to avoid a stack overflow in case of deep recursion.
+**
+***********************************************************************/
+{
+	if (SERIES_FULL(GC_Mark_Queue)) Extend_Series(GC_Mark_Queue, 8);
+	((REBSER**)GC_Mark_Queue->data)[GC_Mark_Queue->tail++] = series;
+}
+
 /***********************************************************************
 **
 */	static void Mark_Series(REBSER *series, REBCNT depth)
@@ -371,9 +384,10 @@ static void Mark_Series(REBSER *series, REBCNT depth);
 			// Object is just a block with special first value (context):
 mark_obj:
 			if (!IS_MARK_SERIES(VAL_OBJ_FRAME(val))) {
-				Mark_Series(VAL_OBJ_FRAME(val), depth);
-				if (SERIES_TAIL(VAL_OBJ_FRAME(val)) >= 1)
-					; //Dump_Frame(VAL_OBJ_FRAME(val), 4);
+				if (depth >= 64) Queue_Mark_Series(VAL_OBJ_FRAME(val));
+				else Mark_Series(VAL_OBJ_FRAME(val), depth);
+				//if (SERIES_TAIL(VAL_OBJ_FRAME(val)) >= 1)
+				//	Dump_Frame(VAL_OBJ_FRAME(val), 4);
 			}
 			break;
 
@@ -467,12 +481,12 @@ static void Mark_Series(REBSER *series, REBCNT depth);
 #endif
 			if (SERIES_WIDE(ser) != sizeof(REBVAL) && SERIES_WIDE(ser) != 4 && SERIES_WIDE(ser) != 0)
 				Crash(RP_BAD_WIDTH, 16, SERIES_WIDE(ser), VAL_TYPE(val));
-			CHECK_MARK(ser, depth);
+			QUEUE_CHECK_MARK(ser, depth);
 			break;
 
 		case REB_MAP:
 			ser = VAL_SERIES(val);
-			CHECK_MARK(ser, depth);
+			QUEUE_CHECK_MARK(ser, depth);
 			if (ser->series) {
 				MARK_SERIES(ser->series);
 			}
@@ -664,7 +678,7 @@ static void Mark_Series(REBSER *series, REBCNT depth);
 	PG_Reb_Stats->Recycle_Counter++;
 	PG_Reb_Stats->Recycle_Series = Mem_Pools[SERIES_POOL].free;
 
-	PG_Reb_Stats->Mark_Count = 0;
+	//PG_Reb_Stats->Mark_Count = 0;
 
 	// WARNING: These terminate existing open blocks. This could
 	// be a problem if code is building a new value at the tail,
@@ -701,12 +715,19 @@ static void Mark_Series(REBSER *series, REBCNT depth);
 		}
 	}
 
+	MARK_SERIES(GC_Mark_Queue);
+
 	// Mark all root series:
 	Mark_Series(VAL_SERIES(ROOT_ROOT), 0);
 	Mark_Series(Task_Series, 0);
 
 	// Mark all devices:
 	Mark_Devices(0);
+
+	// Mark series queued to avoid a stack overflow in case of deep recursion
+	while (GC_Mark_Queue->tail > 0) {
+		Mark_Series(((REBSER**)GC_Mark_Queue->data)[--GC_Mark_Queue->tail], 0);
+	}
 
 	count = Sweep_Series();
 	count += Sweep_Gobs();
@@ -802,6 +823,11 @@ static void Mark_Series(REBSER *series, REBCNT depth);
 
 	GC_Series = Make_Series(60, sizeof(REBSER *), FALSE);
 	KEEP_SERIES(GC_Series, "gc guarded");
+
+	// Series queued to be marked in case of deep recursion.
+	GC_Mark_Queue = Make_Series(15, sizeof(REBSER*), FALSE);
+	BARE_SERIES(GC_Mark_Queue);
+	LABEL_SERIES(GC_Mark_Queue, "gc mark queue");
 }
 
 /***********************************************************************

src/include/sys-globals.h

@@ -84,6 +84,7 @@ TVAR REBINT	GC_Ballast;		// Bytes allocated to force automatic GC
 TVAR REBOOL	GC_Active;		// TRUE when recycle is enabled (set by RECYCLE func)
 TVAR REBSER	*GC_Protect;	// A stack of protected series (removed by pop)
 TVAR REBSER	*GC_Series;		// An array of protected series (removed by address)
+TVAR REBSER *GC_Mark_Queue; // An array of series to be marked (to avoid deep recursion in GC)
 TVAR REBSER	**GC_Infants;	// A small list of last N series created (nursery)
 TVAR REBINT	GC_Last_Infant;	// Index to last infant above (circular)
 TVAR REBFLG GC_Stay_Dirty;  // Do not free memory, fill it with 0xBB

src/include/sys-value.h

@@ -520,6 +520,13 @@ enum {
 #define	CHECK_MARK(s,d) if (!IS_MARK_SERIES(s)) Mark_Series(s, d);
 #endif
 
+// Using the mark queue only if we are deep enough
+#define	QUEUE_CHECK_MARK(s,d) \
+		if (!IS_MARK_SERIES(s)) {\
+			if (depth >= 64) Mark_Series(s, d); \
+			else Queue_Mark_Series(s);\
+		}
+
 //#define LABEL_SERIES(s,l) s->label = (l)
 #define IS_BLOCK_SERIES(s) (SERIES_WIDE(s) == sizeof(REBVAL))
 

src/tests/units/crash-test.r3

@@ -232,6 +232,7 @@ foreach [n s] system/schemes [
 	;@@ https://github.com/Oldes/Rebol-issues/issues/767
 	--assert same? :greater? copy :greater? ;-no crash
 
+if system/version > 3.17.0 [
 --test-- "recursive bind"
 	;@@ https://github.com/Oldes/Rebol-issues/issues/2278
 	obj: make object! [x: 10]
@@ -244,7 +245,12 @@ foreach [n s] system/schemes [
 		10 == get blk/2/1
 		10 == get blk/2/2/1
 	]
-
+--test-- "deep recursion recycle crash"
+	;@@ https://github.com/Oldes/Rebol-issues/issues/2278
+	blk: copy [] loop 200000 [blk: append/only copy [] blk]
+	--assert block? blk
+	blk: none recycle
+]
 ===end-group===
 
 ~~~end-file~~~