From f6503f0100f1179c8e17e42b9539e482d172bf65 Mon Sep 17 00:00:00 2001
From: vsc <vsc@b08c6af1-5177-4d33-ba66-4b1c6b8b522a>
Date: Tue, 29 Jun 2004 19:04:46 +0000
Subject: [PATCH] fix multithreaded version include new version of Ricardo's
 profiler new predicat atomic_concat allow multithreaded-debugging small fixes

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1085 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
---
 C/absmi.c       |  69 ++++++-----
 C/arrays.c      |   6 +
 C/c_interface.c |   7 +-
 C/cdmgr.c       |  14 ++-
 C/compiler.c    |   8 +-
 C/dbase.c       |  95 ++++++++++-----
 C/grow.c        |  24 ++--
 C/heapgc.c      |   8 +-
 C/index.c       |  49 ++++++--
 C/stdpreds.c    | 314 ++++++++++++++++++++++++++++++------------------
 C/unify.c       |   2 +-
 H/clause.h      |  19 +++
 docs/yap.tex    |  11 +-
 m4/Yap.h.m4     |  10 +-
 pl/checker.yap  |  16 ++-
 pl/debug.yap    |   4 +-
 pl/threads.yap  |  14 ++-
 17 files changed, 455 insertions(+), 215 deletions(-)

diff --git a/C/absmi.c b/C/absmi.c
index cce87d37c..cc112731e 100644
--- a/C/absmi.c
+++ b/C/absmi.c
@@ -10,8 +10,15 @@
 *									 *
 * File:		absmi.c							 *
 * comments:	Portable abstract machine interpreter                    *
-* Last rev:     $Date: 2004-06-23 17:24:19 $,$Author: vsc $						 *
+* Last rev:     $Date: 2004-06-29 19:04:40 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.137  2004/06/23 17:24:19  vsc
+* New comment-based message style
+* Fix thread support (at least don't deadlock with oneself)
+* small fixes for coroutining predicates
+* force Yap to recover space in arrays of dbrefs
+* use private predicates in debugger.
+*
 * Revision 1.136  2004/06/17 22:07:22  vsc
 * bad bug in indexing code.
 *
@@ -94,25 +101,6 @@ AritFunctorOfTerm(Term t) {
 
 #include "arith2.h"
 
-#ifdef THREADS
-static int
-same_lu_block(yamop **paddr, yamop *p)
-{
-  yamop *np = *paddr;
-  if (np != p) {
-    OPCODE jmp_op = Yap_opcode(_jump_if_nonvar);
-
-    while (np->opc == jmp_op) {
-      np = NEXTOP(np, xl);
-      if (np == p) return TRUE;
-    }
-    return FALSE;
-  } else {
-    return TRUE;
-  }
-}
-#endif
-
 #ifdef COROUTINING
 /*
   Imagine we are interrupting the execution, say, because we have a spy
@@ -179,19 +167,36 @@ push_live_regs(yamop *pco)
 #endif
 
 #if LOW_PROF 
+#include <signal.h>
+#include <ucontext.h>
 #include <stdio.h>
-void prof_alrm(int signo)
+
+#define TestMode (GCMode | GrowHeapMode | GrowStackMode | ErrorHandlingMode | InErrorMode | AbortMode)
+int Yap_absmiEND(void);
+void prof_alrm(int signo, siginfo_t *si, ucontext_t *sc);
+
+void prof_alrm(int signo, siginfo_t *si, ucontext_t *sc)
 {
-#ifdef i386
-  fprintf(FProf,"%p\n", PREG);
-#else
-  /* vsc: not really supported for shadow regs */
-  fprintf(FProf,"%p\n", P);
-#endif
+  void * oldpc=(void *) sc->uc_mcontext.gregs[14]; /* 14= REG_EIP */
+
+  if (Yap_PrologMode & TestMode) {
+    fprintf(FProf,"%p %p\n", (void *) (Yap_PrologMode & TestMode), P);
+    return;
+  }
+  
+  //  printf("[%p,%p] -> %p\n", Yap_ABSMI_OPCODES[_try_me], Yap_ABSMI_OPCODES[_p_execute_tail], oldpc);
+  // if (oldpc<(void *) &Yap_absmi || oldpc> (void *) Yap_ABSMI_OPCODES[_p_execute_tail]) { 
+  if (oldpc<(void *) &Yap_absmi || oldpc> (void *) &Yap_absmiEND) { 
+     fprintf(FProf,"%p %p\n", (void *) oldpc, P);
+     return;
+  }
+
+  fprintf(FProf,"0 %p\n", PREG);
   return;
 }
 
 #endif
+
 Int 
 Yap_absmi(int inp)
 {
@@ -1189,13 +1194,16 @@ Yap_absmi(int inp)
       BOp(stale_lu_index, Ill);
       {
 	yamop *ipc;
+#if defined(YAPOR) || defined(THREADS)
 	PredEntry *pe = PREG->u.Ill.l1->u.ld.p;
+#endif
 
 	/* update ASP before calling IPred */
 	ASP = YREG+E_CB;
 	if (ASP > (CELL *) B) {
 	  ASP = (CELL *) B;
 	}
+	saveregs();
 #if defined(YAPOR) || defined(THREADS)
 	LOCK(pe->PELock);
 	if (PP) {
@@ -1209,7 +1217,6 @@ Yap_absmi(int inp)
 	  JMPNext();
 	}
 #endif
-	saveregs();
 	ipc = Yap_CleanUpIndex(PREG->u.Ill.I);
 	setregs();
 	/* restart index */
@@ -11939,4 +11946,8 @@ Yap_absmi(int inp)
 
 }
 
-
+/* dummy function that is needed for profiler */
+int Yap_absmiEND()
+{
+  return 1;
+}
diff --git a/C/arrays.c b/C/arrays.c
index 12ec91023..c005d47fc 100644
--- a/C/arrays.c
+++ b/C/arrays.c
@@ -1562,11 +1562,15 @@ p_assign_static(void)
 
 	if (ptr->Flags & LogUpdMask) {
 	  LogUpdClause *lup = (LogUpdClause *)ptr;
+	  LOCK(lup->ClLock);
 	  lup->ClRefCount--;
 	  if (lup->ClRefCount == 0 &&
 	      (lup->ClFlags & ErasedMask) &&
 	      !(lup->ClFlags & InUseMask)) {
+	    UNLOCK(lup->ClLock);
 	    Yap_ErLogUpdCl(lup);
+	  } else {
+	    UNLOCK(lup->ClLock);
 	  }
 	} else {
 	  ptr->NOfRefsTo--;
@@ -1580,7 +1584,9 @@ p_assign_static(void)
       
       if (p->Flags & LogUpdMask) {
 	LogUpdClause *lup = (LogUpdClause *)p;
+	LOCK(lup->ClLock);
 	lup->ClRefCount++;
+	UNLOCK(lup->ClLock);
       } else {
 	p->NOfRefsTo++;
       }
diff --git a/C/c_interface.c b/C/c_interface.c
index 8801ca807..3e37051ec 100644
--- a/C/c_interface.c
+++ b/C/c_interface.c
@@ -10,8 +10,11 @@
 * File:		c_interface.c						 *
 * comments:	c_interface primitives definition 			 *
 *									 *
-* Last rev:	$Date: 2004-06-09 03:32:02 $,$Author: vsc $						 *
+* Last rev:	$Date: 2004-06-29 19:04:41 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.49  2004/06/09 03:32:02  vsc
+* fix bugs
+*
 * Revision 1.48  2004/06/05 03:36:59  vsc
 * coroutining is now a part of attvars.
 * some more fixes.
@@ -923,11 +926,13 @@ YAP_CompileClause(Term t)
 
   Yap_ErrorMessage = NULL;
   ARG1 = t;
+  YAPEnterCriticalSection();
   codeaddr = Yap_cclause (t,0, mod, t);
   if (codeaddr != NULL) {
     t = Deref(ARG1); /* just in case there was an heap overflow */
     Yap_addclause (t, codeaddr, TRUE, mod);
   }
+  YAPLeaveCriticalSection();
 
   RECOVER_MACHINE_REGS();
   return(Yap_ErrorMessage);
diff --git a/C/cdmgr.c b/C/cdmgr.c
index 03ff1faf3..d899bbb34 100644
--- a/C/cdmgr.c
+++ b/C/cdmgr.c
@@ -11,8 +11,12 @@
 * File:		cdmgr.c							 *
 * comments:	Code manager						 *
 *									 *
-* Last rev:     $Date: 2004-06-05 03:36:59 $,$Author: vsc $						 *
+* Last rev:     $Date: 2004-06-29 19:04:41 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.124  2004/06/05 03:36:59  vsc
+* coroutining is now a part of attvars.
+* some more fixes.
+*
 * Revision 1.123  2004/05/17 21:42:09  vsc
 * misc fixes
 *
@@ -3299,6 +3303,10 @@ p_continue_log_update_clause(void)
   PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1));
   yamop *ipc = (yamop *)IntegerOfTerm(ARG2);
 
+#if defined(YAPOR) || defined(THREADS)
+  READ_LOCK(pe->PRWLock);
+  PP = pe;
+#endif
   return fetch_next_lu_clause(pe, ipc, Deref(ARG3), ARG4, ARG5, B->cp_ap, FALSE);
 }
 
