more thread fixes

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

C/absmi.c

@@ -1081,6 +1081,11 @@ Yap_absmi(int inp)
 #if defined(YAPOR) || defined(THREADS)
       PP = PREG->u.p.p;
       READ_LOCK(PP->PRWLock);
+      if (PP->cs.p_code.TrueCodeOfPred != PREG) {
+	PREG = PP->cs.p_code.TrueCodeOfPred;
+	READ_UNLOCK(PP->PRWLock);
+	GONext();
+      }
 #endif
       PREG = NEXTOP(PREG, p);
       GONext();
@@ -1102,7 +1107,6 @@ Yap_absmi(int inp)
 
       /* enter logical pred               */
       BOp(stale_lu_index, Ill);
-      saveregs();
       {
 	yamop *ipc;
 
@@ -1112,17 +1116,18 @@ Yap_absmi(int inp)
 	  ASP = (CELL *) B;
 	}
 #if defined(YAPOR) || defined(THREADS)
-	LOCK(pe->PELock);
+	LOCK(PREG->u.Ill.l1->u.ld.p->PELock);
 	if (*PREG_ADDR != PREG) {
 	  PREG = *PREG_ADDR;
-	  UNLOCK(pe->PELock);
+	  UNLOCK(PREG->u.Ill.l1->u.ld.p->PELock);
 	  JMPNext();
 	}
 #endif
+	saveregs();
 	ipc = Yap_CleanUpIndex(PREG->u.Ill.I);
-	READ_UNLOCK(pe->PRWLock);
-	/* restart index */
 	setregs();
+	UNLOCK(PREG->u.Ill.l1->u.ld.p->PELock);
+	/* restart index */
 	PREG = ipc;
 	if (PREG == NULL) FAIL();
 	CACHED_A1() = ARG1;
@@ -6357,19 +6362,19 @@ Yap_absmi(int inp)
 	if (ASP > (CELL *) B) {
 	  ASP = (CELL *) B;
 	}
- 	saveregs();
 #if defined(YAPOR) || defined(THREADS)
 	LOCK(pe->PELock);
-	if (*PREG_ADDR != PREG)) {
+	if (*PREG_ADDR != PREG) {
 	  PREG = *PREG_ADDR;
 	  UNLOCK(pe->PELock);
 	  JMPNext();
 	}
 #endif
+ 	saveregs();
 	pt0 = Yap_ExpandIndex(pe);
 	/* restart index */
-	UNLOCK(pe->PELock);
 	setregs();
+	UNLOCK(pe->PELock);
  	PREG = pt0;
 	JMPNext();
       }

C/adtdefs.c

@@ -187,6 +187,9 @@ LookupAtom(char *atom)
   if (NOfAtoms > 2*AtomHashTableSize) {
     Yap_signal(YAP_CDOVF_SIGNAL);
   }
+  {extern int vsc_xstop;
+  if (ae == 0x81cf80c) vsc_xstop = 1;
+  }
   return na;
 }
 

C/alloc.c

@@ -12,7 +12,7 @@
 * Last rev:								 *
 * mods:									 *
 * comments:	allocating space					 *
-* version:$Id: alloc.c,v 1.45 2004-02-11 01:20:56 vsc Exp $		 *
+* version:$Id: alloc.c,v 1.46 2004-02-19 19:24:44 vsc Exp $		 *
 *************************************************************************/
 #ifdef SCCS
 static char SccsId[] = "%W% %G%";
@@ -185,6 +185,17 @@ Yap_InitExStacks(int Trail, int Stack)
   InitExStacks(Trail, Stack);
 }
 
+#if defined(YAPOR) || defined(THREADS)
+void
+Yap_KillStacks(int wid)
+{
+  ADDR gb = Yap_thread_gl[worker_id].global_base;
+  if (gb) {
+    free(gb);
+    Yap_thread_gl[wid].global_base = NULL;
+  }
+}
+#else
 void
 Yap_KillStacks(void)
 {
@@ -193,6 +204,7 @@ Yap_KillStacks(void)
     Yap_GlobalBase = NULL;
   }
 }
+#endif
 
 void
 Yap_InitMemory(int Trail, int Heap, int Stack)

C/amasm.c

@@ -1170,6 +1170,7 @@ init_log_upd_table(LogUpdIndex *ic, union clause_obj *cl_u)
   ic->ChildIndex = NULL;
   ic->ClRefCount = 0;
   ic->u.ParentIndex = (LogUpdIndex *)cl_u;
+  INIT_LOCK(ic->ClLock);
   cl_u->lui.ChildIndex = ic;
   cl_u->lui.ClRefCount++;
 }

C/cdmgr.c

