more upgrades to new coroutining code.

C/attvar.c

@@ -79,7 +79,6 @@ BuildNewAttVar(void)
   RESET_VARIABLE(&(newv->Value));
   RESET_VARIABLE(&(newv->Done));
   RESET_VARIABLE(&(newv->Atts));
-  HB = PROTECT_FROZEN_H(B);
   return newv;
 }
 
@@ -104,7 +103,6 @@ CopyAttVar(CELL *orig, struct cp_frame **to_visit_ptr, CELL *res)
     to_visit->to = &(newv->Atts);
   }
   to_visit->oldv = vt[-1];
-  /* you're coming from a variable */
   to_visit->ground = FALSE;
   *to_visit_ptr = to_visit+1;
   *res = (CELL)&(newv->Done);
@@ -879,10 +877,75 @@ p_swi_all_atts(void) {
   }
 }
 
+
+static Term
+AllAttVars(void) {
+  CELL *pt = H0;
+  CELL *myH = H;
+  
+  while (pt < H) {
+    switch(*pt) {
+    case (CELL)FunctorAttVar:
+      if (IsUnboundVar(pt+1)) {
+	if (ASP - myH < 1024) {
+	  Yap_Error_Size = (ASP-H)*sizeof(CELL);
+	  return 0L;
+	}
+	if (myH != H) {
+	  myH[-1] = AbsPair(myH);
+	}
+	myH[0] = AbsAttVar((attvar_record *)pt);
+	myH += 2;
+      }
+      pt += (1+ATT_RECORD_ARITY);
+      break;
+    case (CELL)FunctorDouble:
+#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
+      pt += 4;
+#else
+      pt += 3;
+#endif
+      break;
+    case (CELL)FunctorBigInt:
+      {
+	Int sz = 3 +
+	  (sizeof(MP_INT)+
+	   (((MP_INT *)(pt+2))->_mp_alloc*sizeof(mp_limb_t)))/sizeof(CELL);
+	pt += sz;
+      }
+      break;
+    case (CELL)FunctorLongInt:
+      pt += 3;
+      break;
+    default:
+      pt++;
+    }
+  }
+  if (myH != H) {
+    Term out = AbsPair(H);
+    myH[-1] = TermNil;
+    H = myH;
+    return out;
+  } else {
+    return TermNil;
+  }
+}
+  
 static Int
 p_all_attvars(void)
 {
-  return Yap_unify(ARG1,TermNil);
+  do {
+    Term out;
+
+    if (!(out = AllAttVars())) {
+      if (!Yap_gcl(Yap_Error_Size, 1, ENV, gc_P(P,CP))) {
+	Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
+	return FALSE;
+      }    
+    } else {
+      return Yap_unify(ARG1,out);
+    }
+  } while (TRUE);
 }
 
 static Int

C/heapgc.c

