store constraints in DB

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

C/absmi.c

@@ -1790,8 +1790,8 @@ absmi(int inp)
       /* find something to fool S */
       if (CFREG == Unsigned(LCL0) && ReadTimedVar(WokenGoals) != TermNil) {
 	SREG = (CELL *)RepPredProp(GetPredPropByFunc(MkFunctor(AtomRestoreRegs,2),0));
-	PREG = NEXTOP(PREG,x);
 	XREGS[0] = XREG(PREG->u.y.y);
+	PREG = NEXTOP(PREG,y);
 	goto creep_either;
       }
       /* don't do debugging and friends here */
@@ -1802,7 +1802,6 @@ absmi(int inp)
       /* find something to fool S */
       if (CFREG == Unsigned(LCL0) && ReadTimedVar(WokenGoals) != TermNil) {
 	SREG = (CELL *)RepPredProp(GetPredPropByFunc(MkFunctor(AtomRestoreRegs,2),0));
-	PREG = NEXTOP(PREG,x);
 #if USE_THREADED_CODE
 	if (PREG->opc == (OPCODE)OpAddress[_fcall])
 #else
@@ -1819,6 +1818,7 @@ absmi(int inp)
 	      ENDCACHE_Y_AS_ENV();
 	    }
 	XREGS[0] = XREG(PREG->u.x.x);
+	PREG = NEXTOP(PREG,x);
 	goto creep_either;
       }
       /* don't do debugging and friends here */

C/arith0.c

@@ -143,6 +143,16 @@ p_b(E_ARGS)
 #endif
 }
 
+static E_FUNC
+p_env(E_ARGS)
+{
+#if SBA
+  RINT((Int)YENV);
+#else
+  RINT(YENV - (CELL *)B);
+#endif
+}
+
 static E_FUNC
 p_globalsp(E_ARGS)
 {
@@ -178,6 +188,7 @@ static InitConstEntry InitConstTab[] = {
   {"local_sp", p_localsp},
   {"global_sp", p_globalsp},
   {"$last_choice_pt", p_b},
+  {"$env", p_env},
   {"stackfree", p_stackfree},
 };
 

C/attvar.c

@@ -31,6 +31,8 @@ static char SccsId[]="%W% %G%";
 #endif
 
 STATIC_PROTO(Term  InitVarTime, (void));
+STATIC_PROTO(Int   PutAtt, (attvar_record *,Int,Term));
+STATIC_PROTO(Int   BuildNewAttVar, (Term,Int,Term));
 
 static CELL *
 AddToQueue(attvar_record *attv)
@@ -137,6 +139,47 @@ CopyAttVar(CELL *orig, CELL ***to_visit_ptr, CELL *res)
   return(TRUE);
 }
 