@@ -254,9 +254,18 @@ decrease_ref_counter(yamop *ptr, yamop *b, yamop *e, yamop *sc)
 	!(cl->ClRefCount) &&
 	!(cl->ClFlags & InUseMask)) {
       /* last ref to the clause */
+#if defined(YAPOR) || defined(THREADS)
+      /* can't do erase now without risking deadlocks */
+      cl->ClRefCount++;
+      TRAIL_CLREF(cl);
+      UNLOCK(cl->ClLock);
+#else
+      UNLOCK(cl->ClLock);
       Yap_ErLogUpdCl(cl);
+#endif
+    } else {
+      UNLOCK(cl->ClLock);
     }
-    UNLOCK(cl->ClLock);
   }
 }
 
@@ -402,10 +411,13 @@ kill_static_child_indxs(StaticIndex *indx)
 static void
 kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
 {
-  LogUpdIndex *ncl = c->ChildIndex;
 
+  LogUpdIndex *ncl;
+  /* parent is always locked, now I lock myself */
+  LOCK(c->ClLock);
   if (parent != NULL &&
       !(c->ClFlags & ErasedMask)) {
+    /* remove myself from parent */
     if (c == parent->ChildIndex) {
       parent->ChildIndex = c->SiblingIndex;
     } else {
@@ -418,6 +430,7 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
   }
   /* make sure that a child cannot remove us */
   c->ClRefCount++;
+  ncl = c->ChildIndex;
   while (ncl != NULL) {
     LogUpdIndex *next = ncl->SiblingIndex;
     kill_first_log_iblock(ncl, c, ap);
@@ -429,21 +442,7 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
       ap->cs.p_code.TrueCodeOfPred == c->ClCode) {
     RemoveMainIndex(ap);
   }
-  if (!((c->ClFlags & InUseMask) || c->ClRefCount)) {
+  decrease_log_indices(c, (yamop *)&(ap->cs.p_code.ExpandCode));
-    if (parent != NULL) {
-      parent->ClRefCount--;
-      if (parent->ClFlags & ErasedMask &&
-	  !(parent->ClFlags & InUseMask) &&
-	  parent->ClRefCount == 0) {
-	/* cool, I can erase the father too. */
-	if (parent->ClFlags & SwitchRootMask) {
-	  kill_first_log_iblock(parent, NULL, ap);
-	} else {
-	  kill_first_log_iblock(parent, parent->u.ParentIndex, ap);
-	}
-      }
-    }
-    decrease_log_indices(c, (yamop *)&(ap->cs.p_code.ExpandCode));
 #ifdef DEBUG
     {
       LogUpdIndex *parent = DBErasedIList, *c0 = NULL;
@@ -457,6 +456,27 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
       }
     }
 #endif
+  if (!((c->ClFlags & InUseMask) || c->ClRefCount)) {
+    if (parent != NULL) {
+      parent->ClRefCount--;
+      if (parent->ClFlags & ErasedMask &&
+	  !(parent->ClFlags & InUseMask) &&
+	  parent->ClRefCount == 0) {
+	/* cool, I can erase the father too. */
+	if (parent->ClFlags & SwitchRootMask) {
+	  UNLOCK(parent->ClLock);
+	  kill_first_log_iblock(parent, NULL, ap);
+	  LOCK(parent->ClLock);
+	} else {
+	  LOCK(parent->u.ParentIndex->ClLock);
+	  UNLOCK(parent->ClLock);
+	  kill_first_log_iblock(parent, parent->u.ParentIndex, ap);
+	  LOCK(parent->ClLock);
+	  UNLOCK(parent->u.ParentIndex->ClLock);
+	}
+      }
+    }
+    UNLOCK(c->ClLock);
     Yap_FreeCodeSpace((CODEADDR)c);
   } else {
 #ifdef DEBUG
@@ -464,6 +484,7 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
     DBErasedIList = c;
 #endif
     c->ClFlags |= ErasedMask;
+#if !defined(THREADS) && !defined(YAPOR)
     /* try to move up, so that we don't hold an index */
     if (parent != NULL &&
 	parent->ClFlags & SwitchTableMask) {
@@ -471,7 +492,9 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
       parent->u.ParentIndex->ClRefCount++;
       parent->ClRefCount--;
     }
+#endif
     c->ChildIndex = NULL;
+    UNLOCK(c->ClLock);
   }
 }
 
@@ -489,7 +512,9 @@ Yap_kill_iblock(ClauseUnion *blk, ClauseUnion *parent_blk, PredEntry *ap)
     LogUpdIndex *c = (LogUpdIndex *)blk;
     if (parent_blk != NULL) {
       LogUpdIndex *cl = (LogUpdIndex *)parent_blk;
+      LOCK(cl->ClLock);
       kill_first_log_iblock(c, cl, ap);
+      UNLOCK(cl->ClLock);
     } else {
       kill_first_log_iblock(c, NULL, ap);
     }
@@ -518,18 +543,28 @@ void
 Yap_ErLogUpdIndex(LogUpdIndex *clau)
 {
   LogUpdIndex *c = clau;
+  if (clau->ClFlags & ErasedMask) {
+    /* nothing I can do, I have been erased already */
+    return;
+  }
   if (c->ClFlags & SwitchRootMask) {
      kill_first_log_iblock(clau, NULL, c->u.pred);
  } else {
     while (!(c->ClFlags & SwitchRootMask)) 
       c = c->u.ParentIndex;
+    LOCK(clau->u.ParentIndex->ClLock);
     kill_first_log_iblock(clau, clau->u.ParentIndex, c->u.pred);
+    UNLOCK(clau->u.ParentIndex->ClLock);
  }
 }
 
 void
 Yap_RemoveLogUpdIndex(LogUpdIndex *cl)
 {
+  if (cl->ClFlags & ErasedMask) {
+    /* nothing I can do, I have been erased already */
+    return;
+  }
   if (cl->ClFlags & SwitchRootMask) {
     kill_first_log_iblock(cl, NULL, cl->u.pred);
   } else {
@@ -537,7 +572,9 @@ Yap_RemoveLogUpdIndex(LogUpdIndex *cl)
     while (!(pcl->ClFlags & SwitchRootMask)) {
       pcl = pcl->u.ParentIndex;
     }
+    LOCK(cl->u.ParentIndex->ClLock);
     kill_first_log_iblock(cl, cl->u.ParentIndex, pcl->u.pred);
+    UNLOCK(cl->u.ParentIndex->ClLock);
   }
 }
 
@@ -3051,7 +3088,6 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya
 
   cl = Yap_FollowIndexingCode(pe, i_code, th, tb, tr, NEXTOP(PredLogUpdClause->CodeOfPred,ld), cp_ptr);
   if (cl == NULL) {
-    READ_UNLOCK(pe->PRWLock);
     return FALSE;
   }
   rtn = MkDBRefTerm((DBRef)cl);
@@ -3066,7 +3102,9 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya
     TRAIL_CLREF(cl);	/* So that fail will erase it */
   }
 #endif