@@ -1150,6 +1150,33 @@ check_global(void) {
 
 /* mark a heap object and all heap objects accessible from it */
 
+static void
+mark_variable(CELL_PTR current);
+
+static void
+mark_att_var(CELL *hp)
+{
+  if (!MARKED_PTR(hp-1)) {
+    MARK(hp-1);
+    PUSH_POINTER(hp-1);
+    total_marked++;
+    if (hp < HGEN) {
+      total_oldies++;
+    }
+  }
+  if (!MARKED_PTR(hp)) {
+    MARK(hp);
+    PUSH_POINTER(hp);
+    total_marked++;
+    if (hp < HGEN) {
+      total_oldies++;
+    }
+  }
+  mark_variable(hp+1);
+  mark_variable(hp+2);
+}
+
+
 static void 
 mark_variable(CELL_PTR current)
 {
@@ -1173,7 +1200,10 @@ mark_variable(CELL_PTR current)
   next = GET_NEXT(ccur);
 
   if (IsVarTerm(ccur)) {
-    if (ONHEAP(next)) {
+    if (IsAttVar(current) && current==next) {
+      mark_att_var(current);
+      POP_CONTINUATION();
+    } else if (ONHEAP(next)) {
 #ifdef EASY_SHUNTING
       CELL cnext;
       /* do variable shunting between variables in the global */
@@ -1576,18 +1606,6 @@ mark_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap)
   }
 }
 
-static void
-mark_att_var(CELL *hp)
-{
-  attvar_record *attv = RepAttVar(hp);
-  Functor *cptr = &(attv->AttFunc);
-  mark_external_reference2(CellPtr(cptr));
-  mark_external_reference2(&attv->Done);
-  mark_external_reference2(&attv->Value);
-  mark_external_reference2(&attv->Atts);
-}
-
-
 /* 
    Cleaning the trail should be quick and simple, right? Well, not
    really :-(. The problem is that the trail includes a dumping ground

C/utilpreds.c

@@ -69,8 +69,11 @@ clean_dirty_tr(tr_fr_ptr TR0) {
 	RESET_VARIABLE(p);
       } else {
 	/* copy downwards */
+#ifdef FROZEN_STACKS
+#else
 	TrailTerm(TR0+1) = TrailTerm(pt);
 	TrailTerm(TR0) = TrailTerm(TR0+2) = p;
+#endif
 	pt+=2;
 	TR0 += 3;
       }
@@ -89,7 +92,7 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
   tr_fr_ptr TR0 = TR;
   int ground = TRUE;
 #ifdef COROUTINING
-  CELL *dvars = NULL;
+  CELL *dvarsmin = NULL, *dvarsmax=NULL;
 #endif
 
   HB = HLow;
@@ -251,32 +254,25 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
 #if COROUTINING
       if (newattvs && IsAttachedTerm((CELL)ptd0)) {
 	/* if unbound, call the standard copy term routine */
-	struct cp_frame *bp[1];
+	struct cp_frame *bp;
 
-	if (dvars == NULL) {
+	if (IN_BETWEEN(dvarsmin, ptd0, dvarsmax)) {
-	  dvars = H0;
-	} 	
-	if (ptd0 < dvars) {
 	  *ptf++ = (CELL) ptd0;
 	} else {
-	  tr_fr_ptr CurTR;
+	  CELL new;
 
-	  CurTR = TR;
+	  bp = to_visit;
-	  bp[0] = to_visit;
+	  if (!attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, ptf)) {
-	  HB = HB0;
-	  if (!attas[ExtFromCell(ptd0)].copy_term_op(ptd0, bp, ptf)) {
 	    goto overflow;
 	  }
-	  to_visit = bp[0];
+	  to_visit = bp;
-	  HB = HLow;
+	  new = *ptf;
+	  Bind(ptd0, new);
+	  if (dvarsmin == NULL) {
+	    dvarsmin = CellPtr(new);
+	  }
+	  dvarsmax = CellPtr(new)+1;
 	  ptf++;
-	  if (TR > (tr_fr_ptr)Yap_TrailTop - 256) {
-	    /* Trail overflow */
-	    if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) {
-	      goto trail_overflow;
-	    }
-	  }
-	  Bind(ptd0, ptf[-1]);
 	}
       } else {
 #endif
@@ -288,8 +284,7 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
 	    goto trail_overflow;
 	  }
 	}
-	Bind(ptd0, (CELL)ptf);
+	Bind(ptd0, (CELL)ptf++);
-	ptf++;
 #ifdef COROUTINING
       }
 #endif
@@ -320,8 +315,8 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf,
   }
 
   /* restore our nice, friendly, term to its original state */
-  HB = HB0;
   clean_dirty_tr(TR0);
+  HB = HB0;
   return ground;
 
  overflow:
@@ -521,7 +516,7 @@ Yap_CopyTermNoShare(Term inp) {
 static Int 
 p_copy_term(void)		/* copy term t to a new instance  */
 {
-  Term t = CopyTerm(ARG1, 2, TRUE, TRUE); 
+v  Term t = CopyTerm(ARG1, 2, TRUE, TRUE); 
   if (t == 0L)
     return FALSE;
   /* be careful, there may be a stack shift here */

pl/corout.yap

@@ -37,27 +37,17 @@
 	   '$show_frozen_goals'(Level))).
 
 '$project_and_delayed_goals'(G,LGs) :-