+static Term
+AttVarToTerm(CELL *orig)
+{
+  register attvar_record *attv = (attvar_record *)orig;
+  Term list = TermNil;
+  int j;
+  for (j = 0; j < NUM_OF_ATTS; j++) {
+    Term t = attv->Atts[2*(NUM_OF_ATTS-j-1)+1];
+    if (IsVarTerm(t))
+      list = MkPairTerm(MkVarTerm(),list);
+    else
+      list = MkPairTerm(t,list);
+  }
+  return(list);
+}
+
+static int
+TermToAttVar(Term attvar, Term to)
+{
+  int i = 0;
+  int open = FALSE;
+  
+  while (IsPairTerm(attvar)) {
+    Term t = HeadOfTerm(attvar);
+    if (!IsVarTerm(t)) {
+      if (open) {
+	attvar_record *attv = (attvar_record *)VarOfTerm(Deref(to));
+	if (!PutAtt(attv, i, t))
+	  return(FALSE);
+      } else {
+	if (!BuildNewAttVar(to, i, t))
+	  return(FALSE);
+	open = TRUE;
+      }
+    }
+    i++;
+    attvar = TailOfTerm(attvar);
+  }
+  return(TRUE);
+}
+
 static void
 WakeAttVar(CELL* pt1, CELL reg2)
 {
@@ -578,6 +621,8 @@ void InitAttVarPreds(void)
 {
   attas[attvars_ext].bind_op = WakeAttVar;
   attas[attvars_ext].copy_term_op = CopyAttVar;
+  attas[attvars_ext].to_term_op = AttVarToTerm;
+  attas[attvars_ext].term_to_op = TermToAttVar;
 #ifndef FIXED_STACKS
   attas[attvars_ext].mark_op = mark_attvar;
 #endif

C/corout.c

@@ -342,6 +342,57 @@ CopySuspendedVar(CELL *orig, CELL ***to_visit_ptr, CELL *res)
   return(TRUE);
 }
 
+static Term
+mk_sus_var_list(sus_record *sr, sus_record *osr)
+{
+  if (sr == osr)
+    return(TermNil);
+  return(MkPairTerm(sr->SG, mk_sus_var_list(sr->NR, sr)));
+}
+
+static Term
+SuspendedVarToTerm(CELL *orig)
+{
+  register sus_tag *sreg = (sus_tag *)orig;
+
+  return(MkPairTerm(sreg->SG->SG, mk_sus_var_list(sreg->SG->NR, sreg->SG)));
+}
+
+static sus_record *
+terms_to_suspended_goals(Term gl)
+{
+  sus_record *gf;
+  gf = (sus_record *)H;
+  H += sizeof(sus_record)/sizeof(CELL);
+#ifdef MULTI_ASSIGNMENT_VARIABLES
+  gf->NS = UpdateSVarList(gf);
+#endif
+  gf->SG = HeadOfTerm(gl);
+  gl = TailOfTerm(gl);
+  if (gl == TermNil) {
+    gf->NR = (sus_record *)&(gf->NR);
+  } else {
+    gf->NR = terms_to_suspended_goals(gl);
+  }
+  return(gf);
+}
+
+static int
+TermToSuspendedVar(Term gs, Term var)
+{
+  register sus_tag *vs;
+  /* add a new suspension */
+  vs = (sus_tag *)ReadTimedVar(DelayedVars);
+  if (H0 - (CELL *)vs < 1024)
+    return(FALSE);
+  RESET_VARIABLE(&(vs->ActiveSus));
+  vs->sus_id = susp_ext;
+  vs->SG = terms_to_suspended_goals(gs);
+  unify(var,(CELL)&(vs->ActiveSus));
+  UpdateTimedVar(DelayedVars, (CELL)(vs+1));
+  return(TRUE);
+}
+
 
 #ifndef FIXED_STACKS
 
@@ -1155,6 +1206,8 @@ void InitCoroutPreds(void)
 
   attas[susp_ext].bind_op = Wake;
   attas[susp_ext].copy_term_op = CopySuspendedVar;
+  attas[susp_ext].to_term_op = SuspendedVarToTerm;
+  attas[susp_ext].term_to_op = TermToSuspendedVar;
 #ifndef FIXED_STACKS
   attas[susp_ext].mark_op = mark_suspended_goal;
 #endif /* FIXED_STACKS */

C/dbase.c

@@ -57,7 +57,6 @@ static char     SccsId[] = "%W% %G%";
 */
 
 
-
 #ifdef  KEEP_ENTRY_AGE
 #define DISCONNECT_OLD_ENTRIES 1
 #else
@@ -199,7 +198,11 @@ STATIC_PROTO(CELL *linkcells,(CELL *,Int));
 STATIC_PROTO(Int cmpclls,(CELL *,CELL *,Int));
 STATIC_PROTO(Prop FindDBProp,(AtomEntry *, int, unsigned int, SMALLUNSGN));
 STATIC_PROTO(CELL  CalcKey, (Term));
+#ifdef COROUTINING
+STATIC_PROTO(CELL  *MkDBTerm, (CELL *, CELL *, CELL *, CELL *, CELL *, CELL *,int *));
+#else
 STATIC_PROTO(CELL  *MkDBTerm, (CELL *, CELL *, CELL *, CELL *, CELL *, int *));
+#endif
 STATIC_PROTO(DBRef  CreateDBStruct, (Term, DBProp, int));
 STATIC_PROTO(DBRef  new_lu_index, (LogUpdDBProp));
 STATIC_PROTO(void   clean_lu_index, (DBRef));
@@ -450,7 +453,10 @@ CELL
 EvalMasks(register Term tm, CELL *keyp)
 {
 
-  if (IsApplTerm(tm)) {
+  if (IsVarTerm(tm)) {
+    *keyp = 0L;
+    return(0L);
+  } else if (IsApplTerm(tm)) {
     Functor         fun = FunctorOfTerm(tm);
 
     if (IsExtensionFunctor(fun)) {
@@ -583,6 +589,9 @@ typedef struct {
 static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
 		     register CELL *StoPoint,
 		     CELL *CodeMax, CELL *tbase,
+#ifdef COROUTINING
+		     CELL *attachmentsp,
+#endif
 		     int *vars_foundp)
 {
 
@@ -592,6 +601,10 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
   CELL **to_visit_base = to_visit;
   /* where we are going to add a new pair */
   int vars_found = 0;
+#ifdef COROUTINING
+  Term ConstraintsTerm = TermNil;
+  CELL *ConstraintsBottom = NULL;
+#endif
 
  loop:
   while (pt0 <= pt0_end) {
@@ -794,13 +807,14 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
     
     /* the code to dereference a  variable */
   deref_var:
-    if (!MARKED(d0))
+    if (!MARKED(d0)) {
-      {
+      if ( 
 #if SBA
-	if (d0 != 0) {
+	  d0 != 0
 #else
-	if (d0 != (CELL)ptd0) {
+	  d0 != (CELL)ptd0
 #endif
+	  ) {
 	ptd0 = (Term *) d0;
 	d0 = *ptd0;
 	goto restart; /* continue dereferencing */
@@ -822,7 +836,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
 	/* variables need to be offset at read time */
 	*ptd0 = (displacement | MBIT);
 #if SBA
-	/* the copy we keep will be an empty vaiable   */
+	/* the copy we keep will be an empty variable   */
 	*StoPoint++ = 0;
 #else
 #ifdef IDB_USE_MBIT
@@ -839,6 +853,30 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
 #endif
 	/* indicate we found variables */
 	vars_found++;
+#ifdef COROUTINING
+	if (IsAttachedTerm((CELL)ptd0)) {
+	  Term t[4];
+	  int sz = to_visit-to_visit_base;
+
+	  H = (CELL *)to_visit;
+	  /* store the constraint away for now */
+	  t[0] = (CELL)ptd0;
+	  t[1] = attas[ExtFromCell(ptd0)].to_term_op(ptd0);
+	  t[2] = MkIntegerTerm(ExtFromCell(ptd0));
+	  t[3] = TermNil;
+	  if (ConstraintsBottom == NULL) {
+	    ConstraintsTerm = MkApplTerm(FunctorClist, 4, t);
+	    ConstraintsBottom = RepAppl(ConstraintsTerm)+4;
+	  } else {
+	    Term new = MkApplTerm(FunctorClist, 4, t);
+	    *ConstraintsBottom = new;
+	    ConstraintsBottom = RepAppl(new)+4;
+	  }
+	  memcpy((void *)(H), (void *)(to_visit_base), sz*sizeof(CELL *));
+	  to_visit_base = (CELL **)H;
+	  to_visit = to_visit_base+sz;
+	}
+#endif
 	continue;
       } else  {
 	/* references need to be offset at read time */
@@ -861,7 +899,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
   }
 
   /* Do we still have compound terms to visit */
-  if (to_visit > (CELL **)to_visit_base) {
+  if (to_visit > to_visit_base) {
 #ifdef RATIONAL_TREES
     to_visit -= 4;
     pt0 = to_visit[0];
@@ -877,6 +915,18 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
     goto loop;
   }
 
+#ifdef COROUTINING
+  /* we still may have constraints to do */
+  if (ConstraintsTerm != TermNil) {
+    *attachmentsp = (CELL)(CodeMax)-(CELL)(tbase);
+    pt0 = RepAppl(ConstraintsTerm)+1;
+    pt0_end = RepAppl(ConstraintsTerm)+4;
+    ConstraintsTerm = TermNil; 
+    StoPoint = CodeMax;
+    CodeMax += 4;
+    goto loop;
+  }
+#endif
   /* we're done */
   *vars_foundp = vars_found;
   UNWIND_CUNIF();
@@ -886,7 +936,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
   DBErrorFlag = OVF_ERROR_IN_DB;
   *vars_foundp = vars_found;
 #ifdef RATIONAL_TREES
-  while (to_visit > (CELL **)to_visit_base) {
+  while (to_visit > to_visit_base) {
     to_visit -= 4;
     pt0 = to_visit[0];
     pt0_end = to_visit[1];
@@ -901,7 +951,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
   DBErrorFlag = SOVF_ERROR_IN_DB;
   *vars_foundp = vars_found;
 #ifdef RATIONAL_TREES
-  while (to_visit > (CELL **)to_visit_base) {
+  while (to_visit > to_visit_base) {
     to_visit -= 4;
     pt0 = to_visit[0];
     pt0_end = to_visit[1];
@@ -917,7 +967,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
   DBErrorFlag = TOVF_ERROR_IN_DB;              \
   *vars_foundp = vars_found;
 #ifdef RATIONAL_TREES
-  while (to_visit > (CELL **)to_visit_base) {
+  while (to_visit > to_visit_base) {
     to_visit -= 4;
     pt0 = to_visit[0];
     pt0_end = to_visit[1];
@@ -1123,10 +1173,17 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag)
   DBRef    *TmpRefBase = (DBRef *)ConsultSp;
   CELL	   *CodeAbs;	/* how much code did we find	 */
   int vars_found;
+#ifdef COROUTINING
+  CELL attachments = 0;
+#endif
 
   DBErrorFlag = NO_ERROR_IN_DB;
 
-  if (IsVarTerm(Tm)) {
+  if (IsVarTerm(Tm)
+#ifdef COROUTINING
+      && !IsAttachedTerm(Tm)
+#endif
+      ) {
     Register DBRef  pp;
 
     tt = Tm;
@@ -1185,11 +1242,26 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag)
     ntp0 = pp0->Contents;
 #ifdef IDB_LINK_TABLE
     lr = LinkAr = (link_entry *)TR;
+#endif
+#ifdef COROUTINING
+    /* attachment */ 
+    if (IsVarTerm(Tm)) {
+      tt = sizeof(CELL);
+      ntp = MkDBTerm(VarOfTerm(Tm), VarOfTerm(Tm), ntp0, ntp0+1, ntp0-1,
+		     &attachments,
+		     &vars_found);
+	if (ntp == NULL)
+	  return(NULL);
+    } else
 #endif
     if (IsPairTerm(Tm)) {
       /* avoid null pointers!! */
       tt = AbsPair((CELL *)sizeof(CELL));
-      ntp = MkDBTerm(RepPair(Tm), RepPair(Tm)+1, ntp0, ntp0+2, ntp0-1, &vars_found);
+      ntp = MkDBTerm(RepPair(Tm), RepPair(Tm)+1, ntp0, ntp0+2, ntp0-1,
+#ifdef COROUTINING
+		     &attachments,
+#endif
+		     &vars_found);
       if (ntp == NULL) {
 	return(NULL);
       }
@@ -1274,7 +1346,11 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag)
 	arity = ArityOfFunctor(fun);
 	ntp = MkDBTerm(RepAppl(Tm)+1,
 		       RepAppl(Tm)+arity,
-		     ntp0+1, ntp0+1+arity, ntp0-1, &vars_found);
+		       ntp0+1, ntp0+1+arity, ntp0-1,
+#ifdef COROUTINING
+		       &attachments,
+#endif
+		       &vars_found);
 	if (ntp == NULL)
 	  return(NULL);
       }
@@ -1359,6 +1435,9 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag)
 #endif /* IDB_LINK_TABLE */
 
       pp->NOfCells = NOfCells;
+#ifdef COROUTINING
+      pp->attachments = attachments;
+#endif
       if (pp0 != pp) {
 	nar = pp->Contents;
 #ifdef IDB_LINK_TABLE
@@ -1918,6 +1997,18 @@ p_rcdzifnot(void)
   goto restart_record;
 }
 
+#ifdef COROUTINING
+static void
+copy_attachments(CELL *ts)
+{
+  while (TRUE) {
+    attas[IntegerOfTerm(ts[2])].term_to_op(ts[1], ts[0]);
+    if (ts[3] == TermNil) return;
+    ts = RepAppl(ts[3])+1;
+  }
+}
+#endif
+
 static Term 
 GetDBTerm(DBRef DBSP)
 {
@@ -1942,6 +2033,11 @@ GetDBTerm(DBRef DBSP)
       link_entry *lp = (link_entry *)pt;
       linkblk(lp, HOld-1);
     }
+#endif
+#ifdef COROUTINING
+    if (DBSP->attachments != 0L)  {
+      copy_attachments((CELL *)AdjustIDBPtr(DBSP->attachments,(CELL)(HOld-1)));
+    }
 #endif
     return (AdjustIDBPtr((Term)(DBSP->Entry),Unsigned(HOld)-sizeof(CELL)));
   }

C/init.c

@@ -955,6 +955,7 @@ InitCodes(void)
   heap_regs->functor_braces = MkFunctor(AtomBraces, 1);
   heap_regs->functor_call = MkFunctor(AtomCall, 1);
   heap_regs->functor_cut_by = MkFunctor(AtomCutBy, 1);
+  heap_regs->functor_clist = MkFunctor(LookupAtom("$when"), 4);
   heap_regs->functor_comma = MkFunctor(AtomComma, 2);
   heap_regs->functor_csult = MkFunctor(AtomCsult, 1);
   heap_regs->functor_eq = MkFunctor(AtomEq, 2);

C/save.c

@@ -493,10 +493,14 @@ save_stacks(int mode)
       tr_fr_ptr tr_ptr = TR; 
       while (tr_ptr != (tr_fr_ptr)TrailBase) {
 	CELL val = TrailTerm(tr_ptr-1);
-	if (!IsVarTerm(val) && IsPairTerm(val)) {
+	if (IsVarTerm(val)) {
+	  CELL *d1 = VarOfTerm(val);
+	  if (d1 < (CELL *)HeapTop)
+	    putout(val);
+	} else if (IsPairTerm(val)) {
 	  CELL *d1 = RepPair(val);
 	  if (d1 < (CELL *)HeapTop)
-	    putcellptr(d1);
+	    putout(val);
 	}
 	tr_ptr--;
       }
@@ -2898,17 +2902,22 @@ UnmarkTrEntries(void)
   B--;
   B->cp_ap = (yamop *)NOCODE;
   Entries = (CELL *)TrailBase;
-  while ((CODEADDR)(entry = *Entries++) != NULL) {
+  while ((entry = *Entries++) != (CELL)NULL) {
+    if (IsVarTerm(entry)) {
+      RESET_VARIABLE((CELL *)entry);
+    } else if (IsPairTerm(entry)) {
+      CODEADDR ent = (CODEADDR)RepPair(entry);
       register CELL flags;
 
-    flags = Flags(entry);
+      flags = Flags(ent);
       ResetFlag(InUseMask, flags);
-    Flags(entry) = flags;
+      Flags(ent) = flags;
       if (FlagOn(ErasedMask, flags)) {
 	if (FlagOn(DBClMask, flags)) {
-	ErDBE((DBRef) (entry - (CELL) &(((DBRef) NIL)->Flags)));
+	  ErDBE((DBRef) (ent - (CELL) &(((DBRef) NIL)->Flags)));
 	} else {
-	ErCl(ClauseFlagsToClause(entry));
+	  ErCl(ClauseFlagsToClause(ent));
+	}
       }
     }
   }

C/tracer.c

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

H/Heap.h

@@ -10,7 +10,7 @@
 * File:		Heap.h         						 *
 * mods:									 *
 * comments:	Heap Init Structure					 *
-* version:      $Id: Heap.h,v 1.14 2001-11-26 12:33:05 vsc Exp $	 *
+* version:      $Id: Heap.h,v 1.15 2001-12-17 18:31:10 vsc Exp $	 *
 *************************************************************************/
 
 /* information that can be stored in Code Space */
@@ -223,6 +223,7 @@ typedef struct various_codes {
 #endif
     functor_braces,
     functor_call,
+    functor_clist,
     functor_comma,
     functor_csult,
     functor_cut_by,
@@ -411,6 +412,7 @@ typedef struct various_codes {
 #endif
 #define  FunctorBraces            heap_regs->functor_braces
 #define  FunctorCall              heap_regs->functor_call
+#define  FunctorClist             heap_regs->functor_clist
 #define  FunctorComma             heap_regs->functor_comma
 #define  FunctorCsult             heap_regs->functor_csult
 #define  FunctorCutBy             heap_regs->functor_cut_by

m4/TermExt.h.m4

@@ -10,7 +10,7 @@
 * File:		TermExt.h						 *
 * mods:									 *
 * comments:	Extensions to standard terms for YAP			 *
-* version:      $Id: TermExt.h.m4,v 1.4 2001-12-11 03:34:03 vsc Exp $	 *
+* version:      $Id: TermExt.h.m4,v 1.5 2001-12-17 18:31:11 vsc Exp $	 *
 *************************************************************************/
 
 #if USE_OFFSETS
@@ -71,6 +71,9 @@ typedef struct {
   void (*bind_op)(Term *, Term);
   /* what to do if someone wants to copy our constraint */
   int (*copy_term_op)(CELL *, CELL ***, CELL *);
+  /* copy the constraint into a term and back */
+  Term (*to_term_op)(CELL *);
+  int (*term_to_op)(Term, Term);
   /* op called to do marking in GC */
   void (*mark_op)(CELL *);
 } ext_op;

m4/Yap.h.m4

@@ -10,7 +10,7 @@
 * File:		Yap.h.m4						 *
 * mods:									 *
 * comments:	main header file for YAP				 *
-* version:      $Id: Yap.h.m4,v 1.12 2001-09-24 18:07:16 vsc Exp $	 *
+* version:      $Id: Yap.h.m4,v 1.13 2001-12-17 18:31:11 vsc Exp $	 *
 *************************************************************************/
 
 #include "config.h"
@@ -567,7 +567,7 @@ and  RefOfTerm(t) : Term -> DBRef = ...
 	incompatible with the high tag scheme. Linux-ELF also does not like
 	if you place things in the lower addresses (power to the libc people).
 */
-#if (defined(_AIX) || defined(_WIN32) || defined(sparc) || defined(__sparc) || defined(mips) || defined(__FreeBSD__) || defined(_POWER) || defined(IN_SECOND_QUADRANT)) && !defined(TABLING)
+#if (defined(_AIX) || defined(_WIN32) || defined(sparc) || defined(__sparc) || defined(mips) || defined(__FreeBSD__) || defined(_POWER) || defined(__linux__) || defined(IN_SECOND_QUADRANT)) && !defined(TABLING)
 #define USE_LOW32_TAGS 1
 #endif
 

m4/Yatom.h.m4

@@ -287,6 +287,9 @@ typedef struct DB_STRUCT {
   Int age;                /* entry's age, negative if from recorda,
 			     positive if it was recordz  */
 #endif /* KEEP_ENTRY_AGE */
+#ifdef COROUTINING
+  CELL    attachments;   /* attached terms */   
+#endif
   CELL Mask;		/* parts that should be cleared		*/
   CELL Key;		/* A mask that can be used to check before
 			   you unify */

pl/boot.yap

@@ -43,6 +43,7 @@ true :- true. % otherwise, $$compile will ignore this clause.
 	'$set_yap_flags'(10,0),
 	'$set_value'('$gc',on),
 	'$init_catch',
+%	'$init_newcatch',  commented out for now
 	prompt('  ?- '),
 	(
 	    '$get_value'('$break',0)
@@ -68,17 +69,6 @@ true :- true. % otherwise, $$compile will ignore this clause.
 	    true
 	).
 
-'$init_catch' :-
-	% initialise access to the catch queue
-	( '$has_static_array'('$catch_queue') ->
-	    true
-	;
-	    static_array('$catch_queue',2, term)
-	),
-	update_array('$catch_queue', 0, '$'),
-	update_array('$catch_queue', 1, '$').
-
-
 				%
 % encapsulate $cut_by because of co-routining.
 %
@@ -1125,9 +1115,51 @@ expand_term(Term,Expanded) :-
 '$expand_term_modules'(A,A,A,_).
 
 
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %   catch/throw implementation
 
+/* new design, not working for now:
+
+% at each catch point I need to know:
+% what is ball;
+% where was the previous catch	
+newcatch(G, C, A) :-
+	array_element('$catch', 0, OldEnv),
+	Env is '$env',
+	update_array('$catch', 0, Env),
+	'$execute'(G),
+	update_array('$catch', 0, Env),
+	array_element('$catch', 1, V),
+	(var(V) ->
+	    true
+	;
+	    !, '$handle_throw'(C, A)
+	).
+
+'$handle_throw'(C, A) :-
+        % reset info 
+	array_element('$catch', 1, _),
+	array_element('$catch', 2, Ball),
+	(C = Ball ->
+	    '$execute'(A)
+	    ;
+	    throw(Ball)
+	).
+
+newthrow(Ball) :-
+	% say we are throwing something.
+	array_element('$catch', 1, []),
+	update_array('$catch', 2, Ball),
+	array_element('$catch', 0, Env),
+	'$jump_env'(Env).
+
+'$init_newcatch' :-
+	'$create_array'('$catch', 3).
+
+
+*/
+	
 catch(G,C,A) :- var(G), !,
 	throw(error(instantiation_error,catch(G,C,A))).
 catch(G,C,A) :- number(G), !,
@@ -1252,6 +1284,18 @@ throw(G) :-
         '$format'(user_error,"system_error_at(~w)",[G]),
         abort.
 
+
+'$init_catch' :-
+	% initialise access to the catch queue
+	( '$has_static_array'('$catch_queue') ->
+	    true
+	;
+	    static_array('$catch_queue',2, term)
+	),
+	update_array('$catch_queue', 0, '$'),
+	update_array('$catch_queue', 1, '$').
+
+
 '$check_list'(V, _) :- var(V), !.
 '$check_list'([], _) :- !.
 '$check_list'([_|B], T) :- !,

pl/corout.yap

@@ -619,7 +619,8 @@ call_residue(Goal,Residue) :-
         ;
 	  '$pick_vars_for_project'(LIV,NLIV),
 	  '$project_module'(LMods,NLIV,LAV),
-	  '$all_attvars'(NLAV),
+	  '$all_attvars'(NLAV0),
+	  sort(NLAV0, NLAV),
 	  '$convert_att_vars'(NLAV, LIV, Gs, Gs0)
 	).
 

pl/load_foreign.yap

@@ -17,7 +17,7 @@
 
 load_foreign_files(Objs,Libs,Entry) :-
 	'$check_objs_for_load_foreign_files'(Objs,NewObjs,load_foreign_files(Objs,Libs,Entry)),
-	'$check_lib_for_load_foreign_files'(Libs,load_foreign_files(Objs,Libs,Entry)),
+	'$check_libs_for_load_foreign_files'(Libs,load_foreign_files(Objs,Libs,Entry)),
 	'$check_entry_for_load_foreign_files'(Entry,load_foreign_files(Objs,Libs,Entry)),
 	'$load_foreign_files'(NewObjs,Libs,Entry).