-  READ_UNLOCK(pe->PRWLock);
+#if defined(YAPOR) || defined(THREADS)
+  WPP = NULL;
+#endif
   if (cl->ClFlags & FactMask) {
     if (!Yap_unify(tb, MkAtomTerm(AtomTrue)) ||
 	!Yap_unify(tr, rtn))
@@ -3118,15 +3156,33 @@ p_log_update_clause(void)
 {
   PredEntry      *pe;
   Term t1 = Deref(ARG1);
+  Int ret;
 
   pe = get_pred(t1, Deref(ARG2), "clause/3");
   if (pe == NULL || EndOfPAEntr(pe))
     return FALSE;
-  READ_LOCK(pe->PRWLock);
   if(pe->OpcodeOfPred == INDEX_OPCODE) {
-    IPred(pe);
+    WRITE_LOCK(pe->PRWLock);
+#if defined(YAPOR) || defined(THREADS)
+    if (pe->OpcodeOfPred == INDEX_OPCODE)
+#endif
+      IPred(pe);
+    WRITE_UNLOCK(pe->PRWLock);
   }
-  return fetch_next_lu_clause(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, ARG4, P, TRUE);
+#if defined(YAPOR) || defined(THREADS)
+  if (PP != pe) {
+    READ_LOCK(pe->PRWLock);
+    PP = pe;
+  }
+#endif
+  ret = fetch_next_lu_clause(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, ARG4, P, TRUE);
+#if defined(YAPOR) || defined(THREADS)
+  if (PP == pe) {
+    PP = NULL;
+    READ_UNLOCK(pe->PRWLock);
+  }
+#endif
+  return ret;
 }
 
 static Int			/* $hidden_predicate(P) */
@@ -3135,7 +3191,6 @@ p_continue_log_update_clause(void)
   PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1));
   yamop *ipc = (yamop *)IntegerOfTerm(ARG2);
 
-  READ_LOCK(pe->PRWLock);
   return fetch_next_lu_clause(pe, ipc, Deref(ARG3), ARG4, ARG5, B->cp_ap, FALSE);
 }
 