@@ -3395,6 +3403,10 @@ p_continue_log_update_clause0(void)
   PredEntry *pe = (PredEntry *)IntegerOfTerm(Deref(ARG1));
   yamop *ipc = (yamop *)IntegerOfTerm(ARG2);
 
+#if defined(YAPOR) || defined(THREADS)
+  READ_LOCK(pe->PRWLock);
+  PP = pe;
+#endif
   return fetch_next_lu_clause0(pe, ipc, Deref(ARG3), ARG4, B->cp_ap, FALSE);
 }
 
diff --git a/C/compiler.c b/C/compiler.c
index 4e20e3227..c6aa3e116 100644
--- a/C/compiler.c
+++ b/C/compiler.c
@@ -11,8 +11,11 @@
 * File:		compiler.c						 *
 * comments:	Clause compiler						 *
 *									 *
-* Last rev:     $Date: 2004-04-22 20:07:04 $,$Author: vsc $						 *
+* Last rev:     $Date: 2004-06-29 19:04:41 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.50  2004/04/22 20:07:04  vsc
+* more fixes for USE_SYSTEM_MEMORY
+*
 * Revision 1.49  2004/03/10 16:27:39  vsc
 * skip compilation steps for ground facts.
 *
@@ -2748,6 +2751,8 @@ Yap_cclause(Term inp_clause, int NOfArgs, int mod, Term src)
       Int osize = 2*sizeof(CELL)*(ASP-H);
       ARG1 = my_clause;
       *H++ = src;
+
+      YAPLeaveCriticalSection();
       if (!Yap_gcl(Yap_Error_Size, 2, ENV, P)) {
 	Yap_Error_TYPE = OUT_OF_STACK_ERROR;
 	Yap_Error_Term = my_clause;
@@ -2758,6 +2763,7 @@ Yap_cclause(Term inp_clause, int NOfArgs, int mod, Term src)
 	  Yap_Error_Term = my_clause;
 	}
       }
+      YAPEnterCriticalSection();
       src = *--H;
       my_clause = ARG1;
     }
diff --git a/C/dbase.c b/C/dbase.c
index 077f70b29..abf5dc459 100644
--- a/C/dbase.c
+++ b/C/dbase.c
@@ -1933,8 +1933,11 @@ p_rcdap(void)
     }
     goto recover_record;
   case OUT_OF_TRAIL_ERROR:
-    Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
-    return FALSE;
+    if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
+      Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
+      return FALSE;
+    }
+    goto recover_record;
   case OUT_OF_HEAP_ERROR:
     if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
       return FALSE;
@@ -1981,8 +1984,11 @@ p_rcda_at(void)
     }
     goto recover_record;
   case OUT_OF_TRAIL_ERROR:
-    Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
-    return(FALSE);
+    if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
+      Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
+      return FALSE;
+    }
+    goto recover_record;
   case OUT_OF_HEAP_ERROR:
     if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
       return FALSE;
@@ -2037,8 +2043,11 @@ p_rcdz(void)
     }
     goto recover_record;
   case OUT_OF_TRAIL_ERROR:
-    Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
-    return(FALSE);
+    if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
+      Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
+      return FALSE;
+    }
+    goto recover_record;
   case OUT_OF_HEAP_ERROR:
     if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
       return FALSE;
@@ -2076,8 +2085,11 @@ p_rcdzp(void)
     }
     goto recover_record;
   case OUT_OF_TRAIL_ERROR:
-    Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
-    return(FALSE);
+    if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
+      Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
+      return FALSE;
+    }
+    goto recover_record;
   case OUT_OF_HEAP_ERROR:
     if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
       return FALSE;
@@ -2124,8 +2136,11 @@ p_rcdz_at(void)
     }
     goto recover_record;
   case OUT_OF_TRAIL_ERROR:
-    Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recordz_at/3");
-    return(FALSE);
+    if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
+      Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
+      return FALSE;
+    }
+    goto recover_record;
   case OUT_OF_HEAP_ERROR:
     if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
       return FALSE;
@@ -2171,8 +2186,11 @@ p_rcdstatp(void)
     }
     goto recover_record;
   case OUT_OF_TRAIL_ERROR:
-    Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in record_stat_source/3");
-    return FALSE;
+    if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
+      Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
+      return FALSE;
+    }
+    goto recover_record;
   case OUT_OF_HEAP_ERROR:
     if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
       return FALSE;
@@ -2213,8 +2231,11 @@ p_drcdap(void)
     }
     goto recover_record;
   case OUT_OF_TRAIL_ERROR:
-    Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
-    return(FALSE);
+    if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
+      Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
+      return FALSE;
+    }
+    goto recover_record;
   case OUT_OF_HEAP_ERROR:
     if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
       return FALSE;
@@ -2256,8 +2277,11 @@ p_drcdzp(void)
     }
     goto recover_record;
   case OUT_OF_TRAIL_ERROR:
-    Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
-    return(FALSE);
+    if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
+      Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
+      return FALSE;
+    }
+    goto recover_record;
   case OUT_OF_HEAP_ERROR:
     if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
       return FALSE;
@@ -3895,23 +3919,22 @@ static void
 EraseLogUpdCl(LogUpdClause *clau)
 {
   PredEntry *ap;
-#if defined(YAPOR) || defined(THREADS)
-  int i_locked = FALSE;
-#endif
 
   ap = clau->ClPred;
-#if defined(YAPOR) || defined(THREADS)
-  if (WPP != ap) {
-    WRITE_LOCK(ap->PRWLock);
-    if (WPP == NULL) {
-      i_locked = TRUE;
-      WPP = ap;
-    }
-  }
-#endif
   LOCK(clau->ClLock);
   /* no need to erase what has been erased */ 
   if (!(clau->ClFlags & ErasedMask)) {
+#if defined(YAPOR) || defined(THREADS)
+    int i_locked = FALSE;
+
+    if (WPP != ap) {
+      WRITE_LOCK(ap->PRWLock);
+      if (WPP == NULL) {
+	i_locked = TRUE;
+	WPP = ap;
+      }
+    }
+#endif
     /* get ourselves out of the list */
     if (clau->ClNext != NULL) {
       LOCK(clau->ClNext->ClLock);
@@ -3962,15 +3985,15 @@ EraseLogUpdCl(LogUpdClause *clau)
     /* release the extra reference */
     LOCK(clau->ClLock);
     clau->ClRefCount--;
-  }
-  UNLOCK(clau->ClLock);
-  complete_lu_erase(clau);
 #if defined(YAPOR) || defined(THREADS)
     if (WPP != ap || i_locked) {
       if (i_locked) WPP= NULL;
       WRITE_UNLOCK(ap->PRWLock);
     }
 #endif
+  }
+  UNLOCK(clau->ClLock);
+  complete_lu_erase(clau);
 }
 
 static void
@@ -4700,8 +4723,14 @@ StoreTermInDB(Term t, int nargs)
 	break;
       }
     case OUT_OF_TRAIL_ERROR:
-      Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
-      return(FALSE);
+      XREGS[nargs+1] = t;
+      if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) {
+	Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
+	return FALSE;
+      } else {
+	t = Deref(XREGS[nargs+1]);
+	break;
+      }      
     case OUT_OF_HEAP_ERROR:
       XREGS[nargs+1] = t;
       if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
diff --git a/C/grow.c b/C/grow.c
index f56dd907e..f221a9fe6 100644
--- a/C/grow.c
+++ b/C/grow.c
@@ -540,9 +540,9 @@ static_growheap(long size, int fix_code, struct intermediates *cip)
     UNLOCK(SignalLock);
   }
   ASP -= 256;
+  YAPEnterCriticalSection();
   TrDiff = LDiff = GDiff = DelayDiff = size;
   XDiff = HDiff = 0;
-  YAPEnterCriticalSection();
   SetHeapRegs();
   MoveLocalAndTrail();
   if (fix_code) {
@@ -590,9 +590,9 @@ static_growglobal(long size, CELL **ptr)
     fprintf(Yap_stderr, "[DO]   growing the stacks %ld bytes\n", size);
   }
   ASP -= 256;
+  YAPEnterCriticalSection();
   TrDiff = LDiff = GDiff = size;
   XDiff = HDiff = DelayDiff = 0;
-  YAPEnterCriticalSection();
   SetHeapRegs();
   MoveLocalAndTrail();
   MoveGlobalOnly();
@@ -733,7 +733,12 @@ do_growheap(int fix_code, UInt in_size, struct intermediates *cip)
 int
 Yap_growheap(int fix_code, UInt in_size, void *cip)
 {
-  return do_growheap(fix_code, in_size, (struct intermediates *)cip);
+  int res;
+
+  Yap_PrologMode |= GrowHeapMode;
+  res=do_growheap(fix_code, in_size, (struct intermediates *)cip);
+  Yap_PrologMode &= ~GrowHeapMode;
+  return res;
 }
 
 int
@@ -765,6 +770,7 @@ execute_growstack(long size, int from_trail)
     strncat(Yap_ErrorMessage,": local crashed against global", MAX_ERROR_MSG_SIZE);
     return(FALSE);
   }
+  YAPEnterCriticalSection();  
   XDiff = HDiff = 0;
   GDiff = DelayDiff = Yap_GlobalBase-MyGlobalBase;
 #if USE_SYSTEM_MALLOC
@@ -780,7 +786,6 @@ execute_growstack(long size, int from_trail)
     Yap_GlobalBase = (char *)MyGlobalBase;
   }
   ASP -= 256;
-  YAPEnterCriticalSection();
   if (GDiff) {
     SetHeapRegs();
   } else {
@@ -841,7 +846,12 @@ growstack(long size)
 int
 Yap_growstack(long size)
 {
-  return growstack(size);
+  int res;
+
+  Yap_PrologMode |= GrowStackMode;
+  res=growstack(size);
+  Yap_PrologMode &= ~GrowStackMode;
+  return res;
 }
 
 static void
@@ -943,10 +953,10 @@ Yap_growstack_in_parser(tr_fr_ptr *old_trp, TokEntry **tksp, VarEntry **vep)
 	       (unsigned long int)(TR-(tr_fr_ptr)Yap_TrailBase),Yap_TrailBase,TR);
     fprintf(Yap_stderr, "%%  growing the stacks %ld bytes\n", size);
   }
