fix indirect gc when first Heap cell is not collected

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@199 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

C/dbase.c

@@ -3798,18 +3798,23 @@ p_init_queue(void)
   db_queue *dbq;
   Term t;
 
-  while ((dbq = (db_queue *)AllocDBSpace(sizeof(db_queue))) == NULL) {
+  if (DBQueuesCache) {
-    if (!growheap(FALSE)) {
+    dbq = DBQueuesCache;
-      Abort("[ SYSTEM ERROR: YAP failed to reserve space in growheap ]\n");
+    DBQueuesCache = dbq->next;
-      return(FALSE);
+  } else {
+    while ((dbq = (db_queue *)AllocDBSpace(sizeof(db_queue))) == NULL) {
+      if (!growheap(FALSE)) {
+	Abort("[ SYSTEM ERROR: YAP failed to reserve space in growheap ]\n");
+	return(FALSE);
+      }
     }
+    dbq->id = FunctorDBRef;
+    dbq->EntryTerm = MkAtomTerm(AbsAtom((AtomEntry *)dbq));
+    dbq->Flags = DBClMask;
+    dbq->FirstInQueue = dbq->LastInQueue = NULL;
+    dbq->next = DBQueues;
+    dbq->prev = NULL;
   }
-  dbq->id = FunctorDBRef;
-  dbq->EntryTerm = MkAtomTerm(AbsAtom((AtomEntry *)dbq));
-  dbq->Flags = DBClMask;
-  dbq->FirstInQueue = dbq->LastInQueue = NULL;
-  dbq->next = DBQueues;
-  dbq->prev = NULL;
   DBQueues = dbq;
   dbq->age = IntOfTerm(GetValue(AtomCatch));
   INIT_RWLOCK(dbq->QRWLock);
@@ -3899,8 +3904,9 @@ p_dequeue(void)
       father_key->prev->next = father_key->next;
     if (father_key->next != NULL)
       father_key->next->prev = father_key->prev;
+    father_key->next = DBQueuesCache;
+    DBQueuesCache = father_key;
     WRITE_UNLOCK(father_key->QRWLock);
-    FreeDBSpace((char *) father_key);
     return(FALSE);
   } else {
     Term TDB;

C/heapgc.c

@@ -567,7 +567,7 @@ init_dbtable(tr_fr_ptr trail_ptr) {
 #ifdef DEBUG
 
 #define INSTRUMENT_GC 1
-/*#define CHECK_CHOICEPOINTS 1 */
+/* #define CHECK_CHOICEPOINTS 1  */
 
 #ifdef INSTRUMENT_GC
 typedef enum {
@@ -803,7 +803,7 @@ mark_variable(CELL_PTR current)
       goto begin;
     }
 #ifdef DEBUG
-    else if (next < (CELL *)AtomBase)
+    else if (next < (CELL *)AtomBase || next < (CELL *)HeapTop)
       YP_fprintf(YP_stderr, "ooops while marking %lx, %p at %p\n", (unsigned long int)ccur, current, next);
 #endif
 #ifdef INSTRUMENT_GC
@@ -1325,7 +1325,10 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR)
 	if (pe == NULL) {
 	  YP_fprintf(YP_stderr,"B  %p (%s) with %d\n", gc_B, op_names[opnum], total_marked);
 	} else
-	  YP_fprintf(YP_stderr,"B  %p (%s for %s/%d) with %d,%d\n", gc_B, op_names[opnum], RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, gc_B->cp_h-H0, total_marked);
+	  if (pe->ArityOfPE)
+	    YP_fprintf(YP_stderr,"B  %p (%s for %s/%d) with %d,%d\n", gc_B, op_names[opnum], RepAtom(NameOfFunctor(pe->FunctorOfPred))->StrOfAE, pe->ArityOfPE, gc_B->cp_h-H0, total_marked);
+	  else
+	    YP_fprintf(YP_stderr,"B  %p (%s for %s) with %d,%d\n", gc_B, op_names[opnum], RepAtom(pe->FunctorOfPred)->StrOfAE, gc_B->cp_h-H0, total_marked);
       }
     }
 #endif /* CHECK_CHOICEPOINTS */
@@ -2301,6 +2304,15 @@ adjust_cp_hbs(void)
     } else while (TRUE) {
       CELL_PTR *nxt = nbase+(top-nbase)/2;
       if (nxt[0] > gc_H) {
+	if (nbase == top) {
+	  if (nbase == base) {
+	    gc_B->cp_h = H0;
+	    break;
+	  } else {
+	    Error(SYSTEM_ERROR,TermNil,"Bug in Garbage collector");
+	    return;
+	  }
+	}
 	top = nxt;
       } else if (nxt[0] < gc_H && nxt[1] < gc_H) {
 	nbase = nxt+1;

C/init.c

@@ -862,6 +862,7 @@ InitCodes(void)
   heap_regs->primitives_module = 0;
   heap_regs->user_module = 1;
   heap_regs->db_queues = NULL;
+  heap_regs->db_queues_cache = NULL;
   heap_regs->atom_abol = LookupAtom("$abol");
   AtomAltNot = LookupAtom("not");
   heap_regs->atom_append = LookupAtom ("append");

C/save.c

@@ -950,10 +950,15 @@ restore_codes(void)
     heap_regs->dead_clauses = (Clause *)
       AddrAdjust((ADDR)(heap_regs->dead_clauses));
   }
+  /* vsc: FIXME !!!!! */
   if (heap_regs->db_queues != NULL) {
     heap_regs->db_queues = (struct idb_queue *)
       AddrAdjust((ADDR)(heap_regs->db_queues));
   }
+  if (heap_regs->db_queues_cache != NULL) {
+    heap_regs->db_queues_cache = (struct idb_queue *)
+      AddrAdjust((ADDR)(heap_regs->db_queues_cache));
+  }
   heap_regs->retry_recorded_code = 
     PtoOpAdjust(heap_regs->retry_recorded_code);
   heap_regs->retry_recorded_k_code =

C/tracer.c

@@ -130,7 +130,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
   extern int gc_calls;
 
   vsc_count++;
-  if (vsc_count < 56514000) return;
+  if (vsc_count < 369599) return;
   /* if (vsc_count > 500000) exit(0); */
   /* if (gc_calls < 1) return;*/
   YP_fprintf(YP_stderr,"%lu ", vsc_count);

H/Heap.h

@@ -10,7 +10,7 @@
 * File:		Heap.h         						 *
 * mods:									 *
 * comments:	Heap Init Structure					 *
-* version:      $Id: Heap.h,v 1.13 2001-11-15 00:01:40 vsc Exp $	 *
+* version:      $Id: Heap.h,v 1.14 2001-11-26 12:33:05 vsc Exp $	 *
 *************************************************************************/
 
 /* information that can be stored in Code Space */
@@ -143,7 +143,7 @@ typedef struct various_codes {
 #endif
   int   primitives_module;
   int   user_module;
-  struct idb_queue *db_queues;
+  struct idb_queue *db_queues, *db_queues_cache;
   Atom
     atom_abol,
     atom_alarm,
@@ -333,6 +333,7 @@ typedef struct various_codes {
 #define  PrimitivesModule         heap_regs->primitives_module
 #define  UserModule               heap_regs->user_module
 #define  DBQueues                 heap_regs->db_queues
+#define  DBQueuesCache            heap_regs->db_queues_cache
 #define  NoOfModules              heap_regs->no_of_modules
 #define  AtomAbol                 heap_regs->atom_abol
 #define  AtomAlarm                heap_regs->atom_alarm