@@ -3145,7 +3200,6 @@ fetch_next_lu_clause0(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_
   LogUpdClause *cl;
 
   cl = Yap_FollowIndexingCode(pe, i_code, th, tb, TermNil, NEXTOP(PredLogUpdClause0->CodeOfPred,ld), cp_ptr);
-  READ_UNLOCK(pe->PRWLock);
   if (cl == NULL) {
     return FALSE;
   }
@@ -3198,15 +3252,31 @@ p_log_update_clause0(void)
 {
   PredEntry      *pe;
   Term           t1 = Deref(ARG1);
+  Int ret;
 
   pe = get_pred(t1, Deref(ARG2), "clause/3");
   if (pe == NULL || EndOfPAEntr(pe))
     return FALSE;
-  READ_LOCK(pe->PRWLock);
   if(pe->OpcodeOfPred == INDEX_OPCODE) {
-    IPred(pe);
+#if defined(YAPOR) || defined(THREADS)
+    if (pe->OpcodeOfPred == INDEX_OPCODE)
+#endif
+      IPred(pe);
   }
-  return fetch_next_lu_clause0(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, P, TRUE);
+#if defined(YAPOR) || defined(THREADS)
+  if (PP != pe) {
+    READ_LOCK(pe->PRWLock);
+    PP = pe;
+  }
+#endif
+  ret = fetch_next_lu_clause0(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, P, TRUE);
+#if defined(YAPOR) || defined(THREADS)
+  if (PP == pe) {
+    PP = NULL;
+    READ_UNLOCK(pe->PRWLock);
+  }
+#endif
+  return ret;
 }
 
 static Int			/* $hidden_predicate(P) */
@@ -3215,7 +3285,6 @@ p_continue_log_update_clause0(void)
   PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1));
   yamop *ipc = (yamop *)IntegerOfTerm(ARG2);
 
-  READ_LOCK(pe->PRWLock);
   return fetch_next_lu_clause0(pe, ipc, Deref(ARG3), ARG4, B->cp_ap, FALSE);
 }
 
@@ -3284,7 +3353,12 @@ p_static_clause(void)
   if (pe == NULL || EndOfPAEntr(pe))
     return FALSE;
   if(pe->OpcodeOfPred == INDEX_OPCODE) {
-    IPred(pe);
+    WRITE_LOCK(pe->PRWLock);
+#if defined(YAPOR) || defined(THREADS)
+    if (pe->OpcodeOfPred == INDEX_OPCODE)
+#endif
+      IPred(pe);
+    WRITE_UNLOCK(pe->PRWLock);
   }
   return fetch_next_static_clause(pe, pe->cs.p_code.TrueCodeOfPred, t1, ARG3, ARG4, P, TRUE);
 }
@@ -3304,21 +3378,9 @@ p_nth_clause(void)
   pe = get_pred(t1, Deref(ARG2), "clause/3");
   if (pe == NULL || EndOfPAEntr(pe))
     return FALSE;
-  if(pe->OpcodeOfPred == INDEX_OPCODE) {
-    WRITE_LOCK(pe->PRWLock);
-    if(pe->OpcodeOfPred == INDEX_OPCODE) {
-      IPred(pe);
-    }
-    WRITE_UNLOCK(pe->PRWLock);
-  }
-  READ_LOCK(pe->PRWLock);
   if (!(pe->PredFlags & (SourcePredFlag|LogUpdatePredFlag))) {
-    READ_UNLOCK(pe->PRWLock);
     return FALSE;
   }
-  if (pe->PredFlags & SourcePredFlag) {
-    READ_UNLOCK(pe->PRWLock);
-  }
   /* in case we have to index or to expand code */
   if (pe->ModuleOfPred != IDB_MODULE) {
     UInt i;
@@ -3329,11 +3391,11 @@ p_nth_clause(void)
   } else {
       XREGS[2] = MkVarTerm();
   }
-  cl = Yap_NthClause(pe, ncls);
+  if(pe->OpcodeOfPred == INDEX_OPCODE) {
-  if (pe->PredFlags & LogUpdatePredFlag) {
+    IPred(pe);
-    READ_UNLOCK(pe->PRWLock);
   }
-  if (cl == NULL)
+  cl = Yap_NthClause(pe, ncls);
+  if (cl == NULL) 
     return FALSE;
   if (cl->ClFlags & LogUpdatePredFlag) {
 #if defined(YAPOR) || defined(THREADS)

C/dbase.c

@@ -1520,19 +1520,12 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc
 	Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
 	return(NULL);
       }
-      /* restore lr to NULL in case there is a TR overflow */
-      dbg->lr = NULL;
 #endif
       if ((InFlag & MkIfNot) && (dbg->found_one = check_if_wvars(p->First, NOfCells, ntp0))) {
 	Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
 	return dbg->found_one;
       }
     } else {
-#ifdef IDB_LINK_TABLE
-      /* make sure lr ends in 0 for check_if_nvars */  
-      /* restore lr to NULL in case there is a TR overflow */
-      dbg->lr = NULL;
-#endif
       flag = DBNoVars;
       if ((InFlag & MkIfNot) && (dbg->found_one = check_if_nvars(p->First, NOfCells, ntp0, dbg))) {
 	Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
@@ -3856,12 +3849,10 @@ complete_lu_erase(LogUpdClause *clau)
 static void
 EraseLogUpdCl(LogUpdClause *clau)
 {
-  PredEntry *ap = clau->ClPred;
+  PredEntry *ap;
-#if defined(YAPOR) || defined(THREADS)
+  LOCK(clau->ClLock);
-  if (WPP != ap) {
+  ap = clau->ClPred;
-    WRITE_LOCK(ap->PRWLock);
+  WRITE_LOCK(ap->PRWLock);
-  }
-#endif
   /* no need to erase what has been erased */ 
   if (!(clau->ClFlags & ErasedMask)) {
 
@@ -3903,16 +3894,15 @@ EraseLogUpdCl(LogUpdClause *clau)
 #endif
     /* we are holding a reference to the clause */
     clau->ClRefCount++;
+    UNLOCK(clau->ClLock);
     Yap_RemoveClauseFromIndex(ap, clau->ClCode);
     /* release the extra reference */
+    LOCK(clau->ClLock);
     clau->ClRefCount--;
   }
   complete_lu_erase(clau);
-#if defined(YAPOR) || defined(THREADS)
+  UNLOCK(clau->ClLock);
-  if (WPP != ap) {
+  WRITE_UNLOCK(ap->PRWLock);
-    WRITE_UNLOCK(ap->PRWLock);
-  }
-#endif
 }
 
 static void

C/index.c

@@ -4129,7 +4129,8 @@ expand_index(struct intermediates *cint) {
       lab = do_index(cls, max, cint, argno+1, fail_l, isfirstcl, clleft, top);
     }
   }
-  *labp = (yamop *)lab; /* in case we have a single clause */
+  if (labp)
+    *labp = (yamop *)lab; /* in case we have a single clause */
   return labp;
 }
 
