diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Mutex stuff movibg to C

Browse Source
This commit is contained in:
Vítor Santos Costa 2014-11-27 10:02:04 +00:00
parent c9c2d7233c
commit a83ff038f4
22 changed files with 256 additions and 226 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
C/errors.c
View File

@ -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;

183
C/threads.c
View File

@ -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 <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("$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);

2
H/Yatom.h
View File

@ -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);

6
H/dglobals.h
View File

@ -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

5
H/dlocals.h
View File

@ -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_

6
H/hglobals.h
View File

@ -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;

3
H/hlocals.h
View File

@ -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;

2
H/iatoms.h
View File

@ -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);

6
H/iglobals.h
View File

@ -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
}

3
H/ilocals.h
View File

@ -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;
}

2
H/ratoms.h
View File

@ -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);

6
H/rglobals.h
View File

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

3
H/rlocals.h
View File

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

4
H/tatoms.h
View File

@ -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_;

4
include/YapError.h
View File

@ -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;

2
misc/ATOMS
View File

@ -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

6
misc/GLOBALS
View File

@ -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

3
misc/LOCALS
View File

@ -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

5
packages/yap-lbfgs/lbfgs.pl
View File

@ -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,

4
pl/errors.yap
View File

@ -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]).

37
pl/messages.yap
View File

@ -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) -->

176
pl/threads.yap
View File

@ -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 <em>named</em> 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 <em>named</em> 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 <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_)