-	'$att_vars'(G, LAV),
+	attributes:all_attvars(LAV),
 	LAV = [_|_], !,
 	% SICStus compatible step,
 	% just try to simplify store  by projecting constraints
 	% over query variables.
 	'$project_attributes'(LAV, G),
 	% now get a list of frozen goals.
-	'$att_vars'(G, NLAV),
+	attributes:all_attvars(NLAV),
 	'$get_goalist_from_attvars'(NLAV, LGs).
 '$project_and_delayed_goals'(_,[]).
 
-'$att_vars'(Term, LAV) :-
-	term_variables(Term, TVars),
-	'$select_atts'(TVars, LAV).
-
-'$select_atts'([], []).
-'$select_atts'(V.TVars, V.LAV) :-
-	attvar(V), !,
-	'$select_atts'(TVars, LAV).
-'$select_atts'(V.TVars, LAV) :-
-	'$select_atts'(TVars, LAV).
 
 %
 % wake_up_goal is called by the system whenever a suspended goal
@@ -563,8 +553,7 @@ frozen(V, LG) :-
 	'$fetch_same_done_goals'(G0, D0, LV, GF).
 
 
-/*
+call_residue_vars(Goal,Residue) :-
-call_residue_vars(Goal,Vars) :-
 	attributes:all_attvars(Vs0),
 	call(Goal),
 	attributes:all_attvars(Vs),
@@ -586,13 +575,50 @@ call_residue_vars(Goal,Vars) :-
 	;
 	  '$ord_remove'([V1|Vss], Vs0s, Residue)
 	).
-*/
 
 copy_term(Term, Copy, Goals) :-
 	term_variables(Term, TVars),
 	'$get_goalist_from_attvars'(TVars, Goals0),
 	copy_term_nat([Term|Goals0], [Copy|Goals]).
 
+call_residue(Goal,Residue) :-
+	var(Goal), !,
+	'$do_error'(instantiation_error,call_residue(Goal,Residue)).
+call_residue(Module:Goal,Residue) :-
+	atom(Module), !,
+	'$call_residue'(Goal,Module,Residue).
+call_residue(Goal,Residue) :-
+	'$current_module'(Module),
+	'$call_residue'(Goal,Module,Residue).
+
+'$call_residue'(Goal,Module,Residue) :-
+	'$read_svar_list'(OldAttsList),
+	copy_term_nat(Goal, NGoal),
+	( '$set_svar_list'(CurrentAttsList),
+	  '$system_catch'(NGoal,Module,Error,'$residue_catch_trap'(Error,OldAttsList)),
+	  '$project_and_delayed_goals'(NGoal,Residue0),
+	  '$add_vs_to_vlist'(Residue0, Residue),
+	  ( '$set_svar_list'(OldAttsList),
+	    copy_term_nat(NGoal+NResidue, Goal+Residue)
+	  ;
+	    '$set_svar_list'(CurrentAttsList), fail
+	  )
+	;
+          '$set_svar_list'(OldAttsList), fail
+        ).
+
+'$add_vs_to_vlist'([], []).
+'$add_vs_to_vlist'([G|Residue0], [Vs-G|Residue]) :-
+	term_variables(G, TVs),
+	'$pick_att_vars'(TVs, Vs),
+	'$add_vs_to_vlist'(Residue0, Residue).
+
+
+% make sure we set the suspended goal list to its previous state!
+'$residue_catch_trap'(Error,OldAttsList) :-
+	'$set_svar_list'(OldAttsList),
+	throw(Error).
+
 % make sure we have installed a SICStus like constraint solver.
 '$project_attributes'(_, _) :-
 	'$undefined'(modules_with_attributes(_),attributes), !.