fix nasty variable shunting bug in garbage collector :-(:wq

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

C/absmi.c

@@ -10,8 +10,12 @@
 *									 *
 * File:		absmi.c							 *
 * comments:	Portable abstract machine interpreter                    *
-* Last rev:     $Date: 2006-03-24 17:13:41 $,$Author: rslopes $						 *
+* Last rev:     $Date: 2006-03-30 01:11:09 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.197  2006/03/24 17:13:41  rslopes
+* New update to BEAM engine.
+* BEAM now uses YAP Indexing (JITI)
+*
 * Revision 1.196  2006/03/03 23:10:47  vsc
 * fix MacOSX interrupt handling
 * fix using Yap files as Yap scripts.
@@ -6865,7 +6869,7 @@ Yap_absmi(int inp)
       BOp(call_cpred, sla);
      
 
-      if (!(PREG->u.sla.sla_u.p->PredFlags & ( SafePredFlag|HiddenPredFlag))) {
+      if (!(PREG->u.sla.sla_u.p->PredFlags & (SafePredFlag|HiddenPredFlag))) {
 	CACHE_Y_AS_ENV(YREG);
 	check_stack(NoStackCall, H);
 	ENDCACHE_Y_AS_ENV();

C/heapgc.c

@@ -424,7 +424,7 @@ push_registers(Int num_regs, yamop *nextop)
       for (i=0; i < arity; i++) {
 	Term tlive  = sal->ValueOfVE.lterms[i].tlive;
 	if (!IsVarTerm(tlive) || !IsUnboundVar(&sal->ValueOfVE.lterms[i].tlive)) {
-	    TrailTerm(TR++) = tlive;
+	  TrailTerm(TR++) = tlive;
 	}
       }
     }
@@ -1747,10 +1747,6 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
   dep_fr_ptr depfr = LOCAL_top_dep_fr;
 #endif /* TABLING */
 
-#ifdef EASY_SHUNTING
-  HB = H;
-#endif
-
 #ifdef TABLING
   if (depfr != NULL && gc_B >= DepFr_cons_cp(depfr)) {
     gc_B = DepFr_cons_cp(depfr);
@@ -3407,6 +3403,8 @@ marking_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max)
 #ifdef EASY_SHUNTING
   sTR0 = (tr_fr_ptr)db_vec;
   sTR = (tr_fr_ptr)db_vec;
+  /* make sure we set HB before we do any variable shunting!!! */
+  HB = H;
 #else
   cont_top0 = (cont *)db_vec;
 #endif
@@ -3806,12 +3804,6 @@ call_gc(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop)
   Int    effectiveness = 0;
   int    gc_on = FALSE;
 
-#if defined(YAPOR) || defined(THREADS)
-  if (NOfThreads != 1) {
-    Yap_Error(SYSTEM_ERROR,TermNil,"cannot perform garbage collection: more than a worker/thread running");
-    return(FALSE);
-  }
-#endif
   if (Yap_GetValue(AtomGc) != TermNil)
     gc_on = TRUE;
   if (IsIntegerTerm(Tgc_margin = Yap_GetValue(AtomGcMargin)) &&

C/tracer.c

@@ -38,6 +38,8 @@ TracePutchar(int sno, int ch)
 static void
 send_tracer_message(char *start, char *name, Int arity, char *mname, CELL *args)
 {
+  UInt omax_depth, omax_list, omax_write_args;
+
   if (name == NULL) {
 #ifdef  YAPOR
     fprintf(Yap_stderr, "(%d)%s", worker_id, start);
@@ -59,7 +61,16 @@ send_tracer_message(char *start, char *name, Int arity, char *mname, CELL *args)
       /* Yap_Portray_delays = TRUE; */
 #endif
 #endif
-      Yap_plwrite(args[i], TracePutchar, Handle_vars_f);
+  omax_depth = max_depth;
+  omax_list = max_list;
+  omax_write_args = max_write_args;
+  max_depth = 5;
+  max_list = 5;
+  max_write_args = 5;
+  Yap_plwrite(args[i], TracePutchar, Handle_vars_f);
+  max_depth = omax_depth;
+  max_list = omax_list;
+  max_write_args = omax_write_args;
 #if DEBUG
 #if COROUTINING
       Yap_Portray_delays = FALSE;
@@ -126,8 +137,6 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
 
   sc = Yap_heap_regs;
   vsc_count++;
-  if (vsc_count < 183400)
-    return;
 #ifdef COMMENTED
   //  if (vsc_count == 218280)
   //    vsc_xstop = 1;

C/utilpreds.c

@@ -766,6 +766,9 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter
     /* do or pt2 are unbound  */
     *ptd0 = TermNil;
     /* leave an empty slot to fill in later */
+    if (H+1024 > ASP) {
+      goto global_overflow;
+    }
     H[1] = AbsPair(H+2);
     H += 2;
     H[-2] = (CELL)ptd0;
@@ -802,79 +805,110 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter
   } else {
     return(inp);
   }
+ global_overflow:
+  clean_tr(TR0);
+  Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
+  H = InitialH;
+  return 0L;
+  
 }
  
 static Int 
 p_variables_in_term(void)	/* variables in term t		 */
 {
-  Term t = Deref(ARG1);
   Term out;
 
-  if (IsVarTerm(t)) {
+  do {
-    out = AbsPair(H);
+    Term t = Deref(ARG1);
-    H += 2;
+    if (IsVarTerm(t)) {
-    RESET_VARIABLE(H-2);
+      out = AbsPair(H);
-    RESET_VARIABLE(H-1);
+      H += 2;
-    Yap_unify((CELL)(H-2),ARG1);
+      RESET_VARIABLE(H-2);
-    Yap_unify((CELL)(H-1),ARG2);
+      RESET_VARIABLE(H-1);
-  }  else if (IsPrimitiveTerm(t)) 
+      Yap_unify((CELL)(H-2),ARG1);
-    out = ARG2;
+      Yap_unify((CELL)(H-1),ARG2);
-  else if (IsPairTerm(t)) {
+    }  else if (IsPrimitiveTerm(t)) 
-    out = vars_in_complex_term(RepPair(t)-1,
+      out = ARG2;
-			       RepPair(t)+1, ARG2);
+    else if (IsPairTerm(t)) {
-  }
+      out = vars_in_complex_term(RepPair(t)-1,
-  else {
+				 RepPair(t)+1, ARG2);
-    Functor f = FunctorOfTerm(t);
+    }
-    out = vars_in_complex_term(RepAppl(t),
+    else {
-			       RepAppl(t)+
+      Functor f = FunctorOfTerm(t);
-			       ArityOfFunctor(f), ARG2);
+      out = vars_in_complex_term(RepAppl(t),
-  }
+				 RepAppl(t)+
+				 ArityOfFunctor(f), ARG2);
+    }
+    if (out == 0L) {
+      if (!Yap_gc(3, ENV, P)) {
+	Yap_Error(OUT_OF_STACK_ERROR, TermNil, "in term_variables");
+	return FALSE;
+      }
+    }
+  } while (out == 0L);
   return(Yap_unify(ARG3,out));
 }
 
 static Int 
 p_term_variables(void)	/* variables in term t		 */
 {
-  Term t = Deref(ARG1);
   Term out;
 
-  if (IsVarTerm(t)) {
+  do {
-    return Yap_unify(MkPairTerm(t,TermNil), ARG2);
+    Term t = Deref(ARG1);
-  }  else if (IsPrimitiveTerm(t)) {
+    if (IsVarTerm(t)) {
-    return Yap_unify(TermNil, ARG2);
+      return Yap_unify(MkPairTerm(t,TermNil), ARG2);
-  } else if (IsPairTerm(t)) {
+    }  else if (IsPrimitiveTerm(t)) {
-    out = vars_in_complex_term(RepPair(t)-1,
+      return Yap_unify(TermNil, ARG2);
-			       RepPair(t)+1, TermNil);
+    } else if (IsPairTerm(t)) {
-  }
+      out = vars_in_complex_term(RepPair(t)-1,
-  else {
+				 RepPair(t)+1, TermNil);
-    Functor f = FunctorOfTerm(t);
+    }
-    out = vars_in_complex_term(RepAppl(t),
+    else {
-			       RepAppl(t)+
+      Functor f = FunctorOfTerm(t);
-			       ArityOfFunctor(f), TermNil);
+      out = vars_in_complex_term(RepAppl(t),
-  }
+				 RepAppl(t)+
+				 ArityOfFunctor(f), TermNil);
+    }
+    if (out == 0L) {
+      if (!Yap_gc(2, ENV, P)) {
+	Yap_Error(OUT_OF_STACK_ERROR, TermNil, "in term_variables");
+	return FALSE;
+      }
+    }
+  } while (out == 0L);
   return Yap_unify(ARG2,out);
 }
 
 static Int 
 p_term_variables3(void)	/* variables in term t		 */
 {
-  Term t = Deref(ARG1);
   Term out;
 
-  if (IsVarTerm(t)) {
+  do {
-    return Yap_unify(MkPairTerm(t,ARG3), ARG2);
+    Term t = Deref(ARG1);
-  }  else if (IsPrimitiveTerm(t)) {
+    if (IsVarTerm(t)) {
-    return Yap_unify(ARG2, ARG3);
+      return Yap_unify(MkPairTerm(t,ARG3), ARG2);
-  } else if (IsPairTerm(t)) {
+    }  else if (IsPrimitiveTerm(t)) {
-    out = vars_in_complex_term(RepPair(t)-1,
+      return Yap_unify(ARG2, ARG3);
-			       RepPair(t)+1, ARG3);
+    } else if (IsPairTerm(t)) {
-  }
+      out = vars_in_complex_term(RepPair(t)-1,
-  else {
+				 RepPair(t)+1, ARG3);
-    Functor f = FunctorOfTerm(t);
+    }
-    out = vars_in_complex_term(RepAppl(t),
+    else {
-			       RepAppl(t)+
+      Functor f = FunctorOfTerm(t);
-			       ArityOfFunctor(f), ARG3);
+      out = vars_in_complex_term(RepAppl(t),
-  }
+				 RepAppl(t)+
+				 ArityOfFunctor(f), ARG3);
+    }
+    if (out == 0L) {
+      if (!Yap_gc(3, ENV, P)) {
+	Yap_Error(OUT_OF_STACK_ERROR, TermNil, "in term_variables");
+	return FALSE;
+      }
+    }
+  } while (out == 0L);
+
   return Yap_unify(ARG2,out);
 }
 
@@ -1942,11 +1976,11 @@ void Yap_InitUtilCPreds(void)
   Yap_InitCPred("copy_term", 2, p_copy_term, 0);
   Yap_InitCPred("copy_term_nat", 2, p_copy_term_no_delays, 0);
   Yap_InitCPred("ground", 1, p_ground, SafePredFlag);
-  Yap_InitCPred("$variables_in_term", 3, p_variables_in_term, SafePredFlag|HiddenPredFlag);
+  Yap_InitCPred("$variables_in_term", 3, p_variables_in_term, HiddenPredFlag);
   Yap_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, SafePredFlag|HiddenPredFlag);
   CurrentModule = TERMS_MODULE;
-  Yap_InitCPred("term_variables", 2, p_term_variables, SafePredFlag);
+  Yap_InitCPred("term_variables", 2, p_term_variables, 0);
-  Yap_InitCPred("term_variables", 3, p_term_variables3, SafePredFlag);
+  Yap_InitCPred("term_variables", 3, p_term_variables3, 0);
   Yap_InitCPred("variable_in_term", 2, p_var_in_term, SafePredFlag);
   Yap_InitCPred("term_hash", 4, GvNTermHash, SafePredFlag);
   Yap_InitCPred("variant", 2, p_variant, 0);

H/Heap.h

@@ -10,7 +10,7 @@
 * File:		Heap.h         						 *
 * mods:									 *
 * comments:	Heap Init Structure					 *
-* version:      $Id: Heap.h,v 1.93 2006-03-22 20:07:28 vsc Exp $	 *
+* version:      $Id: Heap.h,v 1.94 2006-03-30 01:11:10 vsc Exp $	 *
 *************************************************************************/
 
 /* information that can be stored in Code Space */
@@ -792,10 +792,10 @@ struct various_codes *Yap_heap_regs;
 #define  AttsMutableList          Yap_heap_regs->wl[worker_id].atts_mutable_list
 #endif
 /* support for generations with backtracking */
+#define  GcCalls                  Yap_heap_regs->wl[worker_id].gc_calls
 #define  GcGeneration             Yap_heap_regs->wl[worker_id].gc_generation
 #define  GcPhase                  Yap_heap_regs->wl[worker_id].gc_phase
 #define  GcCurrentPhase           Yap_heap_regs->wl[worker_id].gc_current_phase
-#define  GcCalls                  Yap_heap_regs->wl[worker_id].gc_calls
 #define  TotGcTime                Yap_heap_regs->wl[worker_id].tot_gc_time
 #define  TotGcRecovered           Yap_heap_regs->wl[worker_id].tot_gc_recovered
 #define  total_marked             Yap_heap_regs->wl[worker_id].tot_marked

changes-5.1.html

@@ -16,6 +16,9 @@
 
 <h2>Yap-5.1.0:</h2>
 <ul>
+<li> FIXED: variable shunting needs HB initialised before any marking
+takes place!!!</li>
+<li> FIXED: handle possible overflow in term_variables</li>
 <li> FIXED: check for singleton warnings in .yap files, try to catch
 bugs before they bite people.</li>
 <li> FIXED: make threads compile again, fix some compilation warnings.</li>

pl/boot.yap

@@ -15,6 +15,28 @@
 *									 *
 *************************************************************************/
 
+tomic_concat(X,Y,At) :-
+	(
+	  nonvar(X),  nonvar(Y)
+	->
+	  atomic_concat([X,Y],At)
+	;
+	  atom(At) ->
+	  atom_length(At,Len),
+	  '$atom_contact_split'(At,0,Len,X,Y)
+	;
+	  number(At) ->
+	  number_codes(At,Codes),
+	  '$append'(X0,Y0,Codes),
+	  name(X,X0),
+	  name(Y,Y0)
+	;
+	  var(At) ->
+	  '$do_error'(instantiation_error,atomic_concat(X,Y,At))
+	;
+	  '$do_error'(type_error(atomic,At),atomic_concant(X,Y,At))
+	).
+
 % This one should come first so that disjunctions and long distance
 % cuts are compiled right with co-routining.
 %