@@ -4170,8 +4171,7 @@ ExpandIndex(PredEntry *ap) {
 	cl = ClauseCodeToStaticIndex(ap->cs.p_code.TrueCodeOfPred);
 	Yap_kill_iblock((ClauseUnion *)cl, NULL, ap);
       }
-      UNLOCK(ap->PELock);
+      return FAILCODE;
-      return NULL;
     }
   }
  restart_index:
@@ -4214,11 +4214,9 @@ ExpandIndex(PredEntry *ap) {
   }
 #endif
   if ((labp = expand_index(&cint)) == NULL) {
-    UNLOCK(ap->PELock);
+    return FAILCODE;
-    return NULL;
   }
   if (*labp == FAILCODE) {
-    UNLOCK(ap->PELock);
     return FAILCODE;
   }
 #ifdef DEBUG
@@ -4232,21 +4230,18 @@ ExpandIndex(PredEntry *ap) {
     if ((indx_out = Yap_assemble(ASSEMBLING_EINDEX, TermNil, ap, FALSE, &cint)) == NULL) {
       if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
 	Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
-	UNLOCK(ap->PELock);
+	return FAILCODE;
-	return NULL;
       }
       goto restart_index;
     }
   } else {
     /* single case */
-    UNLOCK(ap->PELock);
     return *labp;
   }
   if (ProfilerOn) {
     Yap_inform_profiler_of_clause(indx_out, ProfEnd, ap); 
   }
   if (indx_out == NULL) {
-    UNLOCK(ap->PELock);
     return FAILCODE;
   }
   *labp = indx_out;
@@ -4268,7 +4263,6 @@ ExpandIndex(PredEntry *ap) {
     nic->SiblingIndex = ic->ChildIndex;
     ic->ChildIndex = nic;
   }
-  UNLOCK(ap->PELock);
   return indx_out;
 }
 
