locate_references added for debugging perposes

Rev: src/gc.c:1.28

src/gc.c

@@ -378,21 +378,43 @@ INT32 gc_check(void *a)
   return getmark(a)->refs++;
 }
 
-int gc_is_referenced(void *a)
+static void init_gc(void)
 {
-  struct marker *m;
-  m=getmark(a);
-#ifdef DEBUG
-  if(m->refs + m->xrefs > *(INT32 *)a)
+  INT32 tmp3;
+  /* init hash , hashsize will be a prime between num_objects/8 and
+   * num_objects/4, this will assure that no re-hashing is needed.
+   */
+  tmp3=my_log2(num_objects);
+
+  if(!d_flag) tmp3-=2;
+  if(tmp3<0) tmp3=0;
+  if(tmp3>=(long)NELEM(hashprimes)) tmp3=NELEM(hashprimes)-1;
+  hashsize=hashprimes[tmp3];
+
+  hash=(struct marker **)xalloc(sizeof(struct marker **)*hashsize);
+  MEMSET((char *)hash,0,sizeof(struct marker **)*hashsize);
+  markers_left_in_chunk=0;
+}
+
+static void exit_gc(void)
 {
-    INT32 refs=m->refs;
-    INT32 xrefs=m->xrefs;
-    TYPE_T t=attempt_to_identify(a);
+  struct marker_chunk *m;
+  /* Free hash table */
+  free((char *)hash);
+  while((m=chunk))
+  {
+    chunk=m->next;
+    free((char *)m);
+  }
+}
 
-    fprintf(stderr,"**Something has %ld references, while gc() found %ld + %ld external.\n",(long)*(INT32 *)a,(long)refs,(long)xrefs);
-    describe_something(a, t);
+void locate_references(void *a)
+{
+  if(!in_gc)
+    init_gc();
   
   fprintf(stderr,"**Looking for references:\n");
+  
   check_for=a;
   
   found_where=" in an array";
@@ -416,6 +438,26 @@ int gc_is_referenced(void *a)
   found_where="";
   check_for=0;
   
+  if(!in_gc)
+    exit_gc();
+}
+
+int gc_is_referenced(void *a)
+{
+  struct marker *m;
+  m=getmark(a);
+#ifdef DEBUG
+  if(m->refs + m->xrefs > *(INT32 *)a)
+  {
+    INT32 refs=m->refs;
+    INT32 xrefs=m->xrefs;
+    TYPE_T t=attempt_to_identify(a);
+
+    fprintf(stderr,"**Something has %ld references, while gc() found %ld + %ld external.\n",(long)*(INT32 *)a,(long)refs,(long)xrefs);
+    describe_something(a, t);
+
+    locate_references(a);
+
     fatal("Ref counts are wrong (has %d, found %d + %d external)\n",
 	  *(INT32 *)a,
 	  refs,
@@ -474,8 +516,7 @@ int gc_do_free(void *a)
 void do_gc(void)
 {
   double tmp;
-  INT32 tmp2,tmp3;
-  struct marker_chunk *m;
+  INT32 tmp2;
   double multiplier;
 
   if(in_gc) return;
@@ -507,19 +548,7 @@ void do_gc(void)
   objects_freed += (double) num_objects;
 
 
-  /* init hash , hashsize will be a prime between num_objects/8 and
-   * num_objects/4, this will assure that no re-hashing is needed.
-   */
-  tmp3=my_log2(num_objects);
-
-  if(!d_flag) tmp3-=2;
-  if(tmp3<0) tmp3=0;
-  if(tmp3>=(long)NELEM(hashprimes)) tmp3=NELEM(hashprimes)-1;
-  hashsize=hashprimes[tmp3];
-
-  hash=(struct marker **)xalloc(sizeof(struct marker **)*hashsize);
-  MEMSET((char *)hash,0,sizeof(struct marker **)*hashsize);
-  markers_left_in_chunk=0;
+  init_gc();
 
   /* First we count internal references */
   gc_check_all_arrays();
@@ -546,14 +575,7 @@ void do_gc(void)
   gc_free_all_unreferenced_programs();
   gc_free_all_unreferenced_objects();
 
-
-  /* Free hash table */
-  free((char *)hash);
-  while((m=chunk))
-  {
-    chunk=m->next;
-    free((char *)m);
-  }
+  exit_gc();
 
   destruct_objects_to_destruct();