allow coroutining plus tabling, this means fixing some trouble with the

gc and a bug in global variable handling.


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

C/absmi.c

@@ -10,8 +10,11 @@
 *									 *
 * File:		absmi.c							 *
 * comments:	Portable abstract machine interpreter                    *
-* Last rev:     $Date: 2006-12-27 01:32:37 $,$Author: vsc $						 *
+* Last rev:     $Date: 2006-12-29 01:57:50 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.215  2006/12/27 01:32:37  vsc
+* diverse fixes
+*
 * Revision 1.214  2006/11/28 00:46:28  vsc
 * fix bug in threaded implementation
 *
@@ -507,7 +510,6 @@ char *Yap_op_names[_std_top + 1] =
 
 #endif
 
-
 Int 
 Yap_absmi(int inp)
 {
@@ -2086,6 +2088,7 @@ Yap_absmi(int inp)
 #ifdef FROZEN_STACKS
         {
 	  tr_fr_ptr pt0, pt1, pbase;
+
 	  pbase = B->cp_tr;
 	  pt0 = pt1 = TR - 1;
 	  while (pt1 >= pbase) {

C/globals.c

@@ -148,7 +148,7 @@ NewDelayArena(UInt size)
   UInt howmuch;
 
   while ((ADDR)min < Yap_GlobalBase+1024) {
-    if ((howmuch = Yap_InsertInGlobal((CELL *)max, size*sizeof(attvar_record))==0)) {
+    if ((howmuch = Yap_InsertInGlobal((CELL *)max, size*sizeof(attvar_record)))==0) {
       Yap_Error(OUT_OF_STACK_ERROR,TermNil,"No Stack Space for Non-Backtrackable terms");
       return TermNil;
     }

C/heapgc.c

@@ -126,7 +126,7 @@ static cont *cont_top;
 
 static gc_ma_hash_entry gc_ma_hash_table[GC_MAVARS_HASH_SIZE];
 
-static gc_ma_hash_entry *gc_ma_h_top;
+static gc_ma_hash_entry *gc_ma_h_top, *gc_ma_h_list;
 
 static UInt gc_timestamp;    /* an unsigned int */
 
@@ -337,6 +337,11 @@ gc_lookup_ma_var(CELL *addr, tr_fr_ptr trp) {
   if (gc_ma_hash_table[i].timestmp != gc_timestamp) {
     gc_ma_hash_table[i].timestmp = gc_timestamp;
     gc_ma_hash_table[i].addr = addr;
+#if TABLING
+    gc_ma_hash_table[i].loc = trp;
+    gc_ma_hash_table[i].more = gc_ma_h_list;
+    gc_ma_h_list = gc_ma_hash_table+i;
+#endif
     gc_ma_hash_table[i].next = NULL;
     return NULL;
   }
@@ -344,6 +349,13 @@ gc_lookup_ma_var(CELL *addr, tr_fr_ptr trp) {
   while (nptr) {
     optr = nptr;
     if (nptr->addr == addr) {
+#if TABLING
+      /*
+	we're moving from oldest to more recent, so only a new entry
+	has the correct new value
+      */
+      TrailVal(nptr->loc+1) = TrailVal(trp+1);
+#endif      
       return nptr;
     }
     nptr = nptr->next;
@@ -351,13 +363,20 @@ gc_lookup_ma_var(CELL *addr, tr_fr_ptr trp) {
   nptr = GC_ALLOC_NEW_MASPACE();
   optr->next = nptr;
   nptr->addr = addr;
+#if TABLING
+  nptr->loc = trp;
+#endif
   nptr->next = NULL;
+  nptr->more = gc_ma_h_list;
+  gc_ma_h_list = nptr;
   return NULL;
 }
 
 static inline void
 GC_NEW_MAHASH(gc_ma_hash_entry *top) {
   UInt time = ++gc_timestamp;
+
+  gc_ma_h_list = NULL;
   if (time == 0) {
     unsigned int i;
 
@@ -1651,11 +1670,10 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
 	  mark_external_reference(&(TrailTerm(trail_base)));
 	  /* reset the gc to believe the original tag */
 	  TrailTerm(trail_base) = AbsAppl((CELL *)TrailTerm(trail_base));
-#ifdef TABLING
-	  mark_external_reference(&(TrailVal(trail_base)));
-#endif
 	}
-#ifndef TABLING
+#ifdef TABLING
+	mark_external_reference(&(TrailVal(trail_base)));
+#else
 	trail_base++;
 	mark_external_reference(&(TrailTerm(trail_base)));
 #endif
@@ -1666,9 +1684,6 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
 	  mark_external_reference(&(TrailTerm(trail_base)));
 	  /* reset the gc to believe the original tag */
 	  TrailTerm(trail_base) = AbsAppl((CELL *)TrailTerm(trail_base));
-#ifdef TABLING
-	  mark_external_reference(&(TrailVal(trail_base)));
-#endif
 	} 
       } else {
       remove_trash_entry:
@@ -1695,6 +1710,19 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
 #endif
     trail_base++;
   }
+#if TABLING
+  /* 
+     Ugly, but needed: we're not really sure about what were the new
+     values until the very end
+  */
+  {
+   gc_ma_hash_entry *gl = gc_ma_h_list;
+   while (gl) {
+     mark_external_reference(&(TrailVal(gl->loc+1)));
+     gl = gl->more;
+   }
+ }
+#endif
 #ifdef EASY_SHUNTING
   sTR = (tr_fr_ptr)old_cont_top0;
   while (begsTR != NULL) {
@@ -2373,6 +2401,8 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR)
 	Int marked_val_ptr = MARKED_PTR(&TrailVal(trail_ptr+1));
 
 	TrailTerm(dest+1) = TrailTerm(dest) = trail_cell;
+	TrailVal(dest) = old;
+	TrailVal(dest+1) = old1;
 	if (marked_ptr) {
 	  UNMARK(&TrailTerm(dest));
 	  UNMARK(&TrailTerm(dest+1));

C/tracer.c

@@ -160,7 +160,6 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
 
   LOCK(Yap_heap_regs->low_level_trace_lock);
   sc = Yap_heap_regs;
-  vsc_count++;
 #ifdef COMMENTED
   if (vsc_count > 1388060LL && vsc_count < 1388070LL) {
     if (vsc_count==1388061LL)

H/Heap.h

@@ -10,7 +10,7 @@
 * File:		Heap.h         						 *
 * mods:									 *
 * comments:	Heap Init Structure					 *
-* version:      $Id: Heap.h,v 1.111 2006-12-27 01:32:37 vsc Exp $	 *
+* version:      $Id: Heap.h,v 1.112 2006-12-29 01:57:50 vsc Exp $	 *
 *************************************************************************/
 
 /* information that can be stored in Code Space */
@@ -46,6 +46,10 @@ typedef struct memory_hole {
 
 typedef struct gc_ma_hash_entry_struct {
   UInt timestmp;
+#if TABLING
+  tr_fr_ptr loc;
+  struct gc_ma_hash_entry_struct *more;
+#endif
   CELL* addr;
   struct gc_ma_hash_entry_struct *next;
 } gc_ma_hash_entry;
@@ -153,6 +157,7 @@ typedef struct worker_local_struct {
   int disc_trail_entries;
   gc_ma_hash_entry Gc_ma_hash_table[GC_MAVARS_HASH_SIZE];
   gc_ma_hash_entry *Gc_ma_h_top;
+  gc_ma_hash_entry *Gc_ma_h_list;
   UInt Gc_timestamp;    /* an unsigned int */
   ADDR  DB_vec, DB_vec0;
   struct RB_red_blk_node *DB_root, *DB_nil;
@@ -847,6 +852,7 @@ struct various_codes *Yap_heap_regs;
 #endif /* GC_NO_TAGS */
 #define  gc_ma_hash_table         Yap_heap_regs->wl[worker_id].Gc_ma_hash_table
 #define  gc_ma_h_top              Yap_heap_regs->wl[worker_id].Gc_ma_h_top
+#define  gc_ma_h_list             Yap_heap_regs->wl[worker_id].Gc_ma_h_list
 #define  gc_timestamp             Yap_heap_regs->wl[worker_id].Gc_timestamp
 #define  cont_top0                Yap_heap_regs->wl[worker_id].conttop0
 #define  db_vec                   Yap_heap_regs->wl[worker_id].DB_vec

changes-5.1.html

@@ -16,6 +16,8 @@
 
 <h2>Yap-5.1.2:</h2>
 <ul>
+<li> FIXED: garbage collector would not understand bindings to mavars in
+tabling version.</li> 
 <li> FIXED: cut might not prune correctly around meta-call (obs by
 Trevor Walker).</li> 
 <li> NEW: keep history around (use nb and friends).</li> 

configure

@@ -848,9 +848,9 @@ Optional Features:
  --enable-cut-c             support for executing c code when a cut occurs
  --enable-tabling           support tabling
  --enable-or-parallelism    support or-parallelism as: env-copy,sba,a-cow
- --enable-depth-limit       support depth-bound computation
  --enable-rational-trees    support infinite rational trees
  --enable-coroutining       support co-routining, attributed variables and constraints
+ --enable-depth-limit       support depth-bound computation
  --enable-wam-profile       support low level profiling of abstract machine
  --enable-low-level-tracer  support support for procedure-call tracing
  --enable-threads           support system threads
@@ -2283,16 +2283,6 @@ if test "${enable_or_parallelism+set}" = set; then
 else
   orparallelism=no
 fi;
-if test "$tabling" = yes -o "$orparallelism" = yes -o "$threads" = yes
-then
-# Check whether --enable-depth-limit or --disable-depth-limit was given.
-if test "${enable_depth_limit+set}" = set; then
-  enableval="$enable_depth_limit"
-  depthlimit="$enableval"
-else
-  depthlimit=no
-fi;
-else
 # Check whether --enable-rational-trees or --disable-rational-trees was given.
 if test "${enable_rational_trees+set}" = set; then
   enableval="$enable_rational_trees"
@@ -2314,7 +2304,6 @@ if test "${enable_depth_limit+set}" = set; then
 else
   depthlimit=yes
 fi;
-fi
 # Check whether --enable-wam-profile or --disable-wam-profile was given.
 if test "${enable_wam_profile+set}" = set; then
   enableval="$enable_wam_profile"

configure.in

@@ -24,12 +24,6 @@ AC_ARG_ENABLE(tabling,
 AC_ARG_ENABLE(or-parallelism,
 	[ --enable-or-parallelism    support or-parallelism as: env-copy,sba,a-cow ],
 	orparallelism="$enableval", orparallelism=no)
-if test "$tabling" = yes -o "$orparallelism" = yes -o "$threads" = yes
-then
-AC_ARG_ENABLE(depth-limit,
-	[ --enable-depth-limit       support depth-bound computation ],
-	depthlimit="$enableval", depthlimit=no)
-else
 AC_ARG_ENABLE(rational-trees,
 	[ --enable-rational-trees    support infinite rational trees ],
 	rationaltrees="$enableval" , rationaltrees=yes)
@@ -39,7 +33,6 @@ AC_ARG_ENABLE(coroutining,
 AC_ARG_ENABLE(depth-limit,
 	[ --enable-depth-limit       support depth-bound computation ],
 	depthlimit="$enableval", depthlimit=yes)
-fi
 AC_ARG_ENABLE(wam-profile,
 	[ --enable-wam-profile       support low level profiling of abstract machine ],
 	wamprofile="$enableval", wamprofile=no)

pl/utils.yap

@@ -166,6 +166,29 @@ call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) :- atom(A), !,
 call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10) :- 
 	'$do_error'(type_error(atom,A),call_with_args(A,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10)).
 	
+/*
+	
+call_cleanup(Goal, Catcher, Cleanup) :-
+	catch('$call_cleanup'(Goal,Catcher,Cleanup),
+	      Exception,
+	      '$cleanup_exception'(Exception,Catcher,Cleanup)).
+
+'$cleanup_exception'(Exception, exception(Exception), Cleanup) :-
+	call(cleanup).
+
+'$call_cleanup'(Goal,Catcher,Cleanup) :-
+	yap_hacks:current_choice_point(CP0),
+	call(Goal),
+	yap_hacks:current_choice_point(CPF),
+	( CP0 =:= CPF ->
+	    Catcher = exit,
+	    call(Cleanup)
+	;
+	    true
+	).
+'$call_cleanup'(Goal,fail,Cleanup) :-
+	call(Cleanup).
+*/    
 
 op(P,T,V) :- var(P), !,
 	'$do_error'(instantiation_error,op(P,T,V)).
@@ -465,7 +488,7 @@ unknown(V0,V) :-
 
 % Only efective if yap compiled with -DDEBUG
 % this predicate shows the code produced by the compiler
-'$show_code' :- '$debug'(0'f).
+'$show_code' :- '$debug'(0'f). %' just make emacs happy
 
 grow_heap(X) :- '$grow_heap'(X).
 grow_stack(X) :- '$grow_stack'(X).