Add RECYCLE/VERBOSE to Debug build

This is an experimental basic way of getting some information about
the nodes which are being garbage collected.  Using a manually
allocated array from before the recycle is run, it gathers the
nodes expected to be freed.  The nodes are then PROBE'd one at a time,
and then the actual recycling process is performed.

The code for filling the "sweeplist" array is separated from the
actual sweeping code, to avoid slowing it down with debug tests.

(Includes a minor fix to VARARGS! on expired frames, an added test
in ASSERT_CONTEXT(), and removal of the recursion-causing PROBE()
when panic'ing on a series)

Author: hostilefork

src/core/b-init.c

@@ -1602,7 +1602,7 @@ void Shutdown_Core(void)
         &= (~NODE_FLAG_ROOT);
     AS_SERIES(CTX_VARLIST(TG_Task_Context))->header.bits
         &= (~NODE_FLAG_ROOT);
-    Recycle_Core(TRUE);
+    Recycle_Core(TRUE, NULL);
 
     Shutdown_Ports();
     Shutdown_Event_Scheme();

src/core/c-context.c

@@ -1380,6 +1380,17 @@ void Assert_Context_Core(REBCTX *c)
         //
         if (!IS_FRAME(rootvar))
             panic (rootvar);
+
+        REBFRM *f = CTX_FRAME_IF_ON_STACK(c);
+        if (f != NULL) {
+            REBFUN *rootkey_fun = VAL_FUNC(rootkey);
+            REBFUN *frame_fun = f->underlying; // should match
+
+            if (rootkey_fun != frame_fun) {
+                printf("FRAME! context function doesn't match its REBFRM");
+                panic (frame_fun);
+            }
+        }
     }
     else if (IS_BLANK(rootkey)) {
         //

src/core/d-crash.c

@@ -199,7 +199,15 @@ ATTRIBUTE_NO_RETURN void Panic_Core(
     case GUESSED_AS_SERIES: {
         REBSER *s = m_cast(REBSER*, cast(const REBSER*, p)); // don't mutate
     #if !defined(NDEBUG)
-        PROBE(s);
+        #if 0
+            //
+            // It can sometimes be useful to probe here if the series is
+            // valid, but if it's not valid then that could result in a
+            // recursive call to panic and a stack overflow.
+            //
+            PROBE(s);
+        #endif
+
         Panic_Series_Debug(cast(REBSER*, s));
     #else
         strncat(buf, "valid series", PANIC_BUF_SIZE - strlen(buf));

src/core/m-gc.c

@@ -1299,12 +1299,69 @@ static REBCNT Sweep_Series(void)
 }
 
 
+#if !defined(NDEBUG)
+
+//
+//  Fill_Sweeplist: C
+//
+REBCNT Fill_Sweeplist(REBSER *sweeplist)
+{
+    assert(SER_WIDE(sweeplist) == sizeof(REBNOD*));
+    assert(SER_LEN(sweeplist) == 0);
+
+    REBCNT count = 0;
+
+    REBSEG *seg;
+    for (seg = Mem_Pools[SER_POOL].segs; seg != NULL; seg = seg->next) {
+        REBSER *s = cast(REBSER*, seg + 1);
+        REBCNT n;
+        for (n = Mem_Pools[SER_POOL].units; n > 0; --n, ++s) {
+            switch (LEFT_N_BITS(s->header.bits, 4)) {
+            case 9: // 0x8 + 0x1
+                assert(IS_SERIES_MANAGED(s));
+                if (Is_Rebser_Marked(s))
+                    Unmark_Rebser(s);
+                else {
+                    EXPAND_SERIES_TAIL(sweeplist, 1); 
+                    *SER_AT(REBNOD*, sweeplist, count) = cast(REBNOD*, s);
+                    ++count;
+                }
+                break;
+
+            case 11: // 0x8 + 0x2 + 0x1
+                //
+                // It's a cell which is managed where the key is not an END.
+                // This is a managed pairing, so mark bit should be heeded.
+                //
+                // !!! It is a REBNOD, but *not* a "series".
+                //
+                assert(IS_SERIES_MANAGED(s));
+                if (Is_Rebser_Marked(s))
+                    Unmark_Rebser(s);
+                else {
+                    EXPAND_SERIES_TAIL(sweeplist, 1); 
+                    *SER_AT(REBNOD*, sweeplist, count) = cast(REBNOD*, s);
+                    ++count;
+                }
+                break;
+            }
+        }
+    }
+
+    return count;
+}
+
+#endif
+
+
 //
 //  Recycle_Core: C
 //
-// Recycle memory no longer needed.
+// Recycle memory no longer needed.  If sweeplist is not NULL, then it needs
+// to be a series whose width is sizeof(REBSER*), and it will be filled with
+// the list of series that *would* be recycled.
 //
-REBCNT Recycle_Core(REBOOL shutdown)
+REBCNT Recycle_Core(REBOOL shutdown, REBSER *sweeplist)
 {
     // Ordinarily, it should not be possible to spawn a recycle during a
     // recycle.  But when debug code is added into the recycling code, it
@@ -1384,12 +1441,27 @@ REBCNT Recycle_Core(REBOOL shutdown)
 
     REBCNT count = 0;
 
-    count += Sweep_Series();
-    count += Sweep_Gobs();
+    if (sweeplist != NULL) {
+    #if defined(NDEBUG)
+        panic (sweeplist);
+    #else
+        count += Fill_Sweeplist(sweeplist);
+    #endif
+    }
+    else
+        count += Sweep_Series();
+
+    // !!! The intent is for GOB! to be unified in the REBNOD pattern, the
+    // way that the FFI structures were.  So they are not included in the
+    // count, in order to help make the numbers returned consistent between
+    // when the sweeplist is used and not.
+    //
+    Sweep_Gobs();
 
 #if !defined(NDEBUG)
     // Compute new stats:
-    PG_Reb_Stats->Recycle_Series = Mem_Pools[SER_POOL].free - PG_Reb_Stats->Recycle_Series;
+    PG_Reb_Stats->Recycle_Series
+        = Mem_Pools[SER_POOL].free - PG_Reb_Stats->Recycle_Series;
     PG_Reb_Stats->Recycle_Series_Total += PG_Reb_Stats->Recycle_Series;
     PG_Reb_Stats->Recycle_Prior_Eval = Eval_Cycles;
 #endif
@@ -1448,7 +1520,7 @@ REBCNT Recycle(void)
 {
     // Default to not passing the `shutdown` flag.
     //
-    REBCNT n = Recycle_Core(FALSE);
+    REBCNT n = Recycle_Core(FALSE, NULL);
 
 #ifdef DOUBLE_RECYCLE_TEST
     //
@@ -1457,7 +1529,7 @@ REBCNT Recycle(void)
     // shouldn't crash.)  This is an expensive check, but helpful to try if
     // it seems a GC left things in a bad state that crashed a later GC.
     //
-    REBCNT n2 = Recycle_Core(FALSE);
+    REBCNT n2 = Recycle_Core(FALSE, NULL);
     assert(n2 == 0);
 #endif
 

src/core/n-system.c

@@ -124,6 +124,8 @@ REBNATIVE(exit_rebol)
 //      size [integer!]
 //      /torture
 //          "Constant recycle (for internal debugging)"
+//      /verbose
+//          "Dump out information about series being recycled"
 //  ]
 //
 REBNATIVE(recycle)
@@ -153,7 +155,32 @@ REBNATIVE(recycle)
     if (GC_Disabled)
         return R_VOID; // don't give back misleading "0", since no recycle ran
 
-    REBCNT count = Recycle();
+    REBCNT count;
+
+    if (REF(verbose)) {
+    #if defined(NDEBUG)
+        fail (Error(RE_DEBUG_ONLY));
+    #else
+        REBSER *sweeplist = Make_Series(100, sizeof(REBNOD*), MKS_NONE);
+        count = Recycle_Core(FALSE, sweeplist);
+        assert(count == SER_LEN(sweeplist));
+
+        REBCNT index = 0;
+        for (index = 0; index < count; ++index) {
+            REBNOD *node = *SER_AT(REBNOD*, sweeplist, index);
+            PROBE(node);
+        }
+
+        Free_Series(sweeplist);
+        
+        REBCNT recount = Recycle_Core(FALSE, NULL);
+        assert(recount == count); 
+    #endif
+    }
+    else {
+        count = Recycle();
+    }
+
     SET_INTEGER(D_OUT, count);
     return R_OUT;
 }

src/core/t-varargs.c

@@ -557,7 +557,6 @@ void Mold_Varargs(const REBVAL *v, REB_MOLD *mold) {
         REBFRM *f = CTX_FRAME_IF_ON_STACK(context);
 
         if (f == NULL) {
-            assert(GET_SER_FLAG(CTX_VARLIST(context), CONTEXT_FLAG_STACK));
             Append_Unencoded(mold->series, "**unavailable: call ended **");
         }
         else {