fix memory expansion bugs.

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

C/absmi.c

@@ -10,8 +10,11 @@
 *									 *
 * File:		absmi.c							 *
 * comments:	Portable abstract machine interpreter                    *
-* Last rev:     $Date: 2007-01-24 09:57:25 $,$Author: vsc $						 *
+* Last rev:     $Date: 2007-03-21 18:32:49 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.219  2007/01/24 09:57:25  vsc
+* fix glist_void_varx
+*
 * Revision 1.218  2006/12/31 01:50:34  vsc
 * fix some bugs in call_cleanup: the result of action should not matter,
 * and !,fail would not wakeup the delayed goal.
@@ -731,7 +734,7 @@ Yap_absmi(int inp)
 	ASP = YREG+E_CB;
       }
       saveregs();
-      if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L, FALSE)) {
+      if(!Yap_growtrail (0, FALSE)) {
 	Yap_Error(OUT_OF_TRAIL_ERROR,TermNil,"YAP failed to reserve %ld bytes in growtrail",sizeof(CELL) * 16 * 1024L);
 	setregs();
 	FAIL();
@@ -2747,32 +2750,38 @@ Yap_absmi(int inp)
 	 so I don't need to redo it.
        */ 
     NoStackDeallocate:
-      if (ActiveSignals & YAP_CREEP_SIGNAL) {
+      {
-	GONext();
+	CELL cut_b = LCL0-(CELL *)(SREG[E_CB]);
-      }
+
-      ASP = YREG;
+	if (ActiveSignals & YAP_CREEP_SIGNAL) {
-      /* cut_e */
+	  GONext();
-      if (SREG <= ASP) {
-	ASP = SREG-EnvSizeInCells;
-      }
-      if (ActiveSignals & YAP_CDOVF_SIGNAL) {
-	goto noheapleft;
-      }
-      if (ActiveSignals) {
-	if (Yap_op_from_opcode(PREG->opc) == _cut_e) {
-	  /* followed by a cut */
-	  ARG1 = MkIntegerTerm(LCL0-(CELL *)SREG[E_CB]);
-	  SREG = (CELL *)RepPredProp(Yap_GetPredPropByFunc(FunctorCutBy,1));
-	} else {
-	  SREG = (CELL *)RepPredProp(Yap_GetPredPropByAtom(AtomTrue,0));
 	}
-	goto creep;
+	ASP = YREG;
+	/* cut_e */
+	if (SREG <= ASP) {
+	  ASP = SREG-EnvSizeInCells;
+	}
+	if (ActiveSignals & YAP_CDOVF_SIGNAL) {
+	  goto noheapleft;
+	}
+	if (ActiveSignals) {
+	  if (Yap_op_from_opcode(PREG->opc) == _cut_e) {
+	    /* followed by a cut */
+	    ARG1 = MkIntegerTerm(LCL0-(CELL *)SREG[E_CB]);
+	    SREG = (CELL *)RepPredProp(Yap_GetPredPropByFunc(FunctorCutBy,1));
+	  } else {
+	    SREG = (CELL *)RepPredProp(Yap_GetPredPropByAtom(AtomTrue,0));
+	  }
+	  goto creep;
+	}
+	saveregs();
+	if (!Yap_gc(0, ENV, CPREG)) {
+	  Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage);
+	}
+	setregs();
+	SREG = ASP;
+	SREG[E_CB] = (CELL)(LCL0-cut_b);
       }
-      saveregs();
-      if (!Yap_gc(0, ENV, CPREG)) {
-	Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage);
-      }
-      setregs();
       JMPNext();
 
 #ifdef COROUTINING
@@ -13537,7 +13546,7 @@ Yap_absmi(int inp)
 	  S = SREG;
 #endif
 	  saveregs_and_ycache();
-	  if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L, FALSE)) {
+	  if(!Yap_growtrail (0, FALSE)) {
 	    Yap_Error(OUT_OF_TRAIL_ERROR,TermNil,"YAP failed to reserve %ld bytes in growtrail",sizeof(CELL) * 16 * 1024L);
 	    setregs_and_ycache();
 	    FAIL();

C/agc.c

@@ -411,6 +411,7 @@ atom_gc(void)
   
 
   UInt		time_start, agc_time;
+  return;
   if (Yap_GetValue(AtomGcTrace) != TermNil)
     gc_trace = 1;
   agc_calls++;

C/grow.c

@@ -1399,8 +1399,13 @@ static int do_growtrail(long size, int contiguous_only, int in_parser, tr_fr_ptr
     return FALSE;
 #endif
   /* at least 64K for trail */
+  if (!size)
+    size = ((ADDR)TR-Yap_TrailBase);
+  size *= 2;
   if (size < 64*1024)
     size = 64*1024;
+  if (size > 2048*1024)
+    size = 2048*1024;
   /* adjust to a multiple of 256) */
   size = AdjustPageSize(size);
   trail_overflows++;

C/heapgc.c

@@ -139,10 +139,25 @@ static rb_red_blk_node *db_root, *db_nil;
 /* support for hybrid garbage collection scheme */
 
 static void
-gc_growtrail(int committed)
+gc_growtrail(int committed, tr_fr_ptr begsTR, cont *old_cont_top0)
 {
-  if (!Yap_growtrail(64 * 1024L, TRUE)) {
+  UInt sz = Yap_TrailTop-(ADDR)OldTR;
-    TR = OldTR;
+  /* ask for double the size */
+  sz = 2*sz;
+  
+  if (!Yap_growtrail(sz, TRUE)) {
+#ifdef EASY_SHUNTING
+    if (begsTR) {
+      sTR = (tr_fr_ptr)old_cont_top0;
+      while (begsTR != NULL) {
+	tr_fr_ptr newsTR = (tr_fr_ptr)TrailTerm(begsTR);
+	TrailTerm(sTR) = TrailTerm(begsTR+1);
+	TrailTerm(sTR+1) = TrailTerm(begsTR+2);
+	begsTR = newsTR;
+	sTR += 2;
+      } 
+    }
+#endif
     /* could not find more trail */
     save_machine_regs();
     longjmp(Yap_gc_restore, 2);
@@ -155,7 +170,7 @@ PUSH_CONTINUATION(CELL *v, int nof) {
   x = cont_top;
   x++;
   if ((ADDR)x > Yap_TrailTop-1024) {
-    gc_growtrail(TRUE);
+    gc_growtrail(TRUE, NULL, NULL);
   }
   x->v = v;
   x->nof = nof;
@@ -318,7 +333,7 @@ GC_ALLOC_NEW_MASPACE(void)
 {
   gc_ma_hash_entry *new = gc_ma_h_top;
   if ((char *)gc_ma_h_top > Yap_TrailTop-1024)
-    gc_growtrail(FALSE);
+    gc_growtrail(FALSE, NULL, NULL);
   gc_ma_h_top++;
   cont_top = (cont *)gc_ma_h_top;
 #ifdef EASY_SHUNTING
@@ -563,7 +578,7 @@ RBMalloc(UInt size)
 
   db_vec += size; 
   if ((ADDR)db_vec > Yap_TrailTop-1024) {
-    gc_growtrail(FALSE);
+    gc_growtrail(FALSE, NULL, NULL);
   }
   return (rb_red_blk_node *)new;
 }
@@ -1618,7 +1633,7 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
           CELL *cptr = (CELL *)trail_cell;
 
 	  if ((ADDR)nsTR > Yap_TrailTop-1024) {
-	    gc_growtrail(TRUE);
+	    gc_growtrail(TRUE, begsTR, old_cont_top0);
 	  }
 	  TrailTerm(nsTR) = (CELL)NULL;
 	  TrailTerm(nsTR+1) = *hp;
@@ -3508,23 +3523,12 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
   Int           effectiveness, tot;
   int           gc_trace;
   UInt		gc_phase;
+  UInt		alloc_sz;
 
   heap_cells = H-H0;
   gc_verbose = is_gc_verbose();
   effectiveness = 0;
   gc_trace = FALSE;
-#if COROUTINING
-  max = (CELL *)DelayTop();
-  while (max - (CELL*)Yap_GlobalBase < 1024+(2*NUM_OF_ATTS)) {
-    if (!Yap_growglobal(&current_env)) {
-      Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
-      return -1;
-    }
-    max = (CELL *)DelayTop();
-  }
-#else
-  max = NULL;
-#endif
 #ifdef INSTRUMENT_GC
   {
     int i;
@@ -3574,36 +3578,35 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
   }
 #endif
   time_start = Yap_cputime();
-  total_marked = 0;
-  total_oldies = 0;
-#ifdef COROUTING
-  total_smarked = 0;
-#endif
-  discard_trail_entries = 0;
-  {
-    UInt alloc_sz = (CELL *)Yap_TrailTop-(CELL*)Yap_GlobalBase;
-    Yap_bp = Yap_PreAllocCodeSpace();
-    while (Yap_bp+alloc_sz > (char *)AuxSp) {
-      /* not enough space */
-      *--ASP = (CELL)current_env;
-      Yap_bp = (char *)Yap_ExpandPreAllocCodeSpace(alloc_sz, NULL);
-      if (!Yap_bp)
-	return -1;
-      current_env = (CELL *)*ASP;
-      ASP++;
 #if COROUTINING
-      max = (CELL *)DelayTop();
+  max = (CELL *)DelayTop();
-#endif
+  while (max - (CELL*)Yap_GlobalBase < 1024+(2*NUM_OF_ATTS)) {
+    if (!Yap_growglobal(&current_env)) {
+      Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
+      return -1;
     }
-    memset((void *)Yap_bp, 0, alloc_sz);
+    max = (CELL *)DelayTop();
   }
+#else
+  max = NULL;
+#endif
   if (setjmp(Yap_gc_restore) == 2) {
+    UInt sz;
+
     /* we cannot recover, fail system */
     restore_machine_regs();    
-    *--ASP = (CELL)current_env;
+    sz = Yap_TrailTop-(ADDR)OldTR;
+    fprintf(stderr,"sz=%d\n",sz);
+    /* ask for double the size */
+    sz = 2*sz;
     TR = OldTR;
+  
+    *--ASP = (CELL)current_env;
+#ifdef EASY_SHUNTING
+    set_conditionals(sTR);
+#endif
     if (
-	!Yap_growtrail(64 * 1024L, FALSE)
+	!Yap_growtrail(sz, FALSE)
 	) {
       Yap_Error(OUT_OF_TRAIL_ERROR,TermNil,"out of %lB during gc", 64*1024L);
       return -1;
@@ -3617,15 +3620,37 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
       current_env = (CELL *)*ASP;
       ASP++;
 #if COROUTINING
-      max = (CELL *)DelayTop();
+    max = (CELL *)DelayTop();
 #endif
     }
   }
+  total_marked = 0;
+  total_oldies = 0;
+#ifdef COROUTING
+  total_smarked = 0;
+#endif
+  discard_trail_entries = 0;
+  alloc_sz = (CELL *)Yap_TrailTop-(CELL*)Yap_GlobalBase;
+  Yap_bp = Yap_PreAllocCodeSpace();
+  while (Yap_bp+alloc_sz > (char *)AuxSp) {
+    /* not enough space */
+    *--ASP = (CELL)current_env;
+    Yap_bp = (char *)Yap_ExpandPreAllocCodeSpace(alloc_sz, NULL);
+    if (!Yap_bp)
+      return -1;
+    current_env = (CELL *)*ASP;
+    ASP++;
+#if COROUTINING
+    max = (CELL *)DelayTop();
+#endif
+  }
+  memset((void *)Yap_bp, 0, alloc_sz);
 #ifdef HYBRID_SCHEME
   iptop = (CELL_PTR *)H;
 #endif
   /* get the number of active registers */
   HGEN = H0+IntegerOfTerm(Yap_ReadTimedVar(GcGeneration));
+
   gc_phase = (UInt)IntegerOfTerm(Yap_ReadTimedVar(GcPhase));
   /* old HGEN are not very reliable, but still may have data to recover */
   if (gc_phase != GcCurrentPhase) {
@@ -3634,6 +3659,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
   /*  fprintf(stderr,"HGEN is %ld, %p, %p/%p\n", IntegerOfTerm(Yap_ReadTimedVar(GcGeneration)), HGEN, H,H0);*/
   OldTR = (tr_fr_ptr)(old_TR = TR);
   push_registers(predarity, nextop);
+  /* make sure we clean bits after a reset */
   marking_phase(old_TR, current_env, nextop, max);
   if (total_oldies > ((HGEN-H0)*8)/10) {
     total_marked -= total_oldies;
@@ -3767,10 +3793,11 @@ call_gc(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop)
   if (gc_margin < gc_lim)
     gc_margin = gc_lim;
   GcCalls++;
+  HGEN = H0+IntegerOfTerm(Yap_ReadTimedVar(GcGeneration));
   if (gc_on && !(Yap_PrologMode & InErrorMode) &&
       /* make sure there is a point in collecting the heap */
       (ASP-H0)*sizeof(CELL) > gc_lim &&
-      H-H0 > (LCL0-ASP)/2) {
+      H-HGEN > (LCL0-ASP)/2) {
     effectiveness = do_gc(predarity, current_env, nextop);
     if (effectiveness < 0)
       return FALSE;

changes-5.1.html

@@ -16,6 +16,9 @@
 
 <h2>Yap-5.1.2:</h2>
 <ul>
+<li> FIXED: memory expansion in deallocate would lose cut pointer.</li>
+<li> FIXED: make growtrail do more than grow chunks of 64KB.</li>
+<li> FIXED: growtrail was broken if called while doing variable shunting.</li>
 <li> FIXED: by default,allow defining infix+prefix/posfix instead of
 using standard ISO.</li>
 <li> FIXED: nb_current was unimplemented (obs from Pablo Beltran).</li>