another GC backtrace repair

Special treatment of a "prefix" in a closure needs special
backtrace support.

racket/src/racket/gc2/gc2.h

@@ -571,6 +571,11 @@ GC2_EXTERN void GC_report_unsent_message_delta(intptr_t amt);
  is within a factor of 2 or so.
  */
 
+GC2_EXTERN void GC_set_backpointer_object(void *p);
+/*
+ Registers the current object for backpointers, which is used when backtrace
+ support is enabled.
+*/
 
 # ifdef __cplusplus
 };

racket/src/racket/gc2/newgc.c

@@ -2156,6 +2156,13 @@ static void *get_backtrace(mpage *page, void *ptr, int *kind)
 
 #define three_arg_no_op(a, b, c) /* */
 
+void GC_set_backpointer_object(void *p)
+{
+#ifdef MZ_GC_BACKTRACE
+  set_backtrace_source(GC_get_GC(), p, PAGE_TAGGED);
+#endif
+}
+
 /*****************************************************************************/
 /* Routines dealing with various runtime execution stacks                    */
 /*                                                                           */

racket/src/racket/src/eval.c

@@ -5816,6 +5816,9 @@ static void mark_pruned_prefixes(struct NewGC *gc) XFORM_SKIP_PROC
           use_bits[i] = 0;
         }
         /* Should mark/copy pf, but not trigger or require mark propagation: */
+#ifdef MZ_GC_BACKTRACE
+        GC_set_backpointer_object(pf->backpointer);
+#endif
         gcMARK(pf);
         pf = (Scheme_Prefix *)GC_resolve2(pf, gc);
         GC_retract_only_mark_stack_entry(pf, gc);

racket/src/racket/src/mzclpf_post.inc

@@ -23,6 +23,9 @@
            all other marking: */
         pf->next_final = scheme_prefix_finalize;
         scheme_prefix_finalize = pf;
+#ifdef MZ_GC_BACKTRACE
+        pf->backpointer = (Scheme_Object *)c;
+#endif
       }
       mark_stxes = 0;
 

racket/src/racket/src/schpriv.h

@@ -2360,6 +2360,9 @@ typedef struct Scheme_Prefix
   Scheme_Object so; /* scheme_prefix_type */
   int num_slots, num_toplevels, num_stxes;
   struct Scheme_Prefix *next_final; /* for special GC handling */
+#ifdef MZ_GC_BACKTRACE
+  Scheme_Object *backpointer;
+#endif
   Scheme_Object *a[mzFLEX_ARRAY_DECL]; /* array of objects */
   /* followed by an array of `int's for tl_map uses */
 } Scheme_Prefix;