Mutex stuff movibg to C

C/errors.c

@@ -1075,6 +1075,20 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
       serious = TRUE;
     }
     break;
+  case EXISTENCE_ERROR_MUTEX:
+    {
+      int i;
+      Term ti[2];
+
+      i = strlen(tmpbuf);
+      ti[0] = MkAtomTerm(AtomMutex);
+      ti[1] = where;
+      nt[0] = Yap_MkApplTerm(FunctorExistenceError, 2, ti);
+      psize -= i;
+      fun = FunctorError;
+      serious = TRUE;
+    }
+    break;
   case EXISTENCE_ERROR_VARIABLE:
     {
       int i;

C/threads.c

@@ -877,7 +877,11 @@ p_valid_thread( USES_REGS1 )
 typedef struct swi_mutex {
   UInt owners;
   Int tid_own;
+  MutexEntry *alias;
   pthread_mutex_t m;
+  UInt timestamp;
+  struct swi_mutex *backbone; // chain of all mutexes
+  struct swi_mutex *prev, *next; // chain of locked mutexes
 } SWIMutex;
 
 static SWIMutex *NewMutex(void) {
@@ -887,11 +891,23 @@ static SWIMutex *NewMutex(void) {
   extern int pthread_mutexattr_setkind_np(pthread_mutexattr_t *attr, int kind);
 #endif
 
+  LOCK(GLOBAL_MUT_ACCESS);
+  mutp = GLOBAL_FreeMutexes;
+  while (mutp) {
+    if ((Int)(mutp->owners) < 0) {
+      // just making sure
+      break;
+    }
+    mutp = mutp->next;
+  }
+  if (mutp == NULL) {
     mutp = (SWIMutex *)Yap_AllocCodeSpace(sizeof(SWIMutex));
     if (mutp == NULL) {
-    return FALSE;
+      UNLOCK(GLOBAL_MUT_ACCESS);
-  }
+      return NULL;
+    } else {
       pthread_mutexattr_init(&mat);
+      mutp->timestamp = 0;
 #if defined(HAVE_PTHREAD_MUTEXATTR_SETKIND_NP)  && !defined(__MINGW32__)
       pthread_mutexattr_setkind_np(&mat, PTHREAD_MUTEX_RECURSIVE_NP);
 #else
@@ -900,8 +916,17 @@ static SWIMutex *NewMutex(void) {
 #endif
 #endif
       pthread_mutex_init(&mutp->m, &mat);
+    }
+    mutp->backbone  = GLOBAL_mutex_backbone;
+    GLOBAL_mutex_backbone = mutp;
+  } else {
+    // reuse existing mutex
+    mutp->timestamp++;
+  }
   mutp->owners = 0;
   mutp->tid_own = 0;  
+  mutp->alias = NIL;  
+  UNLOCK(GLOBAL_MUT_ACCESS);
   return mutp;
 }
 
@@ -912,10 +937,15 @@ static SWIMutex *MutexOfTerm__(Term t USES_REGS){
   SWIMutex *mut = NULL;
   
   if (IsVarTerm(t1)) {
-    mut = NewMutex();
+    Yap_Error(INSTANTIATION_ERROR, t1, "mutex operation");
-    Yap_unify(MkAddressTerm(mut), ARG1);
+    return NULL;
-  } else if (IsIntegerTerm(t1)) {
+  } else if (IsApplTerm(t1) && FunctorOfTerm(t1) == FunctorMutex) {
-    mut = AddressOfTerm(t1);
+    mut = AddressOfTerm(ArgOfTerm(1,t1));
+    if ((Int)(mut->owners) < 0 ||
+	IntegerOfTerm(ArgOfTerm(2,t1)) != mut->timestamp) {
+      Yap_Error(EXISTENCE_ERROR_MUTEX,  t1, "mutex access");
+      return NULL;
+    }
   } else if (IsAtomTerm(t1)) {
     mut = Yap_GetMutexFromProp(AtomOfTerm(t1));
     if (!mut) {
@@ -933,27 +963,33 @@ p_new_mutex( USES_REGS1 ){
   SWIMutex* mutp;
   Term t1;
   if (IsVarTerm((t1 = Deref(ARG1)))) {
+    Term ts[2];
+    
     if (!(mutp = NewMutex()))
       return FALSE;
-    return Yap_unify(ARG1, MkAddressTerm(mutp));
+    ts[0] = MkAddressTerm(mutp);    
+    ts[1] = MkIntegerTerm(mutp->timestamp);    
+    if (Yap_unify(ARG1, Yap_MkApplTerm(FunctorMutex, 2, ts) ) ) {
+      return TRUE;
+    }
+    Yap_Error(UNINSTANTIATION_ERROR, t1, "mutex_create on an existing mutex");
+    return FALSE;
   } else if(IsAtomTerm(t1)) {
     if (!(mutp = NewMutex()))
       return FALSE;
     return Yap_PutAtomMutex( AtomOfTerm(t1), mutp );
-  } else if (IsAddressTerm(t1)) {
+  } else if (IsApplTerm(t1)  && FunctorOfTerm(t1) == FunctorMutex) {
-
+    Yap_Error(UNINSTANTIATION_ERROR, t1, "mutex_create on an existing mutex");
-
-
-
-
-
-
-
     return FALSE;
   }
   return FALSE;
 }
   
+/** @pred mutex_destroy(+ _MutexId_)
+    
+    Destroy a mutex.  After this call,  _MutexId_ becomes invalid and
+    further references yield an `existence_error` exception. 
+*/
 static Int p_destroy_mutex( USES_REGS1 )
 {
   SWIMutex *mut = MutexOfTerm(Deref(ARG1));
@@ -961,7 +997,19 @@ p_new_mutex( USES_REGS1 ){
     return FALSE;  
   if (pthread_mutex_destroy(&mut->m) < 0)
      return FALSE;
-  Yap_FreeCodeSpace((void *)mut);
+  if (mut->alias) {
+    mut->alias->Mutex  = NULL;
+  }
+  mut->owners = -1;
+  mut->tid_own = -1;
+  LOCK(GLOBAL_MUT_ACCESS);
+  if (GLOBAL_FreeMutexes)
+    mut->prev = GLOBAL_FreeMutexes->prev;
+  else
+    mut->prev = NULL;
+  mut->next = GLOBAL_FreeMutexes;
+  GLOBAL_FreeMutexes = mut;
+  UNLOCK(GLOBAL_MUT_ACCESS);
   return TRUE;
 }
 
@@ -976,11 +1024,17 @@ LockMutex( SWIMutex *mut USES_REGS)
 #endif
   mut->owners++;
   mut->tid_own = worker_id;
+  if (LOCAL_Mutexes)
+    mut->prev = LOCAL_Mutexes->prev;
+  else
+    mut->prev = NULL;
+  mut->next = LOCAL_Mutexes;
+  LOCAL_Mutexes = NULL;
   return true;
 }
 
 static bool
-UnLockMutex( SWIMutex *mut )
+UnLockMutex( SWIMutex *mut USES_REGS)
 {
 #if DEBUG_LOCKS
   MUTEX_UNLOCK(&mut->m);
@@ -989,9 +1043,39 @@ UnLockMutex( SWIMutex *mut )
     return FALSE;
 #endif
   mut->owners--;
+  if (mut->prev) {
+    mut->prev->next = mut->next;
+  } else {
+    LOCAL_Mutexes = mut->next;
+    if (mut->next)
+      mut->next->prev = NULL;
+  }
+  if (mut->next)
+    mut->next->prev = mut->prev;
   return true;
 }
 
+/** @pred mutex_lock(+ _MutexId_) 
+
+
+    Lock the mutex.  Prolog mutexes are <em>recursive</em> mutexes: they
+    can be locked multiple times by the same thread.  Only after unlocking
+    it as many times as it is locked, the mutex becomes available for
+    locking by other threads. If another thread has locked the mutex the
+    calling thread is suspended until to mutex is unlocked.
+
+    If  _MutexId_ is an atom, and there is no current mutex with that
+    name, the mutex is created automatically using mutex_create/1.  This
+    implies named mutexes need not be declared explicitly.
+
+    Please note that locking and unlocking mutexes should be paired
+    carefully. Especially make sure to unlock mutexes even if the protected
+    code fails or raises an exception. For most common cases use
+    with_mutex/2, which provides a safer way for handling Prolog-level
+    mutexes.
+
+ 
+*/
 static Int
 p_lock_mutex( USES_REGS1 )
 {
@@ -1001,6 +1085,14 @@ p_lock_mutex( USES_REGS1 )
   return TRUE;
 }
 
+/** @pred mutex_trylock(+ _MutexId_) 
+
+
+    As mutex_lock/1, but if the mutex is held by another thread, this
+    predicates fails immediately.
+
+ 
+*/
 static Int
 p_trylock_mutex( USES_REGS1 )
 {
@@ -1015,15 +1107,40 @@ p_trylock_mutex( USES_REGS1 )
   return TRUE;
 }
 
+/** @pred mutex_unlock(+ _MutexId_) 
+
+
+    Unlock the mutex. This can only be called if the mutex is held by the
+    calling thread. If this is not the case, a `permission_error`
+    exception is raised.
+
+ 
+*/
 static Int
 p_unlock_mutex( USES_REGS1 )
 {
   SWIMutex *mut = MutexOfTerm(Deref(ARG1));
-  if (!mut || !UnLockMutex( mut ))
+  if (!mut || !UnLockMutex( mut PASS_REGS))
     return FALSE;
   return TRUE;
 }
 
+/** @pred with_mutex(+ _MutexId_, : _Goal_) 
+
+
+    Execute  _Goal_ while holding  _MutexId_.  If  _Goal_ leaves
+    choicepoints, these are destroyed (as in once/1).  The mutex is unlocked
+    regardless of whether  _Goal_ succeeds, fails or raises an exception.
+    An exception thrown by  _Goal_ is re-thrown after the mutex has been
+    successfully unlocked.  See also `mutex_create/2`.
+
+    Although described in the thread-section, this predicate is also
+    available in the single-threaded version, where it behaves simply as
+    once/1.
+
+ 
+*/
+
 static Int
 p_with_mutex( USES_REGS1 )
 {
@@ -1084,7 +1201,7 @@ p_with_mutex( USES_REGS1 )
   }
  end:
   excep = Yap_GetException();
-  if ( !UnLockMutex(mut) ) {
+  if ( !UnLockMutex(mut PASS_REGS) ) {
     return FALSE;
   }
   if (creeping) {
@@ -1559,11 +1676,11 @@ void Yap_InitThreadPreds(void)
   */
   Yap_InitCPred("$valid_thread", 1, p_valid_thread, 0);
   Yap_InitCPred("mutex_create", 1, p_new_mutex, SafePredFlag);
-  Yap_InitCPred("$destroy_mutex", 1, p_destroy_mutex, SafePredFlag);
+  Yap_InitCPred("mutex_destroy", 1, p_destroy_mutex, SafePredFlag);
-  Yap_InitCPred("$lock_mutex", 1, p_lock_mutex, SafePredFlag);
+  Yap_InitCPred("mutex_lock", 1, p_lock_mutex, SafePredFlag);
-  Yap_InitCPred("$trylock_mutex", 1, p_trylock_mutex, SafePredFlag);
+  Yap_InitCPred("mutex_trylock", 1, p_trylock_mutex, SafePredFlag);
-  Yap_InitCPred("$unlock_mutex", 1, p_unlock_mutex, SafePredFlag);
+  Yap_InitCPred("mutex_unlock", 1, p_unlock_mutex, SafePredFlag);
-  Yap_InitCPred("$with_mutex", 2, p_with_mutex, MetaPredFlag);
+  Yap_InitCPred("with_mutex", 2, p_with_mutex, MetaPredFlag);
   Yap_InitCPred("$with_with_mutex", 1, p_with_with_mutex, 0);
   Yap_InitCPred("$unlock_with_mutex", 1, p_unlock_with_mutex, 0);
   Yap_InitCPred("$mutex_info", 3, p_mutex_info, SafePredFlag);

H/Yatom.h

@@ -1346,7 +1346,7 @@ IsTranslationProperty (int flags)
      p = RepMutexProp(p0 = p->NextOfPE);
    READ_UNLOCK(ae->ARWLock);
    if (p0 == NIL) return NULL;
-   return p;
+   return p->Mutex;
  }
 
  INLINE_ONLY inline EXTERN PropFlags IsMutexProperty (int);

H/dglobals.h

@@ -125,3 +125,9 @@
 #define GLOBAL_FPreds Yap_global->FPreds_
 #endif /* LOW_PROF */
 
+#if THREADS
+#define GLOBAL_FreeMutexes Yap_global->FreeMutexes_
+#define GLOBAL_mutex_backbone Yap_global->mutex_backbone_
+#define GLOBAL_MUT_ACCESS Yap_global->MUT_ACCESS_
+#endif
+

H/dlocals.h

@@ -91,6 +91,8 @@
 #define REMOTE_ArithError(wid) REMOTE(wid)->ArithError_
 #define LOCAL_LastAssertedPred LOCAL->LastAssertedPred_
 #define REMOTE_LastAssertedPred(wid) REMOTE(wid)->LastAssertedPred_
+#define LOCAL_TmpPred LOCAL->TmpPred_
+#define REMOTE_TmpPred(wid) REMOTE(wid)->TmpPred_
 #define LOCAL_ScannerStack LOCAL->ScannerStack_
 #define REMOTE_ScannerStack(wid) REMOTE(wid)->ScannerStack_
 #define LOCAL_ScannerExtraBlocks LOCAL->ScannerExtraBlocks_
@@ -424,6 +426,9 @@
 
 #define LOCAL_CurSlot LOCAL->CurSlot_
 #define REMOTE_CurSlot(wid) REMOTE(wid)->CurSlot_
+
+#define LOCAL_Mutexes LOCAL->Mutexes_
+#define REMOTE_Mutexes(wid) REMOTE(wid)->Mutexes_
 #define LOCAL_SourceModule LOCAL->SourceModule_
 #define REMOTE_SourceModule(wid) REMOTE(wid)->SourceModule_
 #define LOCAL_MAX_SIZE LOCAL->MAX_SIZE_

H/hglobals.h

@@ -124,4 +124,10 @@ typedef struct global_data {
   FILE*  FProf_;
   FILE*  FPreds_;
 #endif /* LOW_PROF */
+
+#if THREADS
+  struct swi_mutex*  FreeMutexes_;
+  struct swi_mutex*  mutex_backbone_;
+  lockvar  MUT_ACCESS_;
+#endif
 } w_shared;

H/hlocals.h

@@ -52,6 +52,7 @@ typedef struct worker_local {
   Int  DepthArenas_;
   int  ArithError_;
   struct pred_entry*  LastAssertedPred_;
+  struct pred_entry*  TmpPred_;
   char*  ScannerStack_;
   struct scanner_extra_alloc*  ScannerExtraBlocks_;
   struct DB_TERM*  BallTerm_;
@@ -239,6 +240,8 @@ typedef struct worker_local {
   struct scan_atoms*  search_atoms_;
 
   yhandle_t  CurSlot_;
+
+  struct swi_mutex*  Mutexes_;
   Term  SourceModule_;
   size_t  MAX_SIZE_;
 } w_local;

H/iatoms.h

@@ -189,6 +189,7 @@
   AtomMultiple = Yap_FullLookupAtom("multiple");
   AtomMutable = Yap_LookupAtom("mutable");
   AtomMutableVariable = Yap_FullLookupAtom("$mutable_variable");
+  AtomMutex = Yap_LookupAtom("mutex");
   AtomMyddasDB = Yap_FullLookupAtom("$myddas_db");
   AtomMyddasGoal = Yap_FullLookupAtom("$myddas_goal");
   AtomMyddasHost = Yap_FullLookupAtom("$myddas_host");
@@ -435,6 +436,7 @@
   FunctorModule = Yap_MkFunctor(AtomColomn,2);
   FunctorMultiFileClause = Yap_MkFunctor(AtomMfClause,5);
   FunctorMutable = Yap_MkFunctor(AtomMutableVariable,(sizeof(timed_var)/sizeof(CELL)));
+  FunctorMutex = Yap_MkFunctor(AtomMutex,2);
   FunctorNotImplemented = Yap_MkFunctor(AtomNotImplemented,2);
   FunctorNBQueue = Yap_MkFunctor(AtomQueue,4);
   FunctorNot = Yap_MkFunctor(AtomNot,1);

H/iglobals.h

@@ -124,4 +124,10 @@ static void InitGlobal(void) {
   GLOBAL_FProf = NULL;
   GLOBAL_FPreds = NULL;
 #endif /* LOW_PROF */
+
+#if THREADS
+  GLOBAL_FreeMutexes = NULL;
+  GLOBAL_mutex_backbone = NULL;
+  INIT_LOCK(GLOBAL_MUT_ACCESS);
+#endif
 }

H/ilocals.h

@@ -52,6 +52,7 @@ static void InitWorker(int wid) {
   REMOTE_DepthArenas(wid) = 0;
   REMOTE_ArithError(wid) = FALSE;
   REMOTE_LastAssertedPred(wid) = NULL;
+  REMOTE_TmpPred(wid) = NULL;
   REMOTE_ScannerStack(wid) = NULL;
   REMOTE_ScannerExtraBlocks(wid) = NULL;
   REMOTE_BallTerm(wid) = NULL;
@@ -239,6 +240,8 @@ static void InitWorker(int wid) {
 
 
   REMOTE_CurSlot(wid) = 0;
+
+  REMOTE_Mutexes(wid) = NULL;
   REMOTE_SourceModule(wid) = 0;
   REMOTE_MAX_SIZE(wid) = 1024L;
 }

H/ratoms.h

@@ -189,6 +189,7 @@
   AtomMultiple = AtomAdjust(AtomMultiple);
   AtomMutable = AtomAdjust(AtomMutable);
   AtomMutableVariable = AtomAdjust(AtomMutableVariable);
+  AtomMutex = AtomAdjust(AtomMutex);
   AtomMyddasDB = AtomAdjust(AtomMyddasDB);
   AtomMyddasGoal = AtomAdjust(AtomMyddasGoal);
   AtomMyddasHost = AtomAdjust(AtomMyddasHost);
@@ -435,6 +436,7 @@
   FunctorModule = FuncAdjust(FunctorModule);
   FunctorMultiFileClause = FuncAdjust(FunctorMultiFileClause);
   FunctorMutable = FuncAdjust(FunctorMutable);
+  FunctorMutex = FuncAdjust(FunctorMutex);
   FunctorNotImplemented = FuncAdjust(FunctorNotImplemented);
   FunctorNBQueue = FuncAdjust(FunctorNBQueue);
   FunctorNot = FuncAdjust(FunctorNot);

H/rglobals.h

@@ -124,4 +124,10 @@ static void RestoreGlobal(void) {
 
 
 #endif /* LOW_PROF */
+
+#if THREADS
+
+
+  REINIT_LOCK(GLOBAL_MUT_ACCESS);
+#endif
 }

H/rlocals.h

@@ -54,6 +54,7 @@ static void RestoreWorker(int wid USES_REGS) {
 
 
 
+
   RestoreBallTerm(wid);
 
 
@@ -241,4 +242,6 @@ static void RestoreWorker(int wid USES_REGS) {
 
 
 
+
+
 }

H/tatoms.h

@@ -376,6 +376,8 @@
 #define AtomMutable Yap_heap_regs->AtomMutable_
   Atom AtomMutableVariable_;
 #define AtomMutableVariable Yap_heap_regs->AtomMutableVariable_
+  Atom AtomMutex_;
+#define AtomMutex Yap_heap_regs->AtomMutex_
   Atom AtomMyddasDB_;
 #define AtomMyddasDB Yap_heap_regs->AtomMyddasDB_
   Atom AtomMyddasGoal_;
@@ -868,6 +870,8 @@
 #define FunctorMultiFileClause Yap_heap_regs->FunctorMultiFileClause_
   Functor FunctorMutable_;
 #define FunctorMutable Yap_heap_regs->FunctorMutable_
+  Functor FunctorMutex_;
+#define FunctorMutex Yap_heap_regs->FunctorMutex_
   Functor FunctorNotImplemented_;
 #define FunctorNotImplemented Yap_heap_regs->FunctorNotImplemented_
   Functor FunctorNBQueue_;

include/YapError.h

@@ -55,6 +55,7 @@ typedef enum
   EVALUATION_ERROR_ZERO_DIVISOR,
   EXISTENCE_ERROR_ARRAY,
   EXISTENCE_ERROR_KEY,  
+  EXISTENCE_ERROR_MUTEX,  
   EXISTENCE_ERROR_SOURCE_SINK,
   EXISTENCE_ERROR_STREAM,
   EXISTENCE_ERROR_VARIABLE,
@@ -121,6 +122,7 @@ typedef enum
   TYPE_ERROR_UBYTE,
   TYPE_ERROR_UCHAR,
   TYPE_ERROR_VARIABLE,
+  UNINSTANTIATION_ERROR,
   UNKNOWN_ERROR
 } yap_error_number;
 

misc/ATOMS

@@ -194,6 +194,7 @@ A	MultiFile		F	"$mf"
 A	Multiple		F	"multiple"
 A	Mutable			N	"mutable"
 A	MutableVariable		F	"$mutable_variable"
+A	Mutex			N	"mutex"
 A	MyddasDB		F	"$myddas_db"
 A	MyddasGoal		F	"$myddas_goal"
 A	MyddasHost		F	"$myddas_host"
@@ -440,6 +441,7 @@ F	Minus			Minus		2
 F	Module			Colomn		2
 F	MultiFileClause		MfClause	5
 F	Mutable			MutableVariable	(sizeof(timed_var)/sizeof(CELL))
+F	Mutex			Mutex		2
 F	NotImplemented		NotImplemented	2
 F	NBQueue			Queue		4
 F	Not			Not		1

misc/GLOBALS

@@ -146,6 +146,12 @@ FILE*				FProf					=NULL
 FILE*				FPreds					=NULL
 #endif /* LOW_PROF */
 
+// Mutexes
+#if THREADS
+struct swi_mutex*		FreeMutexes				=NULL
+struct swi_mutex*		mutex_backbone				=NULL
+lockvar				MUT_ACCESS				MkLock
+#endif
 
 END_GLOBAL_DATA
 

misc/LOCALS

@@ -55,7 +55,6 @@ Int				DepthArenas				=0
 int				ArithError				=FALSE
 struct pred_entry*		LastAssertedPred			=NULL
 struct pred_entry*		TmpPred					=NULL
-struct pred_entry*		LastAssertedPred			=NULL
 char*				ScannerStack				=NULL
 struct scanner_extra_alloc*	 ScannerExtraBlocks			=NULL
 struct DB_TERM*			BallTerm				=NULL 		RestoreBallTerm(wid)
@@ -276,6 +275,8 @@ struct scan_atoms*		search_atoms				void
 // Slots
 yhandle_t				CurSlot					=0
 
+// Mutexes
+struct swi_mutex*		Mutexes					=NULL
 
 Term				SourceModule				=0
 

packages/yap-lbfgs/lbfgs.pl

@@ -163,6 +163,11 @@ optimizer_initialize(1,evaluate,progress)
 */
 optimizer_initialize(N,Call_Evaluate,Call_Progress) :-
 	optimizer_initialize(N,user,Call_Evaluate,Call_Progress).
+
+optimizer_initialize(N,Module,Call_Evaluate,Call_Progress) :-
+        optimizer_finalize,
+	!,
+	optimizer_initialize(N,Module,Call_Evaluate,Call_Progress).
 optimizer_initialize(N,Module,Call_Evaluate,Call_Progress) :-
 	\+ initialized,
 

pl/errors.yap

@@ -342,8 +342,8 @@ print_message(_, Term) :-
 	current_prolog_flag(verbose, silent), !.
 '$print_system_message'(Term, Level, Lines) :-
 	( Level == error -> Term \= error(syntax_error(_), _) ; Level == warning ),
-	'$messages':prefix(Level, LinePrefix, Stream, LinesF, Lines2),
+	'$messages':prefix(Level, LinePrefix, Stream, Lines2, Lines),
-	'$messages':file_location(Lines2, Lines), !,
+	'$messages':file_location(LinesF, Lines2), !,
 	flush_output(user_output),
 	flush_output(user_error),
 	print_message_lines(Stream, LinePrefix, [nl|LinesF]).

pl/messages.yap

@@ -68,13 +68,12 @@ handling in YAP:
 
 file_location -->
 	{ source_location(FileName, LN) },
-	file_position(FileName,LN),
+	file_position(FileName,LN).
-	[ nl ].
 
 file_position(user_input,LN) -->
-	[ 'at line ~d in user_input,' - [LN] ].
+	[ 'user_input:~d:0: ' - [LN] ].
 file_position(FileName,LN) -->
-	[ 'at line ~d in ~a,' - [LN,FileName] ].
+	[ '~a:~d:0: ' - [FileName,LN] ].
 
 translate_message(Term) -->
 	generate_message(Term), !.
@@ -238,6 +237,8 @@ system_message(error(existence_error(directory,Key), Where)) -->
 	[ 'EXISTENCE ERROR- ~w: ~w not an existing directory' - [Where,Key] ].
 system_message(error(existence_error(key,Key), Where)) -->
 	[ 'EXISTENCE ERROR- ~w: ~w not an existing key' - [Where,Key] ].
+system_message(error(existence_error(mutex,Key), Where)) -->
+        [ 'EXISTENCE ERROR- ~w: ~w is an erased mutex' - [Where,Key] ].
 system_message(existence_error(prolog_flag,F)) -->
 	[ 'Prolog Flag ~w: new Prolog flags must be created using create_prolog_flag/3.' - [F] ].
 system_message(error(existence_error(prolog_flag,P), Where)) --> !,
@@ -624,22 +625,22 @@ print_message_line(S, [Fmt|T0], T) :-
 prefix(help,	      '',          user_error) --> [].
 prefix(query,	      '',          user_error) --> [].
 prefix(debug,	      '',          user_output) --> [].
-prefix(warning,	      '% ',      user_error) -->
+prefix(warning,	      '',      user_error) -->
 	{ thread_self(Id) },
 	(   { Id == main }
-	->  [ 'Warning: ', nl ]
+	->  [ 'warning: ', nl ]
 	;   { atom(Id) }
-	->  ['Warning: [Thread ~a ]' - [Id], nl ]
+	->  ['warning: [Thread ~a ]' - [Id], nl ]
-	;   ['Warning: [Thread ~d ]' - [Id], nl ]
+	;   ['warning: [Thread ~d ]' - [Id], nl ]
 	).
 prefix(error,	      '',   user_error) -->
 	{ recorded(sp_info,local_sp(P,_,_,_),_) },
 	{ thread_self(Id) },
 	(   { Id == main }
-	->  [ 'ERROR at ' ]
+	->  [ 'error at ' ]
 	;   { atom(Id) }
-	->  [ 'ERROR [ Thread ~a ] at ' - [Id] ]
+	->  [ 'error [ Thread ~a ] at ' - [Id] ]
-	;   [ 'ERROR [ Thread ~d ] at ' - [Id] ]
+	;   [ 'error [ Thread ~d ] at ' - [Id] ]
 	),
 	'$hacks':display_pc(P),
 	!,
@@ -647,10 +648,10 @@ prefix(error,	      '     ',   user_error) -->
 prefix(error,	      '',   user_error) -->
 	{ thread_self(Id) },
 	(   { Id == main }
-	->  [ 'ERROR!!', nl ]
+	->  [ 'error!!', nl ]
 	;   { atom(Id) }
-	->  [ 'ERROR!! [ Thread ~a ]' - [Id], nl ]
+	->  [ 'error!! [ Thread ~a ]' - [Id], nl ]
-	;   [ 'ERROR!! [ Thread ~d ]' - [Id], nl ]
+	;   [ 'error!! [ Thread ~d ]' - [Id], nl ]
 	).
 prefix(banner,	      '',	   user_error) --> [].
 prefix(informational, '~*|% '-[LC],     user_error) -->

pl/threads.yap

@@ -632,11 +632,6 @@ current_thread(Id, Status) :-
 '$thread_id_alias'(Id, Id).
 
 
-'$mutex_id_alias'(Id, Alias) :-
-	recorded('$mutex_alias', [Id|Alias], _), !.
-'$mutex_id_alias'(Id, Id).
-
-
 
 thread_property(Prop) :-
 	'$check_thread_property'(Prop, thread_property(Prop)),
@@ -910,117 +905,6 @@ mutex_create(Id, Options) :-
 '$mutex_option'(Option, _, Goal) :-
 	'$do_error'(domain_error(mutex_option, Option), Goal).
 
-/*
-mutex_create(V) :-
-	var(V), !,
-	'$new_mutex'(V),
-	recorda('$mutex_alias',[V|V],_).
-mutex_create(A) :-
-	atom(A),
-	recorded('$mutex_alias',[_|A],_), !,
-	'$do_error'(permission_error(create,mutex,A),mutex_create(A)).
-mutex_create(A) :-
-	atom(A), !,
-	'$new_mutex'(Id),
-	recorda('$mutex_alias',[Id|A],_).
-mutex_create(V) :-
-	'$do_error'(type_error(atom,V),mutex_create(V)).
-*/
-	
-/** @pred mutex_destroy(+ _MutexId_) 
-
-
-Destroy a mutex.  After this call,  _MutexId_ becomes invalid and
-further references yield an `existence_error` exception.
-
- 
-*/
-mutex_destroy(Mutex) :-
-	'$check_mutex_or_alias'(Mutex, mutex_destroy(Mutex)),
-	'$mutex_id_alias'(Id, Mutex),
-	'$destroy_mutex'(Id),
-	'$erase_mutex_info'(Id).
-
-'$erase_mutex_info'(Id) :-
-	recorded('$mutex_alias',[Id|_],R),
-	erase(R),
-	fail.
-'$erase_mutex_info'(_).
-    
-
-/** @pred mutex_lock(+ _MutexId_) 
-
-
-Lock the mutex.  Prolog mutexes are <em>recursive</em> mutexes: they
-can be locked multiple times by the same thread.  Only after unlocking
-it as many times as it is locked, the mutex becomes available for
-locking by other threads. If another thread has locked the mutex the
-calling thread is suspended until to mutex is unlocked.
-
-If  _MutexId_ is an atom, and there is no current mutex with that
-name, the mutex is created automatically using mutex_create/1.  This
-implies named mutexes need not be declared explicitly.
-
-Please note that locking and unlocking mutexes should be paired
-carefully. Especially make sure to unlock mutexes even if the protected
-code fails or raises an exception. For most common cases use
-with_mutex/2, which provides a safer way for handling Prolog-level
-mutexes.
-
- 
-*/
-mutex_lock(V) :-
-	var(V), !,
-	'$do_error'(instantiation_error,mutex_lock(V)).
-mutex_lock(A) :-
-	recorded('$mutex_alias',[Id|A],_), !,
-	'$lock_mutex'(Id).
-mutex_lock(A) :-
-	atom(A), !,
-	mutex_create(A),
-	mutex_lock(A).
-mutex_lock(V) :-
-	'$do_error'(type_error(mutex,V),mutex_lock(V)).
-	
-/** @pred mutex_trylock(+ _MutexId_) 
-
-
-As mutex_lock/1, but if the mutex is held by another thread, this
-predicates fails immediately.
-
- 
-*/
-mutex_trylock(V) :-
-	var(V), !,
-	'$do_error'(instantiation_error,mutex_trylock(V)).
-mutex_trylock(A) :-
-	recorded('$mutex_alias',[Id|A],_), !,
-	'$trylock_mutex'(Id).
-mutex_trylock(A) :-
-	atom(A), !,
-	mutex_create(A),
-	mutex_trylock(A).
-mutex_trylock(V) :-
-	'$do_error'(type_error(mutex,V),mutex_trylock(V)).
-	
-/** @pred mutex_unlock(+ _MutexId_) 
-
-
-Unlock the mutex. This can only be called if the mutex is held by the
-calling thread. If this is not the case, a `permission_error`
-exception is raised.
-
- 
-*/
-mutex_unlock(Mutex) :-
-	'$check_mutex_or_alias'(Mutex, mutex_unlock(Mutex)),
-	'$mutex_id_alias'(Id, Mutex),
-	( '$unlock_mutex'(Id) ->
-	    true
-	;
-	    '$do_error'(permission_error(unlock,mutex,Mutex),mutex_unlock(Mutex))
-	).
-
 /** @pred mutex_unlock_all 
 
 
@@ -1048,54 +932,6 @@ mutex_unlock_all :-
 	'$unlock_mutex'(Id),
 	'$mutex_unlock_all'(Id).
 
-/** @pred with_mutex(+ _MutexId_, : _Goal_) 
-
-
-Execute  _Goal_ while holding  _MutexId_.  If  _Goal_ leaves
-choicepoints, these are destroyed (as in once/1).  The mutex is unlocked
-regardless of whether  _Goal_ succeeds, fails or raises an exception.
-An exception thrown by  _Goal_ is re-thrown after the mutex has been
-successfully unlocked.  See also `mutex_create/2`.
-
-Although described in the thread-section, this predicate is also
-available in the single-threaded version, where it behaves simply as
-once/1.
-
- 
-*/
-
-with_mutex(M, G) :-
-    ( recorded('$mutex_alias',[Id|M],_) ->
-    '$with_mutex'(Id, G )
-    ;
-    atom(M ) ->
-    mutex_create(Id, [alias(M)]),
-    '$with_mutex'(M, G )
-    ;
-    integer(M) ->
-    '$with_mutex'(M, G )
-    ;
-    '$do_error'(type_error(mutex,M), with_mutex(M, G))
-    ), nonvar(G). % preserve env.
-
-    
-/*
-with_mutex(M, G) :-
-	( '$no_threads' ->
-	  once(G)
-	;
-	  mutex_lock(M),
-	  var(G) -> mutex_unlock(M), '$do_error'(instantiation_error,with_mutex(M, G))
-	;
-	  \+ callable(G) ->
-	  mutex_unlock(M), '$do_error'(type_error(callable,G),with_mutex(M, G))
-	;
-  	  catch('$execute'(G), E, (mutex_unlock(M), throw(E))) ->
-		mutex_unlock(M)
-	  ;	mutex_unlock(M),
-		fail
-	).
-*/
 /** @pred current_mutex(? _MutexId_, ? _ThreadId_, ? _Count_)