@@ -4749,12 +4743,23 @@ cp_lu_trychain(yamop *codep, yamop *ocodep, yamop *ostart, int flag, PredEntry *
 	if (op != _try_clause) {
 	  LogUpdClause *tgl = ClauseCodeToLogUpdClause(ocodep->u.ld.d);
 	  if (compact_mode) {
+	    LOCK(tgl->ClLock);
 	    tgl->ClRefCount--;
 	    if (tgl->ClFlags & ErasedMask &&
 		!(tgl->ClRefCount) &&
 		!(tgl->ClFlags & InUseMask)) {
+#if defined(YAPOR) || defined(THREADS)
+	      /* can't do erase now without risking deadlocks */
+	      tgl->ClRefCount++;
+	      TRAIL_CLREF(tgl);
+	      UNLOCK(tgl->ClLock);
+#else
 	      /* last ref to the clause */
+	      UNLOCK(tgl->ClLock);
 	      Yap_ErLogUpdCl(tgl);
+#endif
+	    } else {
+	      UNLOCK(tgl->ClLock);
 	    }
 	  }
 	}
@@ -4789,12 +4794,23 @@ cp_lu_trychain(yamop *codep, yamop *ocodep, yamop *ostart, int flag, PredEntry *
       if (compact_mode) {
 	LogUpdClause *tgl = ClauseCodeToLogUpdClause(ocodep->u.ld.d);
 
+	LOCK(tgl->ClLock);
 	tgl->ClRefCount--;
 	if (tgl->ClFlags & ErasedMask &&
 	    !(tgl->ClRefCount) &&
 	    !(tgl->ClFlags & InUseMask)) {
 	  /* last ref to the clause */
+#if defined(YAPOR) || defined(THREADS)
+	      /* can't do erase now without risking deadlocks */
+	  tgl->ClRefCount++;
+	  TRAIL_CLREF(tgl);
+	  UNLOCK(tgl->ClLock);
+#else
+	  UNLOCK(tgl->ClLock);
 	  Yap_ErLogUpdCl(tgl);
+#endif
+	} else {
+	  UNLOCK(tgl->ClLock);
 	}
       }
       ocodep = NEXTOP(ocodep, ld);
@@ -6066,6 +6082,7 @@ remove_from_index(PredEntry *ap, path_stack_entry *sp, ClauseDef *cls, yamop *bg
 }
 
 
+/* clause is locked */
 void
 Yap_RemoveClauseFromIndex(PredEntry *ap, yamop *beg) {
   ClauseDef cl;
@@ -6384,8 +6401,8 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, yam
     case _stale_lu_index:
 #if defined(YAPOR) || defined(THREADS)
       LOCK(ap->PELock);
-      if (*jbl != ipc) {
+      if (*jlbl != ipc) {
-	ipc = *jbl;
+	ipc = *jlbl;
 	UNLOCK(ap->PELock);
 	break;
       }
@@ -6586,14 +6603,14 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term t1, Term tb, Term tr, yam
     case _expand_index:
 #if defined(YAPOR) || defined(THREADS)
       LOCK(ap->PELock);
-      if (*jbl != ipc) {
+      if (*jlbl != ipc) {
-	ipc = *jbl;
+	ipc = *jlbl;
 	UNLOCK(ap->PELock);
 	break;
       }
 #endif
       ipc = ExpandIndex(ap);
-      UNLOCK(pe->PELock);
+      UNLOCK(ap->PELock);
       break;
     case _op_fail:
       /*
@@ -6751,8 +6768,8 @@ Yap_NthClause(PredEntry *ap, Int ncls)
     case _stale_lu_index:
 #if defined(YAPOR) || defined(THREADS)
       LOCK(ap->PELock);
-      if (*jbl != ipc) {
+      if (*jlbl != ipc) {
-	ipc = *jbl;
+	ipc = *jlbl;
 	UNLOCK(ap->PELock);
 	break;
       }
@@ -6814,9 +6831,9 @@ Yap_NthClause(PredEntry *ap, Int ncls)
     case _expand_index:
 #if defined(YAPOR) || defined(THREADS)
       LOCK(ap->PELock);
-      if (*jbl != (yamop *)&(ap->cs.p_code.ExpandCode)) {
+      if (*jlbl != (yamop *)&(ap->cs.p_code.ExpandCode)) {
-	ipc = *jbl;
+	ipc = *jlbl;
-	UNLOCK(pe->PELock);
+	UNLOCK(ap->PELock);
 	break;
       }
 #endif
@@ -6833,12 +6850,6 @@ Yap_NthClause(PredEntry *ap, Int ncls)
       break;
     case _undef_p:
     default:
-#if defined(YAPOR) || defined(THREADS)
-      if (PP == ap) {
-	PP = NULL;
-	READ_UNLOCK(ap->PRWLock);
-      }
-#endif
       return NULL;
     }
   }

C/stdpreds.c

@@ -1661,21 +1661,21 @@ cont_current_atom(void)
     while (i < AtomHashTableSize) {
       READ_LOCK(HashChain[i].AERWLock);
       catom = HashChain[i].Entry;
+      READ_UNLOCK(HashChain[i].AERWLock);
       if (catom != NIL) {
 	break;
       }
-      READ_UNLOCK(HashChain[i].AERWLock);
       i++;
     }
     if (i == AtomHashTableSize) {
       cut_fail();
-    } else {
-      READ_UNLOCK(HashChain[i].AERWLock);
     }
   }
   ap = RepAtom(catom);
   if (Yap_unify_constant(ARG1, MkAtomTerm(catom))) {
+    READ_LOCK(ap->ARWLock);
     if (ap->NextOfAE == NIL) {
+      READ_UNLOCK(ap->ARWLock);
       i++;
       while (i < AtomHashTableSize) {
 	READ_LOCK(HashChain[i].AERWLock);
@@ -1687,19 +1687,18 @@ cont_current_atom(void)
 	i++;
       }
       if (i == AtomHashTableSize) {
-	cut_succeed();
+	cut_fail();
       } else {
 	EXTRA_CBACK_ARG(1,1) = MkAtomTerm(catom);
       }
     } else {
-      READ_LOCK(ap->ARWLock);
       EXTRA_CBACK_ARG(1,1) = MkAtomTerm(ap->NextOfAE);
       READ_UNLOCK(ap->ARWLock);
     }
     EXTRA_CBACK_ARG(1,2) = MkIntTerm(i);
-    return(TRUE);
+    return TRUE;
   } else {
-    return(FALSE);
+    return FALSE;
   }
 }
 

C/threads.c

@@ -60,32 +60,38 @@ store_specs(int new_worker_id, UInt ssize, UInt tsize, Term tgoal, Term tdetach)
     Yap_StoreTermInDB(tgoal,4);
   ThreadHandle[new_worker_id].cmod =
     CurrentModule;
-  if (IsVarTerm(tdetach))
+  if (IsVarTerm(tdetach)){
-    tdetach = MkAtomTerm(AtomFalse);
+    ThreadHandle[new_worker_id].tdetach =  
-  ThreadHandle[new_worker_id].tdetach =
+      MkAtomTerm(AtomFalse);
-    tdetach;
+  } else {
+    ThreadHandle[new_worker_id].tdetach = 
+      tdetach;
+  }
 }
 
 
 static void
-thread_die(void)
+thread_die(int wid)
 {
-  Prop p0 = AbsPredProp(heap_regs->thread_handle[worker_id].local_preds);
+  Prop p0;
 
-  /* kill all thread local preds */
-  while(p0) {
-    PredEntry *ap = RepPredProp(p0);
-    p0 = ap->NextOfPE;
-    Yap_Abolish(ap);
-    Yap_FreeCodeSpace((char *)ap);
-  }
-  Yap_KillStacks();
   LOCK(ThreadHandlesLock);
-  ActiveSignals = 0L;
+  if (ThreadHandle[wid].tdetach == MkAtomTerm(AtomTrue)) {
-  free(ScratchPad.ptr);
+    p0 = AbsPredProp(heap_regs->thread_handle[wid].local_preds);
-  free(ThreadHandle[worker_id].default_yaam_regs);
+    /* kill all thread local preds */
-  ThreadHandle[worker_id].in_use = FALSE;
+    while(p0) {
-  pthread_mutex_destroy(&(ThreadHandle[worker_id].tlock));
+      PredEntry *ap = RepPredProp(p0);
+      p0 = ap->NextOfPE;
+      Yap_Abolish(ap);
+      Yap_FreeCodeSpace((char *)ap);
+    }
+    Yap_KillStacks(wid);
+    heap_regs->wl[wid].active_signals = 0L;
+    free(heap_regs->wl[wid].scratchpad.ptr);
+    free(ThreadHandle[wid].default_yaam_regs);
+    ThreadHandle[wid].in_use = FALSE;
+    pthread_mutex_destroy(&(ThreadHandle[wid].tlock));
+  }
   UNLOCK(ThreadHandlesLock);
 }
 
@@ -113,7 +119,7 @@ thread_run(void *widp)
   tgoal = Yap_MkApplTerm(FunctorThreadRun, 2, tgs);
   pthread_mutex_unlock(&(ThreadHandle[worker_id].tlock));
   out = Yap_RunTopGoal(tgoal);
-  thread_die();
+  thread_die(worker_id);
   return NULL;
 }
 
@@ -132,6 +138,8 @@ p_create_thread(void)
   Term tgoal = Deref(ARG1);
   Term tdetach = Deref(ARG5);
   int new_worker_id = IntegerOfTerm(Deref(ARG6));
+  pthread_attr_t at;
+
   if (new_worker_id == -1) {
     /* YAP ERROR */
     return FALSE;
@@ -140,6 +148,8 @@ p_create_thread(void)
   pthread_mutex_init(&ThreadHandle[new_worker_id].tlock, NULL);
   pthread_mutex_lock(&(ThreadHandle[new_worker_id].tlock));
   store_specs(new_worker_id, ssize, tsize, tgoal, tdetach);
+  pthread_attr_init(&at);
+  pthread_attr_setstacksize(&at, 32*4096);
   if ((ThreadHandle[new_worker_id].ret = pthread_create(&(ThreadHandle[new_worker_id].handle), NULL, thread_run, (void *)(&(ThreadHandle[new_worker_id].id)))) == 0) {
     return TRUE;
   }
@@ -156,8 +166,22 @@ p_thread_self(void)
 static Int
 p_thread_join(void)
 {
-  pthread_t th = ThreadHandle[IntegerOfTerm(Deref(ARG1))].handle;
+  Int tid = IntegerOfTerm(Deref(ARG1));
+  pthread_t th;
   void *retval;
+
+  LOCK(ThreadHandlesLock);
+  if (!ThreadHandle[tid].in_use) {
+    UNLOCK(ThreadHandlesLock);
+    return FALSE;
+  }
+  if (!ThreadHandle[tid].tdetach == MkAtomTerm(AtomTrue)) {
+    UNLOCK(ThreadHandlesLock);
+    return FALSE;
+  }
+  ThreadHandle[tid].tdetach = MkAtomTerm(AtomTrue);
+  th = ThreadHandle[tid].handle;
+  UNLOCK(ThreadHandlesLock);
   if (pthread_join(th, &retval) < 0) {
     /* ERROR */
     return FALSE;
@@ -165,6 +189,15 @@ p_thread_join(void)
   return TRUE;
 }
 
+static Int
+p_thread_destroy(void)
+{
+  Int tid = IntegerOfTerm(Deref(ARG1));
+
+  thread_die(tid);
+  return TRUE;
+}
+
 static Int
 p_thread_detach(void)
 {
@@ -179,7 +212,7 @@ p_thread_detach(void)
 static Int
 p_thread_exit(void)
 {
-  thread_die();
+  thread_die(worker_id);
   pthread_exit(NULL);
   return TRUE;
 }
@@ -386,6 +419,7 @@ void Yap_InitThreadPreds(void)
   Yap_InitCPred("$create_thread", 6, p_create_thread, 0);
   Yap_InitCPred("$thread_self", 1, p_thread_self, SafePredFlag);
   Yap_InitCPred("$thread_join", 1, p_thread_join, 0);
+  Yap_InitCPred("$thread_destroy", 1, p_thread_destroy, 0);
   Yap_InitCPred("$detach_thread", 1, p_thread_detach, 0);
   Yap_InitCPred("$thread_exit", 0, p_thread_exit, 0);
   Yap_InitCPred("thread_setconcurrency", 2, p_thread_set_concurrency, 0);

C/tracer.c

@@ -102,7 +102,7 @@ check_trail_consistency(void) {
 */
 
 
-static int vsc_xstop = FALSE;
+int vsc_xstop = FALSE;
 
 CELL old_value = 0L, old_value2 = 0L;
 
@@ -116,7 +116,17 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
 
   LOCK(heap_regs->low_level_trace_lock);
   vsc_count++;
+  if (vsc_count < 12000) {
+      UNLOCK(heap_regs->low_level_trace_lock);
+      return;
+  }
 #ifdef COMMENTED
+  //  if (vsc_count == 218280)
+  //    vsc_xstop = 1;
+  if (vsc_count < 218200) {
+    UNLOCK(heap_regs->low_level_trace_lock);
+    return;
+  }
   if (port != enter_pred ||
       !pred ||
       pred->ArityOfPE != 4 ||

H/Yapproto.h

@@ -10,7 +10,7 @@
 * File:		Yap.proto						 *
 * mods:									 *
 * comments:	Function declarations for YAP				 *
-* version:      $Id: Yapproto.h,v 1.46 2004-02-12 12:37:12 vsc Exp $	 *
+* version:      $Id: Yapproto.h,v 1.47 2004-02-19 19:24:45 vsc Exp $	 *
 *************************************************************************/
 
 /* prototype file for Yap */
@@ -187,7 +187,12 @@ void	STD_PROTO(Yap_InitAsmPred,(char *, unsigned long int, int, CPredicate, int)
 void	STD_PROTO(Yap_InitCmpPred,(char *, unsigned long int, CmpPredicate, int));
 void	STD_PROTO(Yap_InitCPredBack,(char *, unsigned long int, unsigned int, CPredicate,CPredicate,int));
 void	STD_PROTO(Yap_InitWorkspace,(int,int,int,int,int,int));
+
+#if defined(YAPOR) || defined(THREADS)
+void	STD_PROTO(Yap_KillStacks,(int));
+#else
 void	STD_PROTO(Yap_KillStacks,(void));
+#endif
 void	STD_PROTO(Yap_InitYaamRegs,(void));
 void    STD_PROTO(Yap_ReInitWallTime, (void));
 int	STD_PROTO(Yap_OpDec,(int,char *,Atom));

pl/setof.yap

@@ -51,7 +51,8 @@ findall(Template, Generator, Answers, SoFar) :-
 	fail.
 % now wraps it all
 '$findall'(_, _, Ref, SoFar, Answers) :-
-	'$collect_for_findall'(Ref, SoFar, Answers).
+	'$catch'(Error,'$clean_findall'(Ref,Error),_),
+	'$collect_for_findall'(Ref, SoFar, Answers), !.
 
 % error handling: be careful to recover all the space we used up
 % in implementing findall.

pl/threads.yap

@@ -121,7 +121,8 @@ thread_join(Id, Status) :-
 	'$thread_join'(Id0),
 	'$erase_thread_aliases'(Id0),
 	recorded('$thread_exit_status',[Id0|Status],R),
-	erase(R).
+	erase(R),
+	'$thread_destroy'(Id0).
 
 '$erase_thread_aliases'(Id0) :-
 	recorded('$thread_alias',[Id0|_],R),
@@ -305,7 +306,7 @@ message_queue_destroy(Queue) :-
 message_queue_destroy(Name) :-
 	'$do_error'(type_error(atom,Name),message_queue_destroy(Name)).
 
-'$clean_mqueue'(Q) :-
+'$clean_mqueue'(Queue) :-
 	recorded('$msg_queue',q(Queue,_),R),
 	erase(R),
 	fail.