diff --git a/C/errors.c b/C/errors.c
index 19066f857..89cf3f69e 100755
--- a/C/errors.c
+++ b/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;
diff --git a/C/threads.c b/C/threads.c
index 9af49f747..7cdccd8f6 100644
--- a/C/threads.c
+++ b/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,21 +891,42 @@ static SWIMutex *NewMutex(void) {
extern int pthread_mutexattr_setkind_np(pthread_mutexattr_t *attr, int kind);
#endif
- mutp = (SWIMutex *)Yap_AllocCodeSpace(sizeof(SWIMutex));
- if (mutp == NULL) {
- return FALSE;
+ LOCK(GLOBAL_MUT_ACCESS);
+ mutp = GLOBAL_FreeMutexes;
+ while (mutp) {
+ if ((Int)(mutp->owners) < 0) {
+ // just making sure
+ break;
+ }
+ mutp = mutp->next;
}
- pthread_mutexattr_init(&mat);
+ if (mutp == NULL) {
+ mutp = (SWIMutex *)Yap_AllocCodeSpace(sizeof(SWIMutex));
+ if (mutp == NULL) {
+ 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);
+ pthread_mutexattr_setkind_np(&mat, PTHREAD_MUTEX_RECURSIVE_NP);
#else
#ifdef HAVE_PTHREAD_MUTEXATTR_SETTYPE
- pthread_mutexattr_settype(&mat, PTHREAD_MUTEX_RECURSIVE);
+ pthread_mutexattr_settype(&mat, PTHREAD_MUTEX_RECURSIVE);
#endif
#endif
- pthread_mutex_init(&mutp->m, &mat);
+ 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->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_unify(MkAddressTerm(mut), ARG1);
- } else if (IsIntegerTerm(t1)) {
- mut = AddressOfTerm(t1);
+ Yap_Error(INSTANTIATION_ERROR, t1, "mutex operation");
+ return NULL;
+ } else if (IsApplTerm(t1) && FunctorOfTerm(t1) == FunctorMutex) {
+ 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,35 +963,53 @@ 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;
}
- static Int p_destroy_mutex( USES_REGS1 )
+/** @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));
if (!mut)
return FALSE;
if (pthread_mutex_destroy(&mut->m) < 0)
- return FALSE;
- Yap_FreeCodeSpace((void *)mut);
+ return FALSE;
+ 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 recursive 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("$lock_mutex", 1, p_lock_mutex, SafePredFlag);
- Yap_InitCPred("$trylock_mutex", 1, p_trylock_mutex, SafePredFlag);
- Yap_InitCPred("$unlock_mutex", 1, p_unlock_mutex, SafePredFlag);
- Yap_InitCPred("$with_mutex", 2, p_with_mutex, MetaPredFlag);
+ Yap_InitCPred("mutex_destroy", 1, p_destroy_mutex, SafePredFlag);
+ Yap_InitCPred("mutex_lock", 1, p_lock_mutex, SafePredFlag);
+ Yap_InitCPred("mutex_trylock", 1, p_trylock_mutex, SafePredFlag);
+ Yap_InitCPred("mutex_unlock", 1, p_unlock_mutex, SafePredFlag);
+ 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);
diff --git a/H/Yatom.h b/H/Yatom.h
index e58ccd0d1..fde5413ee 100755
--- a/H/Yatom.h
+++ b/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);
diff --git a/H/dglobals.h b/H/dglobals.h
index 4b0f9fb27..8e9db9c00 100644
--- a/H/dglobals.h
+++ b/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
+
diff --git a/H/dlocals.h b/H/dlocals.h
index b736dca66..7ee85a0b1 100644
--- a/H/dlocals.h
+++ b/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_
diff --git a/H/hglobals.h b/H/hglobals.h
index b4488d49f..4b026a72b 100644
--- a/H/hglobals.h
+++ b/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;
diff --git a/H/hlocals.h b/H/hlocals.h
index 2155f3561..97e46b782 100644
--- a/H/hlocals.h
+++ b/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;
diff --git a/H/iatoms.h b/H/iatoms.h
index c6261dee7..b4cf99d55 100644
--- a/H/iatoms.h
+++ b/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);
diff --git a/H/iglobals.h b/H/iglobals.h
index c2b3192c1..55be20c76 100644
--- a/H/iglobals.h
+++ b/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
}
diff --git a/H/ilocals.h b/H/ilocals.h
index de533238e..be24afb59 100755
--- a/H/ilocals.h
+++ b/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;
}
diff --git a/H/ratoms.h b/H/ratoms.h
index a051e3e78..d8558bcbc 100644
--- a/H/ratoms.h
+++ b/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);
diff --git a/H/rglobals.h b/H/rglobals.h
index 3f7d2cdd4..aee512d84 100644
--- a/H/rglobals.h
+++ b/H/rglobals.h
@@ -124,4 +124,10 @@ static void RestoreGlobal(void) {
#endif /* LOW_PROF */
+
+#if THREADS
+
+
+ REINIT_LOCK(GLOBAL_MUT_ACCESS);
+#endif
}
diff --git a/H/rlocals.h b/H/rlocals.h
index 20c129762..e8183562f 100644
--- a/H/rlocals.h
+++ b/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) {
+
+
}
diff --git a/H/tatoms.h b/H/tatoms.h
index c03abd665..ce1e0c8cc 100644
--- a/H/tatoms.h
+++ b/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_;
diff --git a/include/YapError.h b/include/YapError.h
index 750b797f1..735f73e91 100644
--- a/include/YapError.h
+++ b/include/YapError.h
@@ -54,7 +54,8 @@ typedef enum
EVALUATION_ERROR_UNDERFLOW,
EVALUATION_ERROR_ZERO_DIVISOR,
EXISTENCE_ERROR_ARRAY,
- EXISTENCE_ERROR_KEY,
+ 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;
diff --git a/misc/ATOMS b/misc/ATOMS
index eb3645874..9da0be411 100644
--- a/misc/ATOMS
+++ b/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
diff --git a/misc/GLOBALS b/misc/GLOBALS
index 3401821f4..4782d203c 100755
--- a/misc/GLOBALS
+++ b/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
diff --git a/misc/LOCALS b/misc/LOCALS
index 5d4e498ac..7e7b00dde 100755
--- a/misc/LOCALS
+++ b/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
diff --git a/packages/yap-lbfgs/lbfgs.pl b/packages/yap-lbfgs/lbfgs.pl
index b363002ec..dc8705250 100644
--- a/packages/yap-lbfgs/lbfgs.pl
+++ b/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,
diff --git a/pl/errors.yap b/pl/errors.yap
index ae80e1c07..0fea2509d 100644
--- a/pl/errors.yap
+++ b/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':file_location(Lines2, Lines), !,
+ '$messages':prefix(Level, LinePrefix, Stream, Lines2, Lines),
+ '$messages':file_location(LinesF, Lines2), !,
flush_output(user_output),
flush_output(user_error),
print_message_lines(Stream, LinePrefix, [nl|LinesF]).
diff --git a/pl/messages.yap b/pl/messages.yap
index 61adb879b..c70a6fcd5 100644
--- a/pl/messages.yap
+++ b/pl/messages.yap
@@ -68,13 +68,12 @@ handling in YAP:
file_location -->
{ source_location(FileName, LN) },
- file_position(FileName,LN),
- [ nl ].
+ file_position(FileName,LN).
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), !.
@@ -125,7 +124,7 @@ generate_message(debug) --> !,
generate_message(trace) --> !,
[ trace ].
generate_message(error(Error,Context)) -->
- { Error = existence_error(procedure,_) }, !,
+ { Error = existence_error(procedure,_) }, !,
system_message(error(Error,Context)),
stack_dump(error(Error,Context)).
generate_message(error(Error,context(Cause,Extra))) -->
@@ -146,7 +145,7 @@ stack_dump(_) --> [].
prolog_message(X,Y,Z) :-
system_message(X,Y,Z).
-%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
+ %message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
system_message(query(_QueryResult,_)) --> [].
system_message(format(Msg, Args)) -->
[Msg - Args].
@@ -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,33 +625,33 @@ 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 ~d ]' - [Id], nl ]
+ -> ['warning: [Thread ~a ]' - [Id], nl ]
+ ; ['warning: [Thread ~d ]' - [Id], nl ]
).
-prefix(error, ' ', user_error) -->
+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 ~d ] at ' - [Id] ]
+ -> [ 'error [ Thread ~a ] at ' - [Id] ]
+ ; [ 'error [ Thread ~d ] at ' - [Id] ]
),
'$hacks':display_pc(P),
!,
[' !!', nl].
-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 ~d ]' - [Id], nl ]
+ -> [ 'error!! [ Thread ~a ]' - [Id], nl ]
+ ; [ 'error!! [ Thread ~d ]' - [Id], nl ]
).
prefix(banner, '', user_error) --> [].
prefix(informational, '~*|% '-[LC], user_error) -->
diff --git a/pl/threads.yap b/pl/threads.yap
index a9dca3495..ad1964697 100644
--- a/pl/threads.yap
+++ b/pl/threads.yap
@@ -4,7 +4,7 @@
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
-* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
+ * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
@@ -628,15 +628,10 @@ current_thread(Id, Status) :-
'$thread_id_alias'(Id, Alias) :-
- recorded('$thread_alias', [Id|Alias], _), !.
+ recorded('$thread_alias', [Id|Alias], _), !.
'$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)),
@@ -872,11 +867,11 @@ change_address(Id, Address) :-
/** @pred mutex_create(? _MutexId_)
-Create a mutex. if _MutexId_ is an atom, a named mutex is
-created. If it is a variable, an anonymous mutex reference is returned.
-There is no limit to the number of mutexes that can be created.
+ Create a mutex. if _MutexId_ is an atom, a named mutex is
+ created. If it is a variable, an anonymous mutex reference is returned.
+ There is no limit to the number of mutexes that can be created.
-
+
*/
mutex_create(Id, Options) :-
nonvar(Id), !,
@@ -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 recursive 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_)