-  TrDiff = LDiff = size;
-  XDiff = HDiff = GDiff = DelayDiff = 0;
   ASP -= 256;
   YAPEnterCriticalSection();
+  TrDiff = LDiff = size;
+  XDiff = HDiff = GDiff = DelayDiff = 0;
   SetStackRegs();
   MoveLocalAndTrail();
   AdjustScannerStacks(tksp, vep);
diff --git a/C/heapgc.c b/C/heapgc.c
index 0636e35e8..cca7d7bdd 100644
--- a/C/heapgc.c
+++ b/C/heapgc.c
@@ -3172,7 +3172,7 @@ p_inform_gc(void)
 static int
 call_gc(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop)
 {
-  UInt   gc_margin = 128;
+  UInt   gc_margin = MinStackGap;
   Term   Tgc_margin;
   Int    effectiveness = 0;
   int    gc_on = FALSE;
@@ -3225,7 +3225,11 @@ call_gc(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop)
 int 
 Yap_gc(Int predarity, CELL *current_env, yamop *nextop)
 {
-  return call_gc(4096, predarity, current_env, nextop);
+  int res;
+  Yap_PrologMode |= GCMode;
+  res=call_gc(4096, predarity, current_env, nextop);
+  Yap_PrologMode &= ~GCMode;
+  return res;
 }
 
 int 
diff --git a/C/index.c b/C/index.c
index b0fd8f844..e6e439321 100644
--- a/C/index.c
+++ b/C/index.c
@@ -11,8 +11,11 @@
 * File:		index.c							 *
 * comments:	Indexing a Prolog predicate				 *
 *									 *
-* Last rev:     $Date: 2004-06-17 22:07:23 $,$Author: vsc $						 *
+* Last rev:     $Date: 2004-06-29 19:04:42 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.91  2004/06/17 22:07:23  vsc
+* bad bug in indexing code.
+*
 * Revision 1.90  2004/04/29 03:44:04  vsc
 * fix bad suspended clause counter
 *
@@ -5240,15 +5243,20 @@ replace_lu_block(LogUpdIndex *blk, int flag, PredEntry *ap, yamop *code, int has
   {
     LogUpdIndex *idx = ncl->ChildIndex = blk->ChildIndex;
     while (idx) {
+      LogUpdIndex *nidx;
+
+      LOCK(idx->ClLock);
       blk->ClRefCount--;
       ncl->ClRefCount++;
-      idx = idx->SiblingIndex;
+      idx->u.ParentIndex = ncl;
+      nidx = idx->SiblingIndex;
+      UNLOCK(idx->ClLock);
+      idx = nidx;
     }
   }
   blk->ChildIndex = NULL;
   ncl->ClSize = sz;
   INIT_LOCK(ncl->ClLock);
-  INIT_CLREF_COUNT(ncl);
   nbegin = ncl->ClCode;
   begin = blk->ClCode;
   while (jnvs--) {
@@ -5311,7 +5319,13 @@ clean_up_index(LogUpdIndex *blk, yamop **jlbl, PredEntry *ap)
 {
   yamop *codep = blk->ClCode;
 
-  if (blk->ClFlags & InUseMask) {
+  if (
+#if defined(THREADS) || defined(YAPOR)
+      blk->ClRefCount      
+#else
+      blk->ClFlags & InUseMask
+#endif
+      ) {
     yamop *new;
 
     if ((new = replace_lu_block(blk, REFRESH, ap, NULL, FALSE)) == NULL) {
@@ -5377,7 +5391,13 @@ insertz_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
     LogUpdClause *tgl = ClauseCodeToLogUpdClause(code);
 
     if (begin->opc != Yap_opcode(_stale_lu_index)) {
-      if (blk->ClFlags & InUseMask) {
+      if (
+#if defined(THREADS) || defined(YAPOR)
+	  blk->ClRefCount      
+#else
+	  blk->ClFlags & InUseMask
+#endif
+	  ) {
 	begin->opc = Yap_opcode(_stale_lu_index);
       } else {
 	/* we need to rebuild the code */
@@ -6935,7 +6955,7 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
     case _stale_lu_index:
 #if defined(YAPOR) || defined(THREADS)
       LOCK(ap->PELock);
-      if (*jlbl != ipc) {
+      if (!same_lu_block(jlbl, ipc)) {
 	ipc = *jlbl;
 	UNLOCK(ap->PELock);
 	break;
@@ -7000,7 +7020,7 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
       break;
     case _jump_if_nonvar:
       {
-	Term t = Deref(XREGS[arg_from_x(ipc->u.xllll.x)]);
+	Term t = Deref(XREGS[arg_from_x(ipc->u.xl.x)]);
 	if (!IsVarTerm(t)) {
 	  jlbl = &(ipc->u.xl.l);
 	  ipc = ipc->u.xl.l;
@@ -7144,7 +7164,7 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
       H += 3;
 #if defined(YAPOR) || defined(THREADS)
       LOCK(ap->PELock);
-      if (*jlbl != ipc) {
+      if (!same_lu_block(jlbl, ipc)) {
 	ipc = *jlbl;
 	UNLOCK(ap->PELock);
 	break;
@@ -7315,7 +7335,7 @@ Yap_NthClause(PredEntry *ap, Int ncls)
     case _stale_lu_index:
 #if defined(YAPOR) || defined(THREADS)
       LOCK(ap->PELock);
-      if (*jlbl != ipc) {
+      if (!same_lu_block(jlbl, ipc)) {
 	ipc = *jlbl;
 	UNLOCK(ap->PELock);
 	break;
@@ -7636,6 +7656,9 @@ find_caller(PredEntry *ap, yamop *code) {
 	alt = NULL;
       }
       break;
+    case _lock_lu:
+      ipc = NEXTOP(ipc,p);
+      break;
     case _stale_lu_index:
       /* found myself */
       return NULL;
@@ -7663,7 +7686,13 @@ Yap_CleanUpIndex(LogUpdIndex *blk)
     tblk = tblk->u.ParentIndex;
   ap = tblk->u.pred;
 
-  if (blk->ClFlags & InUseMask) {
+  if (
+#if defined(THREADS) || defined(YAPOR)
+      blk->ClRefCount      
+#else
+      blk->ClFlags & InUseMask      
+#endif
+      ) {
     /* I have to kill this block */
     yamop **caller, *new;
     caller = find_caller(ap, blk->ClCode);
diff --git a/C/stdpreds.c b/C/stdpreds.c
index 831113b1f..7622d3250 100644
--- a/C/stdpreds.c
+++ b/C/stdpreds.c
@@ -11,8 +11,11 @@
 * File:		stdpreds.c						 *
 * comments:	General-purpose C implemented system predicates		 *
 *									 *
-* Last rev:     $Date: 2004-06-16 14:12:53 $,$Author: vsc $						 *
+* Last rev:     $Date: 2004-06-29 19:04:42 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.69  2004/06/16 14:12:53  vsc
+* miscellaneous fixes
+*
 * Revision 1.68  2004/05/14 17:11:30  vsc
 * support BigNums in interface
 *
@@ -111,6 +114,7 @@ STD_PROTO(static Int p_walltime, (void));
 STD_PROTO(static Int p_access_yap_flags, (void));
 STD_PROTO(static Int p_set_yap_flags, (void));
 
+
 #ifdef LOW_PROF
 
 #define TIMER_DEFAULT 100
@@ -139,82 +143,12 @@ static Int order=0;
   }
 }
 
-#if defined(__linux__)
-
-static void
-prof_alrm_OLD(int signo)
-{
-  //  printf("%p %p\n", Yap_regp->P_,P);
-  fprintf(FProf,"%p\n", Yap_regp->P_);
-  return;
-}
-
-extern void prof_alrm(int signo);
-
-static Int start_profilers(int msec)
-{
-  struct itimerval t;
-  
-  if (ProfilerOn==msec) return(TRUE);
-
-  if (ProfilerOn) {
-    setitimer(ITIMER_PROF,NULL,NULL);
-    fclose(FPreds);
-    fclose(FProf);
-    ProfilerOn = 0;
-    return TRUE;
-  }
-
-  if (signal(SIGPROF,prof_alrm) == SIG_ERR) {
-    return FALSE;
-  }
-
-  FPreds=fopen("PROFPREDS","w+"); 
-  if (FPreds == NULL) return FALSE;
-  FProf=fopen("PROFILING","w+"); 
-  if (FProf==NULL) { fclose(FPreds); return FALSE; }
-
-  Yap_dump_code_area_for_profiler();
-  
-  t.it_interval.tv_sec=0;
-  t.it_interval.tv_usec=msec;
-  t.it_value.tv_sec=0;
-  t.it_value.tv_usec=msec;
-  setitimer(ITIMER_PROF,&t,NULL);
-
-  ProfilerOn = msec;
-  return(TRUE);
-}
-
-#endif /* Linux */
-
-static Int useprof(void) { 
-#if defined(__linux__)
-  Term p;
-  p=Deref(ARG1);
-  return(start_profilers(IntOfTerm(p)));
-#else
-  return(FALSE);
-#endif
-}
-
-static Int useprof0(void) { 
-#if defined(__linux__)
-  return(start_profilers(TIMER_DEFAULT));
-#else
-  return(FALSE);
-#endif
-}
-
-#if defined(__linux__)
-
 typedef struct clause_entry {
   yamop *beg, *end;
   PredEntry *pp;
   UInt pcs;  /* counter with total for each clause */
-  UInt pca;  /* counter with total for each predicate (repeats for each clause)*/  
-  Int ts; /* start end timestamp towards retracts, eventually */
-  Int tf;
+  UInt pca;  /* counter with total for each predicate (repeated for each clause)*/  
+  Int ts;    /* start end timestamp towards retracts, eventually */
 } clauseentry;
 
 static int
@@ -267,18 +201,29 @@ search_pc_pred(yamop *pc_ptr,clauseentry *beg, clauseentry *end) {
   }
 }
 
+extern void Yap_InitAbsmi(void);
+extern int rational_tree_loop(CELL *pt0, CELL *pt0_end, CELL **to_visit0);
+
+#ifndef ANALYST
+static char *op_names[_std_top + 1] =
+{
+#define OPCODE(OP,TYPE) #OP
+#include "YapOpcodes.h"
+#undef  OPCODE
+};
+#else
+extern char *op_names[];
+#endif
+
+static Int profend(void); 
+
 static int
 showprofres(UInt type) { 
-  clauseentry *pr=(clauseentry *) TR, *t, *t2;
-  UInt count=0, ProfCalls=0;
-  yamop *pc_ptr;
+  clauseentry *pr, *t, *t2;
+  UInt count=0, ProfCalls=0, InGrowHeap=0, InGrowStack=0, InGC=0, InError=0, InUnify=0, InCCall=0;
+  yamop *pc_ptr,*y; void *oldpc;
 
-  if (ProfilerOn) {
-    setitimer(ITIMER_PROF,NULL,NULL);
-    fclose(FPreds);
-    fclose(FProf);
-    ProfilerOn = 0;
-  }  
+  profend(); /* Make sure profiler has ended */
 
   /* First part: Read information about predicates and store it on yap trail */
 
@@ -286,6 +231,7 @@ showprofres(UInt type) {
   if (FPreds == NULL) return FALSE;
 
   ProfPreds=0;
+  pr=(clauseentry *) TR;
   while (fscanf(FPreds,"+%p %p %p %d",&(pr->beg),&(pr->end),&(pr->pp),&(pr->ts)) > 0){
     int c;
     pr->pcs = 0L;
@@ -311,20 +257,46 @@ showprofres(UInt type) {
 
   t2=NULL;
   ProfCalls=0;
-  while(fscanf(FProf,"%p\n",&pc_ptr) >0){
+  while(fscanf(FProf,"%p %p\n",&oldpc, &pc_ptr) >0){
     if (type<10) ProfCalls++;
+    
+    if (oldpc!=0 && type<=2) {
+      if ((unsigned long)oldpc< 70000) {
+        if ((unsigned long) oldpc & GrowHeapMode) { InGrowHeap++; continue; }
+        if ((unsigned long)oldpc & GrowStackMode) { InGrowStack++; continue; }
+        if ((unsigned long)oldpc & GCMode) { InGC++; continue; }
+        if ((unsigned long)oldpc & (ErrorHandlingMode | InErrorMode)) { InError++; continue; }
+      }
+      if (oldpc>(void *) rational_tree_loop && oldpc<(void *) Yap_InitAbsmi) { InUnify++; continue; }
+      y=(yamop *) ((long) pc_ptr-20);
+      if ((void *) y->opc==Yap_ABSMI_OPCODES[_call_cpred] || (void *) y->opc==Yap_ABSMI_OPCODES[_call_usercpred]) {
+             InCCall++;  /* I Was in a C Call */
+	     pc_ptr=y;
+    	     /* 
+	      printf("Aqui está um call_cpred(%p) \n",y->u.sla.sla_u.p->cs.f_code);
+              for(i=0;i<_std_top && pc_ptr->opc!=Yap_ABSMI_OPCODES[i];i++);
+      	         printf("Outro syscall diferente  %s\n", op_names[i]);
+             */
+             continue;
+       } 
+       /* I should never get here, but since I'm, it is certanly Unknown Code, so 
+	  continue running to try to count it as Prolog Code  */
+    }
+   
     t=search_pc_pred(pc_ptr,(clauseentry *)TR,pr);
     if (t!=NULL) { /* pc was found */
-      if (type<10) t->pcs++;
-      else {
-	if (t->pp==(PredEntry *)type) {
-	  ProfCalls++;
-	  if (t2!=NULL) t2->pcs++;
-	}
-      } 
-      t2=t;
-    } 
+        if (type<10) t->pcs++;
+        else {
+	  if (t->pp==(PredEntry *)type) {
+	    ProfCalls++;
+	    if (t2!=NULL) t2->pcs++;
+	  }
+        } 
+        t2=t;
+    }
+
   }
+
   fclose(FProf);
   if (ProfCalls==0) return(FALSE);
 
@@ -346,7 +318,9 @@ showprofres(UInt type) {
   }
 
   /* counting done: now it is time to present the results */
+  fflush(stdout);
 
+  /*
   if (type>10) {
     PredEntry *myp = (PredEntry *)type;
     if (myp->FunctorOfPred->KindOfPE==47872) {
@@ -357,8 +331,9 @@ showprofres(UInt type) {
     }    
     type=1;
   }
+  */
 
-  if (type==0) {  /* Results by predicate */
+  if (type==0 || type==1 || type==3) {  /* Results by predicate */
     t = (clauseentry *)TR;
     while (t < pr) {
       UInt calls=t->pca;
@@ -374,10 +349,6 @@ showprofres(UInt type) {
       }
       while (t<pr && t->pp == myp) t++;
     }
-    count=ProfCalls-count;
-    if (count>0) printf("Unknown:Unknown -> %u (%3.1f%c)\n",count,(float) count*100/ProfCalls,'%');
-    printf("Total of Calls=%u \n",ProfCalls);
-
   } else { /* Results by clauses */
     t = (clauseentry *)TR;
     while (t < pr) {
@@ -403,35 +374,109 @@ showprofres(UInt type) {
       }
       t++;
     }
-    count=ProfCalls-count;
-    if (count>0) printf("Unknown:Unknown -> %u (%3.1f%c)\n",count,(float) count*100/ProfCalls,'%');
-    printf("Total of Calls=%u \n",ProfCalls);
-
-  } 
+  }
+  count=ProfCalls-(count+InGrowHeap+InGrowStack+InGC+InError+InUnify+InCCall); // Falta +InCCall
+  if (InGrowHeap>0) printf("%p sys: GrowHeap -> %u (%3.1f%c)\n",(void *) GrowHeapMode,InGrowHeap,(float) InGrowHeap*100/ProfCalls,'%');
+  if (InGrowStack>0) printf("%p sys: GrowStack -> %u (%3.1f%c)\n",(void *) GrowStackMode,InGrowStack,(float) InGrowStack*100/ProfCalls,'%');
+  if (InGC>0) printf("%p sys: GC -> %u (%3.1f%c)\n",(void *) GCMode,InGC,(float) InGC*100/ProfCalls,'%');
+  if (InError>0) printf("%p sys: ErrorHandling -> %u (%3.1f%c)\n",(void *) ErrorHandlingMode,InError,(float) InError*100/ProfCalls,'%');
+  if (InUnify>0) printf("%p sys: Unify -> %u (%3.1f%c)\n",(void *) UnifyMode,InUnify,(float) InUnify*100/ProfCalls,'%');
+  if (InCCall>0) printf("%p sys: C Code -> %u (%3.1f%c)\n",(void *) CCallMode,InCCall,(float) InCCall*100/ProfCalls,'%');
+  if (count>0) printf("Unknown:Unknown -> %u (%3.1f%c)\n",count,(float) count*100/ProfCalls,'%');
+  printf("Total of Calls=%u \n",ProfCalls);
 
   return TRUE;
 }
 
-#endif /*Linux */
 
 
+
+static Int profinit(void)
+{
+  if (ProfilerOn!=0) return (FALSE);
+
+  FPreds=fopen("PROFPREDS","w+"); 
+  if (FPreds == NULL) return FALSE;
+  FProf=fopen("PROFILING","w+"); 
+  if (FProf==NULL) { fclose(FPreds); return FALSE; }
+
+  Yap_dump_code_area_for_profiler();
+  
+  ProfilerOn = -1; /* Inited but not yet started */
+  return(TRUE);
+}
+
+extern void prof_alrm(int signo, siginfo_t *si, void *sc);
+
+static Int start_profilers(int msec)
+{
+  struct itimerval t;
+  struct sigaction sa;
+  
+  if (ProfilerOn!=-1) return (FALSE); /* have to go through profinit */
+
+  sa.sa_sigaction=prof_alrm;
+  sigemptyset(&sa.sa_mask);
+  sa.sa_flags=SA_SIGINFO;
+  if (sigaction(SIGPROF,&sa,NULL)== -1) return FALSE;
+//  if (signal(SIGPROF,prof_alrm) == SIG_ERR) return FALSE;
+
+  t.it_interval.tv_sec=0;
+  t.it_interval.tv_usec=msec;
+  t.it_value.tv_sec=0;
+  t.it_value.tv_usec=msec;
+  setitimer(ITIMER_PROF,&t,NULL);
+
+  ProfilerOn = msec;
+  return(TRUE);
+}
+
+
+static Int profon(void) { 
+  Term p;
+  p=Deref(ARG1);
+  return(start_profilers(IntOfTerm(p)));
+}
+
+static Int profon0(void) { 
+  return(start_profilers(TIMER_DEFAULT));
+}
+
+static Int profoff(void) {
+  if (ProfilerOn>0) {
+    setitimer(ITIMER_PROF,NULL,NULL);
+    ProfilerOn = -1;
+    return TRUE;
+  }
+  return FALSE;
+}
+
+static Int profalt(void) { 
+  if (ProfilerOn==0) return(FALSE);
+  if (ProfilerOn==-1) return profon();
+  return profoff();
+}
+
+static Int profend(void) 
+{
+  if (ProfilerOn==0) return(FALSE);
+  profoff();         /* Make sure profiler is off */
+  fclose(FPreds); 
+  fclose(FProf); 
+  ProfilerOn=0;
+
+  return (TRUE);
+}
+
 static Int profres(void) { 
-#if defined(__linux__)
   Term p;
   p=Deref(ARG1);
   if (IsLongIntTerm(p)) return(showprofres(LongIntOfTerm(p)));
   else return(showprofres(IntOfTerm(p)));
-#else
-  return(FALSE);
-#endif
 }
 
 static Int profres0(void) { 
-#if defined(__linux__)
   return(showprofres(0));
-#else
-  return(FALSE);
-#endif
 }
 
 #endif /* LOW_PROF */
@@ -1097,7 +1142,7 @@ p_atomic_concat(void)
     }
     if (!IsAtomicTerm(thead)) {
       Yap_ReleasePreAllocCodeSpace((ADDR)cpt0);
-      Yap_Error(TYPE_ERROR_ATOM, ARG1, "atom_concat/2");
+      Yap_Error(TYPE_ERROR_ATOMIC, ARG1, "atom_concat/2");
       return(FALSE);
     }
     if (IsAtomTerm(thead)) {
@@ -1110,12 +1155,41 @@ p_atomic_concat(void)
 	  Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
 	  return(FALSE);
 	}
-      } else if (IsIntegerTerm(thead)) {
+	goto restart;
+      } 
+      memcpy((void *)cptr, (void *)atom_str, sz);
+      cptr += sz;
+    } else if (IsIntegerTerm(thead)) {
+#if HAVE_SNPRINTF
+      snprintf(cptr, (top-cptr)-1024,"%ld", (long int)IntegerOfTerm(thead));
+#else
+      sprintf(cptr,"%ld", IntegerOfTerm(thead));
+#endif
+      while (*cptr && cptr < top-1024) cptr++;
+    } else if (IsFloatTerm(thead)) {
+#if HAVE_SNPRINTF
+      snprintf(cptr,(top-cptr)-1024,"%g", FloatOfTerm(thead));
+#else
+      sprintf(cptr,"%g", FloatOfTerm(thead));
+#endif
+      while (*cptr && cptr < top-1024) cptr++;
+#if USE_GMP
+    } else if (IsBigIntTerm(thead)) {
+      MP_INT *n = Yap_BigIntOfTerm(thead);
+      int sz;
+
+      if ((sz = mpz_sizeinbase (n, 10)) > (top-cptr)-1024) {
+	Yap_ReleasePreAllocCodeSpace((ADDR)cpt0);
+	if (!Yap_growheap(FALSE, sz+1024, NULL)) {
+	  Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
+	  return(FALSE);
+	}
+	goto restart;
       }
-      goto restart;
+      mpz_get_str(cptr, 10, n);
+      while (*cptr) cptr++;
+#endif
     }
-    memcpy((void *)cptr, (void *)atom_str, sz);
-    cptr += sz;
     t1 = TailOfTerm(t1);
     if (IsVarTerm(t1)) {
       Yap_ReleasePreAllocCodeSpace((ADDR)cpt0);
@@ -2785,8 +2859,12 @@ Yap_InitCPreds(void)
   Yap_InitCPred("$hidden", 1, p_hidden, SafePredFlag|SyncPredFlag);
   Yap_InitCPred("$has_yap_or", 0, p_has_yap_or, SafePredFlag|SyncPredFlag);
 #ifdef LOW_PROF
-  Yap_InitCPred("useprof", 1, useprof, SafePredFlag);
-  Yap_InitCPred("useprof", 0, useprof0, SafePredFlag);
+  Yap_InitCPred("profinit",0, profinit, SafePredFlag);
+  Yap_InitCPred("profend" ,0, profend, SafePredFlag);
+  Yap_InitCPred("profon" , 0, profon0, SafePredFlag);
+  Yap_InitCPred("profon" , 1, profon, SafePredFlag);
+  Yap_InitCPred("profoff", 0, profoff, SafePredFlag);
+  Yap_InitCPred("profalt", 0, profalt, SafePredFlag);
   Yap_InitCPred("profres", 1, profres, SafePredFlag);
   Yap_InitCPred("profres", 0, profres0, SafePredFlag);
 #endif
diff --git a/C/unify.c b/C/unify.c
index b046f2efb..5b9500d68 100644
--- a/C/unify.c
+++ b/C/unify.c
@@ -26,7 +26,7 @@ STATIC_PROTO(int    rtable_hash_op, (OPCODE));
 STATIC_PROTO(void   InitReverseLookupOpcode, (void));
 #endif
 
-static int
+int
 rational_tree_loop(CELL *pt0, CELL *pt0_end, CELL **to_visit0)
 {
   CELL **to_visit = to_visit0;
diff --git a/H/clause.h b/H/clause.h
index 97d7a8a99..ad087b2fe 100644
--- a/H/clause.h
+++ b/H/clause.h
@@ -231,3 +231,22 @@ Yap_op_from_opcode(OPCODE opc)
 }
 #endif /* USE_THREADED_CODE */
 
+#if defined(YAPOR) || defined(THREADS)
+static int
+same_lu_block(yamop **paddr, yamop *p)
+{
+  yamop *np = *paddr;
+  if (np != p) {
+    OPCODE jmp_op = Yap_opcode(_jump_if_nonvar);
+
+    while (np->opc == jmp_op) {
+      np = NEXTOP(np, xl);
+      if (np == p) return TRUE;
+    }
+    return FALSE;
+  } else {
+    return TRUE;
+  }
+}
+#endif
+
diff --git a/docs/yap.tex b/docs/yap.tex
index 23380e675..8db2bd35e 100644
--- a/docs/yap.tex
+++ b/docs/yap.tex
@@ -2688,12 +2688,21 @@ codes for the characters of the external representation of @var{A}.
 
 @item atom_concat(+@var{As},?@var{A})
 @findex atom_concat/2
-@snindex atom_concat/2
+@syindex atom_concat/2
 @cnindex atom_concat/2
 The predicate holds when the first argument is a list of atoms, and the
 second unifies with the atom obtained by concatenating all the atoms in
 the first list.
 
+@item atomic_concat(+@var{As},?@var{A})
+@findex atomic_concat/2
+@snindex atomic_concat/2
+@cnindex atomic_concat/2
+The predicate holds when the first argument is a list of atoms, and
+the second unifies with the atom obtained by concatenating all the
+atomic terms in the first list. The first argument thus may contain
+atoms or numbers.
+
 @item atom_concat(+@var{A1},+@var{A2},?@var{A})
 @findex atom_concat/3
 @syindex atom_concat/3
diff --git a/m4/Yap.h.m4 b/m4/Yap.h.m4
index 65808c829..7bddbc876 100644
--- a/m4/Yap.h.m4
+++ b/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.57 2004-04-22 20:07:07 vsc Exp $	 *
+* version:      $Id: Yap.h.m4,v 1.58 2004-06-29 19:04:45 vsc Exp $	 *
 *************************************************************************/
 
 #include "config.h"
@@ -893,7 +893,13 @@ typedef enum {
   InterruptMode = 16,		/* under an interrupt */
   InErrorMode = 32,		/* under an interrupt */
   ConsoleGetcMode = 64,		/* blocked reading from console */
-  ExtendStackMode = 128		/* trying to extend stack */
+  ExtendStackMode = 128,	/* trying to extend stack */
+  GrowHeapMode      = 256,      /* extending Heap  */
+  GrowStackMode     = 512,      /* extending Stack */
+  GCMode            = 1024,     /* doing Garbage Collecting */
+  ErrorHandlingMode = 2048,     /* doing error handling */
+  CCallMode         = 4096,     /* In c Call */
+  UnifyMode         = 8192      /* In Unify Code */
 } prolog_exec_mode;
 
 extern prolog_exec_mode      Yap_PrologMode;
diff --git a/pl/checker.yap b/pl/checker.yap
index 3d8a92048..18000d9ad 100644
--- a/pl/checker.yap
+++ b/pl/checker.yap
@@ -11,8 +11,14 @@
 * File:		checker.yap						 *
 * comments:	style checker for Prolog				 *
 *									 *
-* Last rev:     $Date: 2004-03-19 11:35:42 $,$Author: vsc $						 *
-* $Log: not supported by cvs2svn $                                                                  *
+* Last rev:     $Date: 2004-06-29 19:04:46 $,$Author: vsc $						 *
+* $Log: not supported by cvs2svn $
+* Revision 1.13  2004/03/19 11:35:42  vsc
+* trim_trail for default machine
+* be more aggressive about try-retry-trust chains.
+*    - handle cases where block starts with a wait
+*    - don't use _killed instructions, just let the thing rot by itself.
+*                                                                  *
 *									 *
 *************************************************************************/
 
@@ -28,10 +34,16 @@ style_check(all) :- '$syntax_check_mode'(_,on),
 	'$syntax_check_multiple'(_,on).
 style_check(single_var) :- '$syntax_check_mode'(_,on),
 	'$syntax_check_single_var'(_,on).
+style_check(-single_var) :-
+	no_style_check(single_var).
 style_check(discontiguous) :- '$syntax_check_mode'(_,on),
 	'$syntax_check_discontiguous'(_,on).
+style_check(-discontiguous) :-
+	no_style_check(discontiguous).
 style_check(multiple) :- '$syntax_check_mode'(_,on),
 	'$syntax_check_multiple'(_,on).
+style_check(-multiple) :-
+	no_style_check(multiple).
 style_check([]).
 style_check([H|T]) :- style_check(H), style_check(T).
 
diff --git a/pl/debug.yap b/pl/debug.yap
index 2b18d5946..f650f0ce3 100644
--- a/pl/debug.yap
+++ b/pl/debug.yap
@@ -379,7 +379,7 @@ debugging :-
 '$continue_avoid_goal'(_, G, Module, _) :-
     recorded('$spy_stop', on, _), !,
     \+ '$pred_being_spied'(G, Module).
-% fpr skip keep on going until we get back.
+% for skip keep on going until we get back.
 '$continue_avoid_goal'(GoalNumber, _, _, Value) :-
     number(Value),
     Value < GoalNumber.
@@ -509,7 +509,7 @@ debugging :-
 '$action'(0'n,_,_,_,_) :- !,			% n		nodebug
 	'$skipeol'(0'n),
 	'$set_yap_flags'(10,0),
-	( recorded('$spy_stop',_,R), erase(R), fail ; true).
+	( recorded('$spy_stop',_,R), erase(R), fail ; true),
 	nodebug.
 '$action'(0'k,_,CallNumber,_,_) :- !,		% k		quasi leap
 	'$skipeol'(0'k),
diff --git a/pl/threads.yap b/pl/threads.yap
index a611b8f68..1f6015c35 100644
--- a/pl/threads.yap
+++ b/pl/threads.yap
@@ -25,7 +25,8 @@
 '$init_thread0' :-
 	no_threads, !.
 '$init_thread0' :-
-	'$create_mq'(0).
+	'$create_mq'(0),
+	'$add_thread_aliases'([main], 0).
 	
 
 '$top_thread_goal'(G, Detached) :-
@@ -281,7 +282,7 @@ message_queue_create(Cond) :-
 	recorda('$queue',q(Cond,Mutex,Cond,CName), _).
 message_queue_create(Name) :-
 	atom(Name),
-	recorded('$thread_alias',[Name|_],_), !,
+	recorded('$thread_alias',[_,Name],_), !,
 	'$do_error'(permission_error(create,queue,Name),message_queue_create(Name)).
 message_queue_create(Name) :-
 	atom(Name), !,
@@ -323,9 +324,9 @@ message_queue_destroy(Name) :-
 	erase(R),
 	fail.
 '$clean_mqueue'(_).
-	
+
 thread_send_message(Queue, Term) :-
-	recorded('$thread_alias',[Queue|Id],_), !,
+	recorded('$thread_alias',[Id|Queue],_), !,
 	thread_send_message(Id, Term).
 thread_send_message(Queue, Term) :-
 	recorded('$queue',q(Queue,Mutex,Cond,Key),_),
@@ -338,6 +339,9 @@ thread_get_message(Term) :-
 	'$thread_self'(Id),
 	thread_get_message(Id, Term).
 
+thread_get_message(Queue, Term) :-
+	recorded('$thread_alias',[Id|Queue],_), !,
+	thread_get_message(Id, Term).
 thread_get_message(Queue, Term) :-
 	recorded('$queue',q(Queue,Mutex,Cond,Key),_),
 	mutex_lock(Mutex),
@@ -396,7 +400,7 @@ thread_signal(Thread, Goal) :-
 	var(Thread), !,
 	'$do_error'(instantiation_error,thread_signal(Thread, Goal)).
 thread_signal(Thread, Goal) :-
-	recorded('$thread_alias',[Thread|Id],_),
+	recorded('$thread_alias',[Id|Thread],_),
 	'$thread_signal'(Id, Goal).
 thread_signal(Thread, Goal) :-
 	integer(Thread), !,