move message queues to C
This commit is contained in:
parent
7cbcd17993
commit
3c7779ec78
271
C/dbase.c
271
C/dbase.c
@ -181,21 +181,6 @@ typedef struct {
|
|||||||
} SFKeep;
|
} SFKeep;
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
typedef struct queue_entry {
|
|
||||||
struct queue_entry *next;
|
|
||||||
DBTerm *DBT;
|
|
||||||
} QueueEntry;
|
|
||||||
|
|
||||||
typedef struct idb_queue
|
|
||||||
{
|
|
||||||
Functor id; /* identify this as being pointed to by a DBRef */
|
|
||||||
SMALLUNSGN Flags; /* always required */
|
|
||||||
#if PARALLEL_YAP
|
|
||||||
rwlock_t QRWLock; /* a simple lock to protect this entry */
|
|
||||||
#endif
|
|
||||||
QueueEntry *FirstInQueue, *LastInQueue;
|
|
||||||
} db_queue;
|
|
||||||
|
|
||||||
#define HashFieldMask ((CELL)0xffL)
|
#define HashFieldMask ((CELL)0xffL)
|
||||||
#define DualHashFieldMask ((CELL)0xffffL)
|
#define DualHashFieldMask ((CELL)0xffffL)
|
||||||
#define TripleHashFieldMask ((CELL)0xffffffL)
|
#define TripleHashFieldMask ((CELL)0xffffffL)
|
||||||
@ -5184,6 +5169,108 @@ Yap_StoreTermInDBPlusExtraSpace(Term t, UInt extra_size, UInt *sz) {
|
|||||||
return o;
|
return o;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void
|
||||||
|
Yap_init_tqueue( db_queue *dbq )
|
||||||
|
{
|
||||||
|
dbq->id = FunctorDBRef;
|
||||||
|
dbq->Flags = DBClMask;
|
||||||
|
dbq->FirstInQueue = dbq->LastInQueue = NULL;
|
||||||
|
INIT_RWLOCK(dbq->QRWLock);
|
||||||
|
}
|
||||||
|
|
||||||
|
void
|
||||||
|
Yap_destroy_tqueue( db_queue *dbq USES_REGS)
|
||||||
|
{
|
||||||
|
QueueEntry * cur_instance = dbq->FirstInQueue;
|
||||||
|
while (cur_instance) {
|
||||||
|
/* release space for cur_instance */
|
||||||
|
keepdbrefs(cur_instance->DBT PASS_REGS);
|
||||||
|
ErasePendingRefs(cur_instance->DBT PASS_REGS);
|
||||||
|
FreeDBSpace((char *) cur_instance->DBT);
|
||||||
|
FreeDBSpace((char *) cur_instance);
|
||||||
|
}
|
||||||
|
dbq->FirstInQueue =
|
||||||
|
dbq->LastInQueue = NULL;
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
bool
|
||||||
|
Yap_enqueue_tqueue(db_queue *father_key, Term t USES_REGS)
|
||||||
|
{
|
||||||
|
QueueEntry *x;
|
||||||
|
while ((x = (QueueEntry *)AllocDBSpace(sizeof(QueueEntry))) == NULL) {
|
||||||
|
if (!Yap_growheap(FALSE, sizeof(QueueEntry), NULL)) {
|
||||||
|
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "in findall");
|
||||||
|
return false;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
/* Yap_LUClauseSpace += sizeof(QueueEntry); */
|
||||||
|
x->DBT = StoreTermInDB(Deref(t), 2 PASS_REGS);
|
||||||
|
if (x->DBT == NULL) {
|
||||||
|
return false;
|
||||||
|
}
|
||||||
|
x->next = NULL;
|
||||||
|
if (father_key->LastInQueue != NULL)
|
||||||
|
father_key->LastInQueue->next = x;
|
||||||
|
father_key->LastInQueue = x;
|
||||||
|
if (father_key->FirstInQueue == NULL) {
|
||||||
|
father_key->FirstInQueue = x;
|
||||||
|
}
|
||||||
|
return true;
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
bool
|
||||||
|
Yap_dequeue_tqueue(db_queue *father_key, Term t, bool first, bool release USES_REGS)
|
||||||
|
{
|
||||||
|
Term TDB;
|
||||||
|
QueueEntry * cur_instance = father_key->FirstInQueue, *prev = NULL;
|
||||||
|
while (cur_instance) {
|
||||||
|
while ((TDB = GetDBTerm(cur_instance->DBT, false PASS_REGS)) == 0L) {
|
||||||
|
if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
|
||||||
|
LOCAL_Error_TYPE = YAP_NO_ERROR;
|
||||||
|
if (!Yap_growglobal(NULL)) {
|
||||||
|
Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage);
|
||||||
|
return false;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
LOCAL_Error_TYPE = YAP_NO_ERROR;
|
||||||
|
if (!Yap_gcl(LOCAL_Error_Size, 2, ENV, gc_P(P,CP))) {
|
||||||
|
Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage);
|
||||||
|
return false;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if (Yap_unify(t, TDB)) {
|
||||||
|
if (release) {
|
||||||
|
if (cur_instance == father_key->FirstInQueue) {
|
||||||
|
father_key->FirstInQueue = cur_instance->next;
|
||||||
|
}
|
||||||
|
if (cur_instance == father_key->LastInQueue) {
|
||||||
|
father_key->LastInQueue = prev;
|
||||||
|
}
|
||||||
|
if (prev) {
|
||||||
|
prev->next = cur_instance->next;
|
||||||
|
}
|
||||||
|
/* release space for cur_instance */
|
||||||
|
keepdbrefs(cur_instance->DBT PASS_REGS);
|
||||||
|
ErasePendingRefs(cur_instance->DBT PASS_REGS);
|
||||||
|
FreeDBSpace((char *) cur_instance->DBT);
|
||||||
|
FreeDBSpace((char *) cur_instance);
|
||||||
|
}
|
||||||
|
return true;
|
||||||
|
} else {
|
||||||
|
// just getting the first
|
||||||
|
if (first)
|
||||||
|
return false;
|
||||||
|
// but keep on going, if we want to check everything.
|
||||||
|
prev = cur_instance;
|
||||||
|
cur_instance = cur_instance->next;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return false;
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
p_init_queue( USES_REGS1 )
|
p_init_queue( USES_REGS1 )
|
||||||
@ -5198,10 +5285,7 @@ p_init_queue( USES_REGS1 )
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
/* Yap_LUClauseSpace += sizeof(db_queue); */
|
/* Yap_LUClauseSpace += sizeof(db_queue); */
|
||||||
dbq->id = FunctorDBRef;
|
Yap_init_tqueue( dbq );
|
||||||
dbq->Flags = DBClMask;
|
|
||||||
dbq->FirstInQueue = dbq->LastInQueue = NULL;
|
|
||||||
INIT_RWLOCK(dbq->QRWLock);
|
|
||||||
t = MkIntegerTerm((Int)dbq);
|
t = MkIntegerTerm((Int)dbq);
|
||||||
return Yap_unify(ARG1, t);
|
return Yap_unify(ARG1, t);
|
||||||
}
|
}
|
||||||
@ -5211,8 +5295,8 @@ static Int
|
|||||||
p_enqueue( USES_REGS1 )
|
p_enqueue( USES_REGS1 )
|
||||||
{
|
{
|
||||||
Term Father = Deref(ARG1);
|
Term Father = Deref(ARG1);
|
||||||
QueueEntry *x;
|
|
||||||
db_queue *father_key;
|
db_queue *father_key;
|
||||||
|
bool rc;
|
||||||
|
|
||||||
if (IsVarTerm(Father)) {
|
if (IsVarTerm(Father)) {
|
||||||
Yap_Error(INSTANTIATION_ERROR, Father, "enqueue");
|
Yap_Error(INSTANTIATION_ERROR, Father, "enqueue");
|
||||||
@ -5222,34 +5306,16 @@ p_enqueue( USES_REGS1 )
|
|||||||
return FALSE;
|
return FALSE;
|
||||||
} else
|
} else
|
||||||
father_key = (db_queue *)IntegerOfTerm(Father);
|
father_key = (db_queue *)IntegerOfTerm(Father);
|
||||||
while ((x = (QueueEntry *)AllocDBSpace(sizeof(QueueEntry))) == NULL) {
|
|
||||||
if (!Yap_growheap(FALSE, sizeof(QueueEntry), NULL)) {
|
|
||||||
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "in findall");
|
|
||||||
return FALSE;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
/* Yap_LUClauseSpace += sizeof(QueueEntry); */
|
|
||||||
x->DBT = StoreTermInDB(Deref(ARG2), 2 PASS_REGS);
|
|
||||||
if (x->DBT == NULL) {
|
|
||||||
return FALSE;
|
|
||||||
}
|
|
||||||
x->next = NULL;
|
|
||||||
WRITE_LOCK(father_key->QRWLock);
|
WRITE_LOCK(father_key->QRWLock);
|
||||||
if (father_key->LastInQueue != NULL)
|
rc = Yap_enqueue_tqueue(father_key, Deref(ARG2) PASS_REGS);
|
||||||
father_key->LastInQueue->next = x;
|
|
||||||
father_key->LastInQueue = x;
|
|
||||||
if (father_key->FirstInQueue == NULL) {
|
|
||||||
father_key->FirstInQueue = x;
|
|
||||||
}
|
|
||||||
WRITE_UNLOCK(father_key->QRWLock);
|
WRITE_UNLOCK(father_key->QRWLock);
|
||||||
return TRUE;
|
return rc;
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
p_enqueue_unlocked( USES_REGS1 )
|
p_enqueue_unlocked( USES_REGS1 )
|
||||||
{
|
{
|
||||||
Term Father = Deref(ARG1);
|
Term Father = Deref(ARG1);
|
||||||
QueueEntry *x;
|
|
||||||
db_queue *father_key;
|
db_queue *father_key;
|
||||||
|
|
||||||
if (IsVarTerm(Father)) {
|
if (IsVarTerm(Father)) {
|
||||||
@ -5260,25 +5326,7 @@ p_enqueue_unlocked( USES_REGS1 )
|
|||||||
return FALSE;
|
return FALSE;
|
||||||
} else
|
} else
|
||||||
father_key = (db_queue *)IntegerOfTerm(Father);
|
father_key = (db_queue *)IntegerOfTerm(Father);
|
||||||
while ((x = (QueueEntry *)AllocDBSpace(sizeof(QueueEntry))) == NULL) {
|
return Yap_enqueue_tqueue(father_key, Deref(ARG2) PASS_REGS);
|
||||||
if (!Yap_growheap(FALSE, sizeof(QueueEntry), NULL)) {
|
|
||||||
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "in findall");
|
|
||||||
return FALSE;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
/* Yap_LUClauseSpace += sizeof(QueueEntry); */
|
|
||||||
x->DBT = StoreTermInDB(Deref(ARG2), 2 PASS_REGS);
|
|
||||||
if (x->DBT == NULL) {
|
|
||||||
return FALSE;
|
|
||||||
}
|
|
||||||
x->next = NULL;
|
|
||||||
if (father_key->LastInQueue != NULL)
|
|
||||||
father_key->LastInQueue->next = x;
|
|
||||||
father_key->LastInQueue = x;
|
|
||||||
if (father_key->FirstInQueue == NULL) {
|
|
||||||
father_key->FirstInQueue = x;
|
|
||||||
}
|
|
||||||
return TRUE;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* when reading an entry in the data base we are making it accessible from
|
/* when reading an entry in the data base we are making it accessible from
|
||||||
@ -5326,7 +5374,7 @@ p_dequeue( USES_REGS1 )
|
|||||||
} else if (!IsIntegerTerm(Father)) {
|
} else if (!IsIntegerTerm(Father)) {
|
||||||
Yap_Error(TYPE_ERROR_INTEGER, Father, "dequeue");
|
Yap_Error(TYPE_ERROR_INTEGER, Father, "dequeue");
|
||||||
return FALSE;
|
return FALSE;
|
||||||
} else
|
} else {
|
||||||
father_key = (db_queue *)IntegerOfTerm(Father);
|
father_key = (db_queue *)IntegerOfTerm(Father);
|
||||||
WRITE_LOCK(father_key->QRWLock);
|
WRITE_LOCK(father_key->QRWLock);
|
||||||
if ((cur_instance = father_key->FirstInQueue) == NULL) {
|
if ((cur_instance = father_key->FirstInQueue) == NULL) {
|
||||||
@ -5334,34 +5382,15 @@ p_dequeue( USES_REGS1 )
|
|||||||
WRITE_UNLOCK(father_key->QRWLock);
|
WRITE_UNLOCK(father_key->QRWLock);
|
||||||
FreeDBSpace((char *)father_key);
|
FreeDBSpace((char *)father_key);
|
||||||
return FALSE;
|
return FALSE;
|
||||||
} else {
|
}
|
||||||
Term TDB;
|
if (!Yap_dequeue_tqueue(father_key, ARG2, true, true PASS_REGS) )
|
||||||
|
return FALSE;
|
||||||
if (cur_instance == father_key->LastInQueue)
|
if (cur_instance == father_key->LastInQueue)
|
||||||
father_key->FirstInQueue = father_key->LastInQueue = NULL;
|
father_key->FirstInQueue = father_key->LastInQueue = NULL;
|
||||||
else
|
else
|
||||||
father_key->FirstInQueue = cur_instance->next;
|
father_key->FirstInQueue = cur_instance->next;
|
||||||
WRITE_UNLOCK(father_key->QRWLock);
|
WRITE_UNLOCK(father_key->QRWLock);
|
||||||
while ((TDB = GetDBTerm(cur_instance->DBT, FALSE PASS_REGS)) == 0L) {
|
return TRUE;
|
||||||
if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
|
|
||||||
LOCAL_Error_TYPE = YAP_NO_ERROR;
|
|
||||||
if (!Yap_growglobal(NULL)) {
|
|
||||||
Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage);
|
|
||||||
return FALSE;
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
LOCAL_Error_TYPE = YAP_NO_ERROR;
|
|
||||||
if (!Yap_gcl(LOCAL_Error_Size, 2, ENV, gc_P(P,CP))) {
|
|
||||||
Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage);
|
|
||||||
return FALSE;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
/* release space for cur_instance */
|
|
||||||
keepdbrefs(cur_instance->DBT PASS_REGS);
|
|
||||||
ErasePendingRefs(cur_instance->DBT PASS_REGS);
|
|
||||||
FreeDBSpace((char *) cur_instance->DBT);
|
|
||||||
FreeDBSpace((char *) cur_instance);
|
|
||||||
return Yap_unify(ARG2, TDB);
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -5370,7 +5399,7 @@ static Int
|
|||||||
p_dequeue_unlocked( USES_REGS1 )
|
p_dequeue_unlocked( USES_REGS1 )
|
||||||
{
|
{
|
||||||
db_queue *father_key;
|
db_queue *father_key;
|
||||||
QueueEntry *cur_instance, *prev_instance;
|
QueueEntry *cur_instance;
|
||||||
Term Father = Deref(ARG1);
|
Term Father = Deref(ARG1);
|
||||||
|
|
||||||
if (IsVarTerm(Father)) {
|
if (IsVarTerm(Father)) {
|
||||||
@ -5379,50 +5408,22 @@ p_dequeue_unlocked( USES_REGS1 )
|
|||||||
} else if (!IsIntegerTerm(Father)) {
|
} else if (!IsIntegerTerm(Father)) {
|
||||||
Yap_Error(TYPE_ERROR_INTEGER, Father, "dequeue");
|
Yap_Error(TYPE_ERROR_INTEGER, Father, "dequeue");
|
||||||
return FALSE;
|
return FALSE;
|
||||||
} else
|
|
||||||
father_key = (db_queue *)IntegerOfTerm(Father);
|
|
||||||
prev_instance = NULL;
|
|
||||||
cur_instance = father_key->FirstInQueue;
|
|
||||||
while (cur_instance) {
|
|
||||||
Term TDB;
|
|
||||||
while ((TDB = GetDBTerm(cur_instance->DBT, FALSE PASS_REGS)) == 0L) {
|
|
||||||
if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
|
|
||||||
LOCAL_Error_TYPE = YAP_NO_ERROR;
|
|
||||||
if (!Yap_growglobal(NULL)) {
|
|
||||||
Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage);
|
|
||||||
return FALSE;
|
|
||||||
}
|
|
||||||
} else {
|
} else {
|
||||||
LOCAL_Error_TYPE = YAP_NO_ERROR;
|
father_key = (db_queue *)IntegerOfTerm(Father);
|
||||||
if (!Yap_gcl(LOCAL_Error_Size, 2, ENV, gc_P(P,CP))) {
|
if ((cur_instance = father_key->FirstInQueue) == NULL) {
|
||||||
Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage);
|
/* an empty queue automatically goes away */
|
||||||
|
FreeDBSpace((char *)father_key);
|
||||||
return FALSE;
|
return FALSE;
|
||||||
}
|
}
|
||||||
}
|
if (!Yap_dequeue_tqueue(father_key, ARG2, true, true PASS_REGS) )
|
||||||
}
|
return FALSE;
|
||||||
if (Yap_unify(ARG2, TDB)) {
|
if (cur_instance == father_key->LastInQueue)
|
||||||
if (prev_instance) {
|
|
||||||
prev_instance->next = cur_instance->next;
|
|
||||||
if (father_key->LastInQueue == cur_instance)
|
|
||||||
father_key->LastInQueue = prev_instance;
|
|
||||||
} else if (cur_instance == father_key->LastInQueue)
|
|
||||||
father_key->FirstInQueue = father_key->LastInQueue = NULL;
|
father_key->FirstInQueue = father_key->LastInQueue = NULL;
|
||||||
else
|
else
|
||||||
father_key->FirstInQueue = cur_instance->next;
|
father_key->FirstInQueue = cur_instance->next;
|
||||||
/* release space for cur_instance */
|
|
||||||
keepdbrefs(cur_instance->DBT PASS_REGS);
|
|
||||||
ErasePendingRefs(cur_instance->DBT PASS_REGS);
|
|
||||||
FreeDBSpace((char *) cur_instance->DBT);
|
|
||||||
FreeDBSpace((char *) cur_instance);
|
|
||||||
return TRUE;
|
return TRUE;
|
||||||
} else {
|
|
||||||
prev_instance = cur_instance;
|
|
||||||
cur_instance = cur_instance->next;
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
/* an empty queue automatically goes away */
|
|
||||||
return FALSE;
|
|
||||||
}
|
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
p_peek_queue( USES_REGS1 )
|
p_peek_queue( USES_REGS1 )
|
||||||
@ -5437,34 +5438,22 @@ p_peek_queue( USES_REGS1 )
|
|||||||
} else if (!IsIntegerTerm(Father)) {
|
} else if (!IsIntegerTerm(Father)) {
|
||||||
Yap_Error(TYPE_ERROR_INTEGER, Father, "dequeue");
|
Yap_Error(TYPE_ERROR_INTEGER, Father, "dequeue");
|
||||||
return FALSE;
|
return FALSE;
|
||||||
} else
|
|
||||||
father_key = (db_queue *)IntegerOfTerm(Father);
|
|
||||||
cur_instance = father_key->FirstInQueue;
|
|
||||||
while (cur_instance) {
|
|
||||||
Term TDB;
|
|
||||||
while ((TDB = GetDBTerm(cur_instance->DBT, FALSE PASS_REGS)) == 0L) {
|
|
||||||
if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
|
|
||||||
LOCAL_Error_TYPE = YAP_NO_ERROR;
|
|
||||||
if (!Yap_growglobal(NULL)) {
|
|
||||||
Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage);
|
|
||||||
return FALSE;
|
|
||||||
}
|
|
||||||
} else {
|
} else {
|
||||||
LOCAL_Error_TYPE = YAP_NO_ERROR;
|
father_key = (db_queue *)IntegerOfTerm(Father);
|
||||||
if (!Yap_gcl(LOCAL_Error_Size, 2, ENV, gc_P(P,CP))) {
|
if ((cur_instance = father_key->FirstInQueue) == NULL) {
|
||||||
Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage);
|
/* an empty queue automatically goes away */
|
||||||
|
FreeDBSpace((char *)father_key);
|
||||||
return FALSE;
|
return FALSE;
|
||||||
}
|
}
|
||||||
}
|
if (!Yap_dequeue_tqueue(father_key, ARG2, true, false PASS_REGS) )
|
||||||
}
|
return FALSE;
|
||||||
if (Yap_unify(ARG2, TDB)) {
|
if (cur_instance == father_key->LastInQueue)
|
||||||
|
father_key->FirstInQueue = father_key->LastInQueue = NULL;
|
||||||
|
else
|
||||||
|
father_key->FirstInQueue = cur_instance->next;
|
||||||
return TRUE;
|
return TRUE;
|
||||||
}
|
}
|
||||||
cur_instance = cur_instance->next;
|
|
||||||
}
|
}
|
||||||
return FALSE;
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
|
14
C/globals.c
14
C/globals.c
@ -190,10 +190,11 @@ CreateNewArena(CELL *ptr, UInt size)
|
|||||||
}
|
}
|
||||||
|
|
||||||
static Term
|
static Term
|
||||||
NewArena(UInt size, UInt arity, CELL *where USES_REGS)
|
NewArena(UInt size, int wid, UInt arity, CELL *where)
|
||||||
{
|
{
|
||||||
Term t;
|
Term t;
|
||||||
UInt new_size;
|
UInt new_size;
|
||||||
|
WORKER_REGS(wid)
|
||||||
|
|
||||||
if (where == NULL || where == HR) {
|
if (where == NULL || where == HR) {
|
||||||
while (HR+size > ASP-1024) {
|
while (HR+size > ASP-1024) {
|
||||||
@ -226,7 +227,7 @@ p_allocate_arena( USES_REGS1 )
|
|||||||
Yap_Error(TYPE_ERROR_INTEGER,t,"allocate_arena");
|
Yap_Error(TYPE_ERROR_INTEGER,t,"allocate_arena");
|
||||||
return FALSE;
|
return FALSE;
|
||||||
}
|
}
|
||||||
return Yap_unify(ARG2,NewArena(IntegerOfTerm(t), 1, NULL PASS_REGS));
|
return Yap_unify(ARG2,NewArena(IntegerOfTerm(t), worker_id, 1, NULL));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
@ -240,8 +241,7 @@ p_default_arena_size( USES_REGS1 )
|
|||||||
void
|
void
|
||||||
Yap_AllocateDefaultArena(Int gsize, Int attsize, int wid)
|
Yap_AllocateDefaultArena(Int gsize, Int attsize, int wid)
|
||||||
{
|
{
|
||||||
CACHE_REGS
|
REMOTE_GlobalArena(wid) = NewArena(gsize, wid, 2, NULL);
|
||||||
REMOTE_GlobalArena(wid) = NewArena(gsize, 2, NULL PASS_REGS);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static void
|
static void
|
||||||
@ -1579,7 +1579,7 @@ nb_queue(UInt arena_sz USES_REGS)
|
|||||||
return FALSE;
|
return FALSE;
|
||||||
if (arena_sz < 4*1024)
|
if (arena_sz < 4*1024)
|
||||||
arena_sz = 4*1024;
|
arena_sz = 4*1024;
|
||||||
queue_arena = NewArena(arena_sz, 1, NULL PASS_REGS);
|
queue_arena = NewArena(arena_sz, worker_id, 1, NULL);
|
||||||
if (queue_arena == 0L) {
|
if (queue_arena == 0L) {
|
||||||
return FALSE;
|
return FALSE;
|
||||||
}
|
}
|
||||||
@ -1933,7 +1933,7 @@ p_nb_heap( USES_REGS1 )
|
|||||||
ar[HEAP_MAX] = tsize;
|
ar[HEAP_MAX] = tsize;
|
||||||
if (arena_sz < 1024)
|
if (arena_sz < 1024)
|
||||||
arena_sz = 1024;
|
arena_sz = 1024;
|
||||||
heap_arena = NewArena(arena_sz,1,NULL PASS_REGS);
|
heap_arena = NewArena(arena_sz,worker_id,1,NULL);
|
||||||
if (heap_arena == 0L) {
|
if (heap_arena == 0L) {
|
||||||
return FALSE;
|
return FALSE;
|
||||||
}
|
}
|
||||||
@ -2215,7 +2215,7 @@ p_nb_beam( USES_REGS1 )
|
|||||||
ar[HEAP_MAX] = tsize;
|
ar[HEAP_MAX] = tsize;
|
||||||
if (arena_sz < 1024)
|
if (arena_sz < 1024)
|
||||||
arena_sz = 1024;
|
arena_sz = 1024;
|
||||||
beam_arena = NewArena(arena_sz,1,NULL PASS_REGS);
|
beam_arena = NewArena(arena_sz,worker_id,1,NULL);
|
||||||
if (beam_arena == 0L) {
|
if (beam_arena == 0L) {
|
||||||
return FALSE;
|
return FALSE;
|
||||||
}
|
}
|
||||||
|
16
C/init.c
16
C/init.c
@ -1183,6 +1183,22 @@ InitThreadHandle(int wid)
|
|||||||
pthread_mutex_init(&(REMOTE_ThreadHandle(wid).tlock_status), NULL);
|
pthread_mutex_init(&(REMOTE_ThreadHandle(wid).tlock_status), NULL);
|
||||||
REMOTE_ThreadHandle(wid).tdetach = (CELL)0;
|
REMOTE_ThreadHandle(wid).tdetach = (CELL)0;
|
||||||
REMOTE_ThreadHandle(wid).cmod = (CELL)0;
|
REMOTE_ThreadHandle(wid).cmod = (CELL)0;
|
||||||
|
{
|
||||||
|
mbox_t * mboxp = &REMOTE_ThreadHandle(wid).mbox_handle;
|
||||||
|
pthread_mutex_t *mutexp;
|
||||||
|
pthread_cond_t *condp;
|
||||||
|
struct idb_queue *msgsp;
|
||||||
|
|
||||||
|
mboxp->name = MkIntTerm(0);
|
||||||
|
condp = & mboxp->cond;
|
||||||
|
pthread_cond_init(condp, NULL);
|
||||||
|
mutexp = & mboxp->mutex;
|
||||||
|
pthread_mutex_init(mutexp, NULL);
|
||||||
|
msgsp = & mboxp->msgs;
|
||||||
|
mboxp->nmsgs = 0;
|
||||||
|
Yap_init_tqueue(msgsp);
|
||||||
|
}
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
int
|
int
|
||||||
|
253
C/threads.c
253
C/threads.c
@ -51,6 +51,7 @@ static Int p_nodebug_locks( USES_REGS1 ) { debug_locks = 0; return TRUE; }
|
|||||||
|
|
||||||
#include "threads.h"
|
#include "threads.h"
|
||||||
|
|
||||||
|
|
||||||
/*
|
/*
|
||||||
* This file includes the definition of threads in Yap. Threads
|
* This file includes the definition of threads in Yap. Threads
|
||||||
* are supposed to be compatible with the SWI-Prolog thread package.
|
* are supposed to be compatible with the SWI-Prolog thread package.
|
||||||
@ -130,13 +131,116 @@ allocate_new_tid(void)
|
|||||||
return new_worker_id;
|
return new_worker_id;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static bool
|
||||||
|
mboxCreate( Term namet, mbox_t *mboxp USES_REGS )
|
||||||
|
{
|
||||||
|
pthread_mutex_t *mutexp;
|
||||||
|
pthread_cond_t *condp;
|
||||||
|
struct idb_queue *msgsp;
|
||||||
|
|
||||||
|
memset(mboxp, 0, sizeof(mbox_t));
|
||||||
|
UNLOCK(GLOBAL_mboxq_lock);
|
||||||
|
condp = & mboxp->cond;
|
||||||
|
pthread_cond_init(condp, NULL);
|
||||||
|
mutexp = & mboxp->mutex;
|
||||||
|
pthread_mutex_init(mutexp, NULL);
|
||||||
|
msgsp = & mboxp->msgs;
|
||||||
|
mboxp->nmsgs = 0;
|
||||||
|
mboxp->nclients = 0;
|
||||||
|
Yap_init_tqueue(msgsp);
|
||||||
|
// match at the end, when everything is built.
|
||||||
|
mboxp->name = namet;
|
||||||
|
return true;
|
||||||
|
}
|
||||||
|
|
||||||
|
static bool
|
||||||
|
mboxDestroy( mbox_t *mboxp USES_REGS )
|
||||||
|
{
|
||||||
|
pthread_mutex_t *mutexp = &mboxp->mutex;
|
||||||
|
pthread_cond_t *condp = &mboxp->cond;
|
||||||
|
struct idb_queue *msgsp = &mboxp->msgs;
|
||||||
|
|
||||||
|
if (mboxp->nclients == 0) {
|
||||||
|
pthread_cond_destroy(condp);
|
||||||
|
pthread_mutex_destroy(mutexp);
|
||||||
|
Yap_destroy_tqueue(msgsp PASS_REGS);
|
||||||
|
// at this point, there is nothing left to unlock!
|
||||||
|
return true;
|
||||||
|
} else {
|
||||||
|
/* we have clients in the mailbox, try to wake them up one by one */
|
||||||
|
if (mboxp->nclients > 0)
|
||||||
|
mboxp->nclients = - mboxp->nclients;
|
||||||
|
pthread_cond_signal(condp);
|
||||||
|
pthread_mutex_unlock(mutexp);
|
||||||
|
return true;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
static bool
|
||||||
|
mboxSend( mbox_t *mboxp, Term t USES_REGS )
|
||||||
|
{
|
||||||
|
pthread_mutex_t *mutexp = &mboxp->mutex;
|
||||||
|
pthread_cond_t *condp = &mboxp->cond;
|
||||||
|
struct idb_queue *msgsp = &mboxp->msgs;
|
||||||
|
|
||||||
|
if (mboxp->nclients < 0) {
|
||||||
|
// oops, dead mailbox
|
||||||
|
return false;
|
||||||
|
}
|
||||||
|
Yap_enqueue_tqueue(msgsp, t PASS_REGS);
|
||||||
|
mboxp->nmsgs++;
|
||||||
|
pthread_cond_broadcast(condp);
|
||||||
|
pthread_mutex_unlock(mutexp);
|
||||||
|
return true;
|
||||||
|
}
|
||||||
|
|
||||||
|
static bool
|
||||||
|
mboxReceive( mbox_t *mboxp, Term t USES_REGS )
|
||||||
|
{
|
||||||
|
pthread_mutex_t *mutexp = &mboxp->mutex;
|
||||||
|
pthread_cond_t *condp = &mboxp->cond;
|
||||||
|
struct idb_queue *msgsp = &mboxp->msgs;
|
||||||
|
bool rc;
|
||||||
|
|
||||||
|
if (mboxp->nclients >= 0) {
|
||||||
|
mboxp->nclients++;
|
||||||
|
} else {
|
||||||
|
return false; // don't try to read if someone else already closed down...
|
||||||
|
}
|
||||||
|
do {
|
||||||
|
rc = Yap_dequeue_tqueue(msgsp, t, false, true PASS_REGS);
|
||||||
|
if (rc) {
|
||||||
|
mboxp->nmsgs--;
|
||||||
|
if (mboxp->nclients > 0) {
|
||||||
|
mboxp->nclients--;
|
||||||
|
} else {
|
||||||
|
mboxp->nclients++;
|
||||||
|
return mboxDestroy( mboxp PASS_REGS);
|
||||||
|
}
|
||||||
|
pthread_mutex_unlock(mutexp);
|
||||||
|
} else {
|
||||||
|
pthread_cond_wait(condp, mutexp);
|
||||||
|
}
|
||||||
|
} while (!rc);
|
||||||
|
return rc;
|
||||||
|
}
|
||||||
|
|
||||||
|
static bool
|
||||||
|
mboxPeek( mbox_t *mboxp, Term t USES_REGS )
|
||||||
|
{
|
||||||
|
pthread_mutex_t *mutexp = &mboxp->mutex;
|
||||||
|
struct idb_queue *msgsp = &mboxp->msgs;
|
||||||
|
bool rc = Yap_dequeue_tqueue(msgsp, t, false, false PASS_REGS);
|
||||||
|
pthread_mutex_unlock(mutexp);
|
||||||
|
return rc;
|
||||||
|
}
|
||||||
|
|
||||||
static int
|
static int
|
||||||
store_specs(int new_worker_id, UInt ssize, UInt tsize, UInt sysize, Term *tpgoal, Term *tpdetach, Term *tpexit)
|
store_specs(int new_worker_id, UInt ssize, UInt tsize, UInt sysize, Term tgoal, Term tdetach, Term texit)
|
||||||
{
|
{
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
UInt pm; /* memory to be requested */
|
UInt pm; /* memory to be requested */
|
||||||
Term tmod;
|
Term tmod;
|
||||||
Term tdetach, tgoal;
|
|
||||||
|
|
||||||
if (tsize < MinTrailSpace)
|
if (tsize < MinTrailSpace)
|
||||||
tsize = MinTrailSpace;
|
tsize = MinTrailSpace;
|
||||||
@ -161,7 +265,7 @@ store_specs(int new_worker_id, UInt ssize, UInt tsize, UInt sysize, Term *tpgoal
|
|||||||
return FALSE;
|
return FALSE;
|
||||||
}
|
}
|
||||||
REMOTE_ThreadHandle(new_worker_id).tgoal =
|
REMOTE_ThreadHandle(new_worker_id).tgoal =
|
||||||
Yap_StoreTermInDB(Deref(*tpgoal), 7);
|
Yap_StoreTermInDB(Deref(tgoal), 7);
|
||||||
|
|
||||||
if (CurrentModule) {
|
if (CurrentModule) {
|
||||||
REMOTE_ThreadHandle(new_worker_id).cmod =
|
REMOTE_ThreadHandle(new_worker_id).cmod =
|
||||||
@ -169,7 +273,7 @@ store_specs(int new_worker_id, UInt ssize, UInt tsize, UInt sysize, Term *tpgoal
|
|||||||
} else {
|
} else {
|
||||||
REMOTE_ThreadHandle(new_worker_id).cmod = USER_MODULE;
|
REMOTE_ThreadHandle(new_worker_id).cmod = USER_MODULE;
|
||||||
}
|
}
|
||||||
tdetach = Deref(*tpdetach);
|
tdetach = Deref(tdetach);
|
||||||
if (IsVarTerm(tdetach)){
|
if (IsVarTerm(tdetach)){
|
||||||
REMOTE_ThreadHandle(new_worker_id).tdetach =
|
REMOTE_ThreadHandle(new_worker_id).tdetach =
|
||||||
MkAtomTerm(AtomFalse);
|
MkAtomTerm(AtomFalse);
|
||||||
@ -177,10 +281,10 @@ store_specs(int new_worker_id, UInt ssize, UInt tsize, UInt sysize, Term *tpgoal
|
|||||||
REMOTE_ThreadHandle(new_worker_id).tdetach =
|
REMOTE_ThreadHandle(new_worker_id).tdetach =
|
||||||
tdetach;
|
tdetach;
|
||||||
}
|
}
|
||||||
tgoal = Yap_StripModule(Deref(*tpexit), &tmod);
|
texit = Yap_StripModule(Deref(texit), &tmod);
|
||||||
REMOTE_ThreadHandle(new_worker_id).texit_mod = tmod;
|
REMOTE_ThreadHandle(new_worker_id).texit_mod = tmod;
|
||||||
REMOTE_ThreadHandle(new_worker_id).texit =
|
REMOTE_ThreadHandle(new_worker_id).texit =
|
||||||
Yap_StoreTermInDB(tgoal,7);
|
Yap_StoreTermInDB(texit,7);
|
||||||
REMOTE_ThreadHandle(new_worker_id).local_preds =
|
REMOTE_ThreadHandle(new_worker_id).local_preds =
|
||||||
NULL;
|
NULL;
|
||||||
REMOTE_ThreadHandle(new_worker_id).start_of_timesp =
|
REMOTE_ThreadHandle(new_worker_id).start_of_timesp =
|
||||||
@ -189,6 +293,8 @@ store_specs(int new_worker_id, UInt ssize, UInt tsize, UInt sysize, Term *tpgoal
|
|||||||
NULL;
|
NULL;
|
||||||
REMOTE_ScratchPad(new_worker_id).ptr =
|
REMOTE_ScratchPad(new_worker_id).ptr =
|
||||||
NULL;
|
NULL;
|
||||||
|
// reset arena info
|
||||||
|
REMOTE_GlobalArena(new_worker_id) =0;
|
||||||
return TRUE;
|
return TRUE;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -267,6 +373,8 @@ setup_engine(int myworker_id, int init_thread)
|
|||||||
REMOTE_PL_local_data_p(myworker_id)->reg_cache = standard_regs;
|
REMOTE_PL_local_data_p(myworker_id)->reg_cache = standard_regs;
|
||||||
Yap_InitExStacks(myworker_id, REMOTE_ThreadHandle(myworker_id).tsize, REMOTE_ThreadHandle(myworker_id).ssize);
|
Yap_InitExStacks(myworker_id, REMOTE_ThreadHandle(myworker_id).tsize, REMOTE_ThreadHandle(myworker_id).ssize);
|
||||||
REMOTE_SourceModule(myworker_id) = CurrentModule = REMOTE_ThreadHandle(myworker_id).cmod;
|
REMOTE_SourceModule(myworker_id) = CurrentModule = REMOTE_ThreadHandle(myworker_id).cmod;
|
||||||
|
// create a mbox
|
||||||
|
mboxCreate( MkIntTerm(myworker_id), &REMOTE_ThreadHandle(myworker_id).mbox_handle PASS_REGS );
|
||||||
Yap_InitTime( myworker_id );
|
Yap_InitTime( myworker_id );
|
||||||
Yap_InitYaamRegs( myworker_id );
|
Yap_InitYaamRegs( myworker_id );
|
||||||
REFRESH_CACHE_REGS
|
REFRESH_CACHE_REGS
|
||||||
@ -384,7 +492,7 @@ p_thread_new_tid( USES_REGS1 )
|
|||||||
}
|
}
|
||||||
|
|
||||||
static int
|
static int
|
||||||
init_thread_engine(int new_worker_id, UInt ssize, UInt tsize, UInt sysize, Term *tgoal, Term *tdetach, Term *texit)
|
init_thread_engine(int new_worker_id, UInt ssize, UInt tsize, UInt sysize, Term tgoal, Term tdetach, Term texit)
|
||||||
{
|
{
|
||||||
return store_specs(new_worker_id, ssize, tsize, sysize, tgoal, tdetach, texit);
|
return store_specs(new_worker_id, ssize, tsize, sysize, tgoal, tdetach, texit);
|
||||||
}
|
}
|
||||||
@ -415,7 +523,7 @@ p_create_thread( USES_REGS1 )
|
|||||||
return FALSE;
|
return FALSE;
|
||||||
}
|
}
|
||||||
/* make sure we can proceed */
|
/* make sure we can proceed */
|
||||||
if (!init_thread_engine(new_worker_id, ssize, tsize, sysize, &ARG1, &ARG5, &ARG6))
|
if (!init_thread_engine(new_worker_id, ssize, tsize, sysize, ARG1, ARG5, ARG6))
|
||||||
return FALSE;
|
return FALSE;
|
||||||
//REMOTE_ThreadHandle(new_worker_id).pthread_handle = 0L;
|
//REMOTE_ThreadHandle(new_worker_id).pthread_handle = 0L;
|
||||||
REMOTE_ThreadHandle(new_worker_id).id = new_worker_id;
|
REMOTE_ThreadHandle(new_worker_id).id = new_worker_id;
|
||||||
@ -547,7 +655,7 @@ Yap_thread_create_engine(YAP_thread_attr *ops)
|
|||||||
pthread_setspecific(Yap_yaamregs_key, (const void *)&Yap_standard_regs);
|
pthread_setspecific(Yap_yaamregs_key, (const void *)&Yap_standard_regs);
|
||||||
MUTEX_LOCK(&(REMOTE_ThreadHandle(0).tlock));
|
MUTEX_LOCK(&(REMOTE_ThreadHandle(0).tlock));
|
||||||
}
|
}
|
||||||
if (!init_thread_engine(new_id, ops->ssize, ops->tsize, ops->sysize, &t, &t, &(ops->egoal)))
|
if (!init_thread_engine(new_id, ops->ssize, ops->tsize, ops->sysize, t, t, (ops->egoal)))
|
||||||
return -1;
|
return -1;
|
||||||
//REMOTE_ThreadHandle(new_id).pthread_handle = 0L;
|
//REMOTE_ThreadHandle(new_id).pthread_handle = 0L;
|
||||||
REMOTE_ThreadHandle(new_id).id = new_id;
|
REMOTE_ThreadHandle(new_id).id = new_id;
|
||||||
@ -848,6 +956,127 @@ p_cond_create( USES_REGS1 )
|
|||||||
return Yap_unify(ARG1, MkIntegerTerm((Int)condp));
|
return Yap_unify(ARG1, MkIntegerTerm((Int)condp));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
static Int
|
||||||
|
p_mbox_create( USES_REGS1 )
|
||||||
|
{
|
||||||
|
Term namet = Deref(ARG1);
|
||||||
|
mbox_t* mboxp = GLOBAL_named_mboxes;
|
||||||
|
|
||||||
|
if (IsVarTerm(namet)) {
|
||||||
|
char buf[256];
|
||||||
|
sprintf(buf, "$%p", mboxp);
|
||||||
|
namet = MkAtomTerm(Yap_FullLookupAtom(buf));
|
||||||
|
Yap_unify(ARG1, namet);
|
||||||
|
}
|
||||||
|
if (IsAtomTerm(namet)) {
|
||||||
|
LOCK(GLOBAL_mboxq_lock);
|
||||||
|
while( mboxp && mboxp->name != namet)
|
||||||
|
mboxp = mboxp->next;
|
||||||
|
if (mboxp) {
|
||||||
|
UNLOCK(GLOBAL_mboxq_lock);
|
||||||
|
return FALSE;
|
||||||
|
}
|
||||||
|
mboxp = (mbox_t *)Yap_AllocCodeSpace(sizeof(mbox_t));
|
||||||
|
if (mboxp == NULL) {
|
||||||
|
UNLOCK(GLOBAL_mboxq_lock);
|
||||||
|
return FALSE;
|
||||||
|
}
|
||||||
|
// global mbox, for now we'll just insert in list
|
||||||
|
mboxp->next = GLOBAL_named_mboxes;
|
||||||
|
GLOBAL_named_mboxes = mboxp;
|
||||||
|
}
|
||||||
|
return mboxCreate( namet, mboxp PASS_REGS );
|
||||||
|
}
|
||||||
|
|
||||||
|
static Int
|
||||||
|
p_mbox_destroy( USES_REGS1 )
|
||||||
|
{
|
||||||
|
Term namet = Deref(ARG1);
|
||||||
|
mbox_t* mboxp = GLOBAL_named_mboxes, *prevp;
|
||||||
|
|
||||||
|
if (IsVarTerm(namet) || !IsAtomTerm(namet))
|
||||||
|
return FALSE;
|
||||||
|
LOCK(GLOBAL_mboxq_lock);
|
||||||
|
prevp = NULL;
|
||||||
|
while( mboxp && mboxp->name != namet) {
|
||||||
|
prevp = mboxp;
|
||||||
|
mboxp = mboxp->next;
|
||||||
|
}
|
||||||
|
if (!mboxp) {
|
||||||
|
UNLOCK(GLOBAL_mboxq_lock);
|
||||||
|
return FALSE;
|
||||||
|
}
|
||||||
|
if (mboxp == GLOBAL_named_mboxes) {
|
||||||
|
GLOBAL_named_mboxes = mboxp->next;
|
||||||
|
} else {
|
||||||
|
prevp->next = mboxp->next;
|
||||||
|
}
|
||||||
|
UNLOCK(GLOBAL_mboxq_lock);
|
||||||
|
mboxDestroy(mboxp PASS_REGS);
|
||||||
|
Yap_FreeCodeSpace( (char *)mboxp );
|
||||||
|
return TRUE;
|
||||||
|
}
|
||||||
|
|
||||||
|
static mbox_t*
|
||||||
|
getMbox(Term t)
|
||||||
|
{
|
||||||
|
mbox_t* mboxp;
|
||||||
|
if (IsAtomTerm(t)) {
|
||||||
|
LOCK(GLOBAL_mboxq_lock);
|
||||||
|
mboxp = GLOBAL_named_mboxes;
|
||||||
|
while( mboxp && mboxp->name != t) {
|
||||||
|
mboxp = mboxp->next;
|
||||||
|
}
|
||||||
|
} else if (IsIntTerm(t)) {
|
||||||
|
int wid = IntOfTerm(t);
|
||||||
|
if (REMOTE(wid) &&
|
||||||
|
(REMOTE_ThreadHandle(wid).in_use || REMOTE_ThreadHandle(wid).zombie))
|
||||||
|
{
|
||||||
|
return &REMOTE_ThreadHandle(wid).mbox_handle;
|
||||||
|
} else {
|
||||||
|
return NULL;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
return NULL;
|
||||||
|
}
|
||||||
|
if (mboxp) {
|
||||||
|
pthread_mutex_lock(& mboxp->mutex);
|
||||||
|
}
|
||||||
|
UNLOCK(GLOBAL_mboxq_lock);
|
||||||
|
return mboxp;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
static Int
|
||||||
|
p_mbox_send( USES_REGS1 )
|
||||||
|
{
|
||||||
|
Term namet = Deref(ARG1);
|
||||||
|
mbox_t* mboxp = getMbox(namet) ;
|
||||||
|
|
||||||
|
return mboxSend(mboxp, Deref(ARG2) PASS_REGS);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
static Int
|
||||||
|
p_mbox_receive( USES_REGS1 )
|
||||||
|
{
|
||||||
|
Term namet = Deref(ARG1);
|
||||||
|
mbox_t* mboxp = getMbox(namet) ;
|
||||||
|
|
||||||
|
return mboxReceive(mboxp, Deref(ARG2) PASS_REGS);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
static Int
|
||||||
|
p_mbox_peek( USES_REGS1 )
|
||||||
|
{
|
||||||
|
Term namet = Deref(ARG1);
|
||||||
|
mbox_t* mboxp = getMbox(namet) ;
|
||||||
|
|
||||||
|
return mboxPeek(mboxp, Deref(ARG2) PASS_REGS);
|
||||||
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
p_cond_destroy( USES_REGS1 )
|
p_cond_destroy( USES_REGS1 )
|
||||||
{
|
{
|
||||||
@ -884,7 +1113,6 @@ p_cond_wait( USES_REGS1 )
|
|||||||
{
|
{
|
||||||
pthread_cond_t *condp = (pthread_cond_t *)IntegerOfTerm(Deref(ARG1));
|
pthread_cond_t *condp = (pthread_cond_t *)IntegerOfTerm(Deref(ARG1));
|
||||||
SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG2));
|
SWIMutex *mut = (SWIMutex*)IntegerOfTerm(Deref(ARG2));
|
||||||
|
|
||||||
pthread_cond_wait(condp, &mut->m);
|
pthread_cond_wait(condp, &mut->m);
|
||||||
return TRUE;
|
return TRUE;
|
||||||
}
|
}
|
||||||
@ -1112,6 +1340,11 @@ and succeeds silently.
|
|||||||
Yap_InitCPred("$cond_signal", 1, p_cond_signal, SafePredFlag);
|
Yap_InitCPred("$cond_signal", 1, p_cond_signal, SafePredFlag);
|
||||||
Yap_InitCPred("$cond_broadcast", 1, p_cond_broadcast, SafePredFlag);
|
Yap_InitCPred("$cond_broadcast", 1, p_cond_broadcast, SafePredFlag);
|
||||||
Yap_InitCPred("$cond_wait", 2, p_cond_wait, SafePredFlag);
|
Yap_InitCPred("$cond_wait", 2, p_cond_wait, SafePredFlag);
|
||||||
|
Yap_InitCPred("$message_queue_create", 1, p_mbox_create, SafePredFlag);
|
||||||
|
Yap_InitCPred("$message_queue_destroy", 1, p_mbox_destroy, SafePredFlag);
|
||||||
|
Yap_InitCPred("$message_queue_send", 2, p_mbox_send, SafePredFlag);
|
||||||
|
Yap_InitCPred("$message_queue_receive", 2, p_mbox_receive, SafePredFlag);
|
||||||
|
Yap_InitCPred("$message_queue_peek", 2, p_mbox_peek, SafePredFlag);
|
||||||
Yap_InitCPred("$thread_stacks", 4, p_thread_stacks, SafePredFlag);
|
Yap_InitCPred("$thread_stacks", 4, p_thread_stacks, SafePredFlag);
|
||||||
Yap_InitCPred("$signal_thread", 1, p_thread_signal, SafePredFlag);
|
Yap_InitCPred("$signal_thread", 1, p_thread_signal, SafePredFlag);
|
||||||
Yap_InitCPred("$nof_threads", 1, p_nof_threads, SafePredFlag);
|
Yap_InitCPred("$nof_threads", 1, p_nof_threads, SafePredFlag);
|
||||||
|
@ -133,7 +133,7 @@ check_area(void)
|
|||||||
PredEntry *old_p[10000];
|
PredEntry *old_p[10000];
|
||||||
Term old_x1[10000], old_x2[10000], old_x3[10000];
|
Term old_x1[10000], old_x2[10000], old_x3[10000];
|
||||||
|
|
||||||
static CELL oldv;
|
//static CELL oldv;
|
||||||
|
|
||||||
void
|
void
|
||||||
low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
|
low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
|
||||||
|
4
H/Regs.h
4
H/Regs.h
@ -85,6 +85,7 @@ INLINE_ONLY inline EXTERN void save_B(void);
|
|||||||
#define PASS_REGS
|
#define PASS_REGS
|
||||||
#define USES_REGS1 void
|
#define USES_REGS1 void
|
||||||
#define USES_REGS
|
#define USES_REGS
|
||||||
|
#define WORKER_REGS(WID)
|
||||||
|
|
||||||
typedef struct regstore_t
|
typedef struct regstore_t
|
||||||
{
|
{
|
||||||
@ -179,13 +180,16 @@ extern pthread_key_t Yap_yaamregs_key;
|
|||||||
#undef CACHE_REGS
|
#undef CACHE_REGS
|
||||||
#undef REFRESH_CACHE_REGS
|
#undef REFRESH_CACHE_REGS
|
||||||
#undef INIT_REGS
|
#undef INIT_REGS
|
||||||
|
#undef CACHE_REGS
|
||||||
#undef PASS_REGS
|
#undef PASS_REGS
|
||||||
#undef PASS_REGS1
|
#undef PASS_REGS1
|
||||||
#undef USES_REGS
|
#undef USES_REGS
|
||||||
#undef USES_REGS1
|
#undef USES_REGS1
|
||||||
|
#undef WORKER_REGS
|
||||||
#define CACHE_REGS REGSTORE *regcache = ((REGSTORE *)pthread_getspecific(Yap_yaamregs_key));
|
#define CACHE_REGS REGSTORE *regcache = ((REGSTORE *)pthread_getspecific(Yap_yaamregs_key));
|
||||||
#define REFRESH_CACHE_REGS regcache = ((REGSTORE *)pthread_getspecific(Yap_yaamregs_key));
|
#define REFRESH_CACHE_REGS regcache = ((REGSTORE *)pthread_getspecific(Yap_yaamregs_key));
|
||||||
#define INIT_REGS , ((REGSTORE *)pthread_getspecific(Yap_yaamregs_key))
|
#define INIT_REGS , ((REGSTORE *)pthread_getspecific(Yap_yaamregs_key))
|
||||||
|
#define WORKER_REGS(WID) REGSTORE *regcache = REMOTE_ThreadHandle(WID).current_yaam_regs;
|
||||||
#define PASS_REGS1 regcache
|
#define PASS_REGS1 regcache
|
||||||
#define PASS_REGS , regcache
|
#define PASS_REGS , regcache
|
||||||
#define USES_REGS1 struct regstore_t *regcache
|
#define USES_REGS1 struct regstore_t *regcache
|
||||||
|
33
H/Yap.h
33
H/Yap.h
@ -652,7 +652,39 @@ typedef enum
|
|||||||
|
|
||||||
|
|
||||||
/************************/
|
/************************/
|
||||||
|
// queues are an example of collections of DB objects
|
||||||
|
typedef struct queue_entry {
|
||||||
|
struct queue_entry *next;
|
||||||
|
struct DB_TERM *DBT;
|
||||||
|
} QueueEntry;
|
||||||
|
|
||||||
|
typedef struct idb_queue
|
||||||
|
{
|
||||||
|
struct FunctorEntryStruct *id; /* identify this as being pointed to by a DBRef */
|
||||||
|
SMALLUNSGN Flags; /* always required */
|
||||||
|
#if PARALLEL_YAP
|
||||||
|
rwlock_t QRWLock; /* a simple lock to protect this entry */
|
||||||
|
#endif
|
||||||
|
QueueEntry *FirstInQueue, *LastInQueue;
|
||||||
|
} db_queue;
|
||||||
|
|
||||||
|
void Yap_init_tqueue( db_queue *dbq );
|
||||||
|
void Yap_destroy_tqueue( db_queue *dbq USES_REGS);
|
||||||
|
bool Yap_enqueue_tqueue(db_queue *father_key, Term t USES_REGS);
|
||||||
|
bool Yap_dequeue_tqueue(db_queue *father_key, Term t, bool first, bool release USES_REGS);
|
||||||
|
|
||||||
#ifdef THREADS
|
#ifdef THREADS
|
||||||
|
|
||||||
|
|
||||||
|
typedef struct thread_mbox {
|
||||||
|
Term name;
|
||||||
|
pthread_mutex_t mutex;
|
||||||
|
pthread_cond_t cond;
|
||||||
|
struct idb_queue msgs;
|
||||||
|
int nmsgs, nclients; // if nclients < 0 mailbox has been closed.
|
||||||
|
struct thread_mbox *next;
|
||||||
|
} mbox_t;
|
||||||
|
|
||||||
typedef struct thandle {
|
typedef struct thandle {
|
||||||
int in_use;
|
int in_use;
|
||||||
int zombie;
|
int zombie;
|
||||||
@ -669,6 +701,7 @@ typedef struct thandle {
|
|||||||
REGSTORE *current_yaam_regs;
|
REGSTORE *current_yaam_regs;
|
||||||
struct pred_entry *local_preds;
|
struct pred_entry *local_preds;
|
||||||
pthread_t pthread_handle;
|
pthread_t pthread_handle;
|
||||||
|
mbox_t mbox_handle;
|
||||||
int ref_count;
|
int ref_count;
|
||||||
#ifdef LOW_LEVEL_TRACER
|
#ifdef LOW_LEVEL_TRACER
|
||||||
long long int thread_inst_count;
|
long long int thread_inst_count;
|
||||||
|
@ -904,7 +904,7 @@ typedef struct DB_STRUCT
|
|||||||
|
|
||||||
#define DBStructFlagsToDBStruct(X) ((DBRef)((char *)(X) - (CELL) &(((DBRef) NULL)->Flags)))
|
#define DBStructFlagsToDBStruct(X) ((DBRef)((char *)(X) - (CELL) &(((DBRef) NULL)->Flags)))
|
||||||
|
|
||||||
#if MULTIPLE_STAACKS
|
#if MULTIPLE_STACKS
|
||||||
#define INIT_DBREF_COUNT(X) (X)->ref_count = 0
|
#define INIT_DBREF_COUNT(X) (X)->ref_count = 0
|
||||||
#define INC_DBREF_COUNT(X) (X)->ref_count++
|
#define INC_DBREF_COUNT(X) (X)->ref_count++
|
||||||
#define DEC_DBREF_COUNT(X) (X)->ref_count--
|
#define DEC_DBREF_COUNT(X) (X)->ref_count--
|
||||||
|
@ -61,6 +61,8 @@
|
|||||||
|
|
||||||
#if defined(THREADS)
|
#if defined(THREADS)
|
||||||
#define GLOBAL_master_thread Yap_global->master_thread_
|
#define GLOBAL_master_thread Yap_global->master_thread_
|
||||||
|
#define GLOBAL_named_mboxes Yap_global->named_mboxes_
|
||||||
|
#define GLOBAL_mboxq_lock Yap_global->mboxq_lock_
|
||||||
#endif /* THREADS */
|
#endif /* THREADS */
|
||||||
|
|
||||||
#define GLOBAL_stdout Yap_global->stdout_
|
#define GLOBAL_stdout Yap_global->stdout_
|
||||||
|
@ -61,6 +61,8 @@ typedef struct global_data {
|
|||||||
|
|
||||||
#if defined(THREADS)
|
#if defined(THREADS)
|
||||||
pthread_t master_thread_;
|
pthread_t master_thread_;
|
||||||
|
struct thread_mbox* named_mboxes_;
|
||||||
|
lockvar mboxq_lock_;
|
||||||
#endif /* THREADS */
|
#endif /* THREADS */
|
||||||
|
|
||||||
struct io_stream* stdout_;
|
struct io_stream* stdout_;
|
||||||
|
@ -61,6 +61,8 @@ static void InitGlobal(void) {
|
|||||||
|
|
||||||
#if defined(THREADS)
|
#if defined(THREADS)
|
||||||
|
|
||||||
|
GLOBAL_named_mboxes = NULL;
|
||||||
|
INIT_LOCK(GLOBAL_mboxq_lock);
|
||||||
#endif /* THREADS */
|
#endif /* THREADS */
|
||||||
|
|
||||||
GLOBAL_stdout = Soutput;
|
GLOBAL_stdout = Soutput;
|
||||||
|
@ -61,6 +61,8 @@ static void RestoreGlobal(void) {
|
|||||||
|
|
||||||
#if defined(THREADS)
|
#if defined(THREADS)
|
||||||
|
|
||||||
|
|
||||||
|
REINIT_LOCK(GLOBAL_mboxq_lock);
|
||||||
#endif /* THREADS */
|
#endif /* THREADS */
|
||||||
|
|
||||||
|
|
||||||
|
@ -69,6 +69,8 @@ int PrologShouldHandleInterrupts void
|
|||||||
/* This is the guy who actually started the system, and who has the correct registers */
|
/* This is the guy who actually started the system, and who has the correct registers */
|
||||||
#if defined(THREADS)
|
#if defined(THREADS)
|
||||||
pthread_t master_thread void
|
pthread_t master_thread void
|
||||||
|
struct thread_mbox* named_mboxes =NULL
|
||||||
|
lockvar mboxq_lock MkLock
|
||||||
#endif /* THREADS */
|
#endif /* THREADS */
|
||||||
|
|
||||||
// streams
|
// streams
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
|
|
||||||
:- use_module(library(lineutils),
|
:- use_module(library(lineutils),
|
||||||
[file_filter_with_init/5,
|
[file_filter_with_initialization/5,
|
||||||
split/3,
|
split/3,
|
||||||
glue/3]).
|
glue/3]).
|
||||||
|
|
||||||
@ -18,18 +18,18 @@
|
|||||||
|
|
||||||
main :-
|
main :-
|
||||||
warning(Warning),
|
warning(Warning),
|
||||||
%file_filter_with_init('misc/HEAPFIELDS','H/hstruct.h',gen_struct,Warning,['hstruct.h','HEAPFIELDS']),
|
%file_filter_with_initialization('misc/HEAPFIELDS','H/hstruct.h',gen_struct,Warning,['hstruct.h','HEAPFIELDS']),
|
||||||
%file_filter_with_init('misc/HEAPFIELDS','H/dhstruct.h',gen_dstruct,Warning,['dhstruct.h','HEAPFIELDS']),
|
%file_filter_with_initialization('misc/HEAPFIELDS','H/dhstruct.h',gen_dstruct,Warning,['dhstruct.h','HEAPFIELDS']),
|
||||||
%file_filter_with_init('misc/HEAPFIELDS','H/rhstruct.h',gen_hstruct,Warning,['rhstruct.h','HEAPFIELDS']),
|
%file_filter_with_initialization('misc/HEAPFIELDS','H/rhstruct.h',gen_hstruct,Warning,['rhstruct.h','HEAPFIELDS']),
|
||||||
%file_filter_with_init('misc/HEAPFIELDS','H/ihstruct.h',gen_init,Warning,['ihstruct.h','HEAPFIELDS']),
|
%file_filter_with_initialization('misc/HEAPFIELDS','H/ihstruct.h',gen_init,Warning,['ihstruct.h','HEAPFIELDS']),
|
||||||
file_filter_with_init('misc/GLOBALS','H/hglobals.h',gen_struct,Warning,['hglobals.h','GLOBALS']),
|
file_filter_with_initialization('misc/GLOBALS','H/hglobals.h',gen_struct,Warning,['hglobals.h','GLOBALS']),
|
||||||
file_filter_with_init('misc/GLOBALS','H/dglobals.h',gen_dstruct,Warning,['dglobals.h','GLOBALS']),
|
file_filter_with_initialization('misc/GLOBALS','H/dglobals.h',gen_dstruct,Warning,['dglobals.h','GLOBALS']),
|
||||||
file_filter_with_init('misc/GLOBALS','H/rglobals.h',gen_hstruct,Warning,['rglobals.h','GLOBALS']),
|
file_filter_with_initialization('misc/GLOBALS','H/rglobals.h',gen_hstruct,Warning,['rglobals.h','GLOBALS']),
|
||||||
file_filter_with_init('misc/GLOBALS','H/iglobals.h',gen_init,Warning,['iglobals.h','GLOBALS']),
|
file_filter_with_initialization('misc/GLOBALS','H/iglobals.h',gen_init,Warning,['iglobals.h','GLOBALS']),
|
||||||
file_filter_with_init('misc/LOCALS','H/hlocals.h',gen_struct,Warning,['hlocals.h','LOCALS']),
|
file_filter_with_initialization('misc/LOCALS','H/hlocals.h',gen_struct,Warning,['hlocals.h','LOCALS']),
|
||||||
file_filter_with_init('misc/LOCALS','H/dlocals.h',gen_dstruct,Warning,['dlocals.h','LOCALS']),
|
file_filter_with_initialization('misc/LOCALS','H/dlocals.h',gen_dstruct,Warning,['dlocals.h','LOCALS']),
|
||||||
file_filter_with_init('misc/LOCALS','H/rlocals.h',gen_hstruct,Warning,['rlocals.h','LOCALS']),
|
file_filter_with_initialization('misc/LOCALS','H/rlocals.h',gen_hstruct,Warning,['rlocals.h','LOCALS']),
|
||||||
file_filter_with_init('misc/LOCALS','H/ilocals.h',gen_init,Warning,['ilocals.h','LOCALS']).
|
file_filter_with_initialization('misc/LOCALS','H/ilocals.h',gen_init,Warning,['ilocals.h','LOCALS']).
|
||||||
|
|
||||||
warning('~n /* This file, ~a, was generated automatically by \"yap -L misc/buildlocalglobal\"~n please do not update, update misc/~a instead */~n~n').
|
warning('~n /* This file, ~a, was generated automatically by \"yap -L misc/buildlocalglobal\"~n please do not update, update misc/~a instead */~n~n').
|
||||||
|
|
||||||
|
166
pl/threads.yap
166
pl/threads.yap
@ -122,18 +122,21 @@ volatile(P) :-
|
|||||||
'$init_thread0' :-
|
'$init_thread0' :-
|
||||||
'$no_threads', !.
|
'$no_threads', !.
|
||||||
'$init_thread0' :-
|
'$init_thread0' :-
|
||||||
recorda('$thread_defaults', [0, 0, 0, false, true], _),
|
mutex_create(WMId),
|
||||||
'$create_thread_mq'(0),
|
assert_static(prolog:'$with_mutex_mutex'(WMId) ),
|
||||||
'$new_mutex'(Id),
|
fail.
|
||||||
assert_static(prolog:'$with_mutex_mutex'(Id)).
|
'$init_thread0' :-
|
||||||
|
recorda('$thread_defaults', [0, 0, 0, false, true], _).
|
||||||
|
|
||||||
'$reinit_thread0' :-
|
'$reinit_thread0' :-
|
||||||
'$no_threads', !.
|
'$no_threads', !.
|
||||||
|
'$reinit_thread0' :- fail,
|
||||||
|
abolish(prolog:'$with_mutex_mutex'/1),
|
||||||
|
fail.
|
||||||
'$reinit_thread0' :-
|
'$reinit_thread0' :-
|
||||||
'$create_thread_mq'(0),
|
mutex_create(WMId),
|
||||||
% abolish(prolog:'$with_mutex_mutex',1),
|
asserta_static( ( prolog:'$with_mutex_mutex'(WMId) :- !) ).
|
||||||
'$new_mutex'(Id),
|
|
||||||
asserta_static((prolog:'$with_mutex_mutex'(Id) :- !)).
|
|
||||||
|
|
||||||
'$top_thread_goal'(G, Detached) :-
|
'$top_thread_goal'(G, Detached) :-
|
||||||
'$thread_self'(Id),
|
'$thread_self'(Id),
|
||||||
@ -175,7 +178,6 @@ thread_create(Goal) :-
|
|||||||
'$thread_options'([detached(true)], [], Stack, Trail, System, Detached, AtExit, G0),
|
'$thread_options'([detached(true)], [], Stack, Trail, System, Detached, AtExit, G0),
|
||||||
'$thread_new_tid'(Id),
|
'$thread_new_tid'(Id),
|
||||||
% '$erase_thread_info'(Id), % this should not be here
|
% '$erase_thread_info'(Id), % this should not be here
|
||||||
'$create_thread_mq'(Id),
|
|
||||||
(
|
(
|
||||||
'$create_thread'(Goal, Stack, Trail, System, Detached, AtExit, Id)
|
'$create_thread'(Goal, Stack, Trail, System, Detached, AtExit, Id)
|
||||||
->
|
->
|
||||||
@ -199,7 +201,6 @@ thread_create(Goal, Id) :-
|
|||||||
'$thread_options'([], [], Stack, Trail, System, Detached, AtExit, G0),
|
'$thread_options'([], [], Stack, Trail, System, Detached, AtExit, G0),
|
||||||
'$thread_new_tid'(Id),
|
'$thread_new_tid'(Id),
|
||||||
% '$erase_thread_info'(Id), % this should not be here
|
% '$erase_thread_info'(Id), % this should not be here
|
||||||
'$create_thread_mq'(Id),
|
|
||||||
(
|
(
|
||||||
'$create_thread'(Goal, Stack, Trail, System, Detached, AtExit, Id)
|
'$create_thread'(Goal, Stack, Trail, System, Detached, AtExit, Id)
|
||||||
->
|
->
|
||||||
@ -260,7 +261,6 @@ thread_create(Goal, Id, Options) :-
|
|||||||
'$thread_new_tid'(Id),
|
'$thread_new_tid'(Id),
|
||||||
% '$erase_thread_info'(Id), % this should not be here
|
% '$erase_thread_info'(Id), % this should not be here
|
||||||
'$record_alias_info'(Id, Alias),
|
'$record_alias_info'(Id, Alias),
|
||||||
'$create_thread_mq'(Id),
|
|
||||||
(
|
(
|
||||||
'$create_thread'(Goal, Stack, Trail, System, Detached, AtExit, Id)
|
'$create_thread'(Goal, Stack, Trail, System, Detached, AtExit, Id)
|
||||||
->
|
->
|
||||||
@ -278,10 +278,6 @@ thread_create(Goal, Id, Options) :-
|
|||||||
recorded('$thread_exit_hook', [Id|_], R),
|
recorded('$thread_exit_hook', [Id|_], R),
|
||||||
erase(R),
|
erase(R),
|
||||||
fail.
|
fail.
|
||||||
'$erase_thread_info'(Id) :-
|
|
||||||
recorded('$queue',q(Id,_,_,_,QKey),_),
|
|
||||||
'$empty_mqueue'(QKey),
|
|
||||||
fail.
|
|
||||||
'$erase_thread_info'(_).
|
'$erase_thread_info'(_).
|
||||||
|
|
||||||
|
|
||||||
@ -1187,15 +1183,10 @@ message_queue_create(Id, [alias(Alias)]) :-
|
|||||||
message_queue_create(Id, [alias(Alias)]) :-
|
message_queue_create(Id, [alias(Alias)]) :-
|
||||||
\+ atom(Alias), !,
|
\+ atom(Alias), !,
|
||||||
'$do_error'(type_error(atom,Alias), message_queue_create(Id, [alias(Alias)])).
|
'$do_error'(type_error(atom,Alias), message_queue_create(Id, [alias(Alias)])).
|
||||||
message_queue_create(Id, [alias(Alias)]) :- !,
|
message_queue_create(Alias, [alias(Alias)]) :- !,
|
||||||
'$new_mutex'(Mutex),
|
( recorded('$thread_alias', [_|Alias], _) ->
|
||||||
'$cond_create'(Cond),
|
'$do_error'(permission_error(create,queue,alias(Alias)),message_queue_create(Alias, [alias(Alias)]))
|
||||||
( recorded('$queue', q(Alias,_,_,_,_), _) ->
|
; '$message_queue_create'(Alias)
|
||||||
'$do_error'(permission_error(create,queue,alias(Alias)),message_queue_create(Id, [alias(Alias)]))
|
|
||||||
; recorded('$thread_alias', [_|Alias], _) ->
|
|
||||||
'$do_error'(permission_error(create,queue,alias(Alias)),message_queue_create(Id, [alias(Alias)]))
|
|
||||||
; '$mq_new_id'(Id, NId, Key),
|
|
||||||
recorda('$queue',q(Alias,Mutex,Cond,NId,Key), _)
|
|
||||||
).
|
).
|
||||||
message_queue_create(Id, [Option| _]) :-
|
message_queue_create(Id, [Option| _]) :-
|
||||||
'$do_error'(domain_error(queue_option, Option), message_queue_create(Id, [Option| _])).
|
'$do_error'(domain_error(queue_option, Option), message_queue_create(Id, [Option| _])).
|
||||||
@ -1214,51 +1205,12 @@ created and _Queue_ is unified to its identifier.
|
|||||||
*/
|
*/
|
||||||
message_queue_create(Id) :-
|
message_queue_create(Id) :-
|
||||||
( var(Id) -> % ISO DTR
|
( var(Id) -> % ISO DTR
|
||||||
message_queue_create(Id, [])
|
'$message_queue_create'(Id)
|
||||||
; atom(Id) -> % old behavior
|
; atom(Id) -> % old behavior
|
||||||
message_queue_create(_, [alias(Id)])
|
'$message_queue_create'(Id)
|
||||||
; '$do_error'(uninstantiation_error(Id), message_queue_create(Id))
|
; '$do_error'(uninstantiation_error(Id), message_queue_create(Id))
|
||||||
).
|
).
|
||||||
|
|
||||||
'$do_msg_queue_create'(Id) :-
|
|
||||||
\+ recorded('$queue',q(Id,_,_,_,_), _),
|
|
||||||
'$new_mutex'(Mutex),
|
|
||||||
'$cond_create'(Cond),
|
|
||||||
'$mq_new_id'(Id, NId, Key),
|
|
||||||
recorda('$queue',q(Id,Mutex,Cond,NId,Key), _),
|
|
||||||
fail.
|
|
||||||
'$do_msg_queue_create'(_).
|
|
||||||
|
|
||||||
'$create_thread_mq'(TId) :-
|
|
||||||
recorded('$queue',q(TId,_,_,_,_), R),
|
|
||||||
erase(R),
|
|
||||||
fail.
|
|
||||||
'$create_thread_mq'(TId) :-
|
|
||||||
\+ recorded('$queue',q(TId,_,_,_,_), _),
|
|
||||||
'$new_mutex'(Mutex),
|
|
||||||
'$cond_create'(Cond),
|
|
||||||
'$mq_new_id'(TId, TId, Key),
|
|
||||||
recorda('$queue', q(TId,Mutex,Cond,TId,Key), _),
|
|
||||||
fail.
|
|
||||||
% recover space
|
|
||||||
'$create_thread_mq'(_).
|
|
||||||
|
|
||||||
'$mq_new_id'(Id, Id, AtId) :-
|
|
||||||
integer(Id), !,
|
|
||||||
\+ recorded('$queue', q(_,_,_,Id,_), _),
|
|
||||||
'$init_db_queue'(AtId).
|
|
||||||
'$mq_new_id'(_, Id, AtId) :-
|
|
||||||
'$integers'(Id),
|
|
||||||
\+ recorded('$queue', q(_,_,_,Id,_), _),
|
|
||||||
!,
|
|
||||||
'$init_db_queue'(AtId).
|
|
||||||
|
|
||||||
'$integers'(-1).
|
|
||||||
'$integers'(I) :-
|
|
||||||
'$integers'(I1),
|
|
||||||
I is I1-1.
|
|
||||||
|
|
||||||
|
|
||||||
/** @pred message_queue_destroy(+ _Queue_)
|
/** @pred message_queue_destroy(+ _Queue_)
|
||||||
|
|
||||||
|
|
||||||
@ -1277,29 +1229,6 @@ message_queue_destroy(Name) :-
|
|||||||
fail.
|
fail.
|
||||||
message_queue_destroy(_).
|
message_queue_destroy(_).
|
||||||
|
|
||||||
|
|
||||||
'$message_queue_destroy'(Queue) :-
|
|
||||||
recorded('$queue',q(Queue,Mutex,Cond,_,QKey),R), !,
|
|
||||||
'$clean_mqueue'(QKey),
|
|
||||||
'$cond_destroy'(Cond),
|
|
||||||
'$destroy_mutex'(Mutex),
|
|
||||||
erase(R).
|
|
||||||
'$message_queue_destroy'(Queue) :-
|
|
||||||
atomic(Queue), !,
|
|
||||||
'$do_error'(existence_error(message_queue,Queue),message_queue_destroy(Queue)).
|
|
||||||
'$message_queue_destroy'(Name) :-
|
|
||||||
'$do_error'(type_error(atom,Name),message_queue_destroy(Name)).
|
|
||||||
|
|
||||||
'$clean_mqueue'(Queue) :-
|
|
||||||
'$db_dequeue'(Queue, _),
|
|
||||||
fail.
|
|
||||||
'$clean_mqueue'(_).
|
|
||||||
|
|
||||||
'$empty_mqueue'(Queue) :-
|
|
||||||
'$db_dequeue_unlocked'(Queue, _),
|
|
||||||
fail.
|
|
||||||
'$empty_mqueue'(_).
|
|
||||||
|
|
||||||
message_queue_property(Id, Prop) :-
|
message_queue_property(Id, Prop) :-
|
||||||
( nonvar(Id) ->
|
( nonvar(Id) ->
|
||||||
'$check_message_queue_or_alias'(Id, message_queue_property(Id, Prop))
|
'$check_message_queue_or_alias'(Id, message_queue_property(Id, Prop))
|
||||||
@ -1369,31 +1298,14 @@ queue as all-but-the-winner perform a useless scan of the queue. If
|
|||||||
there is only one waiting thread or all waiting threads wait with an
|
there is only one waiting thread or all waiting threads wait with an
|
||||||
unbound variable an arbitrary thread is restarted to scan the queue.
|
unbound variable an arbitrary thread is restarted to scan the queue.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
*/
|
*/
|
||||||
thread_send_message(Queue, Term) :- var(Queue), !,
|
thread_send_message(Queue, Term) :- var(Queue), !,
|
||||||
'$do_error'(instantiation_error,thread_send_message(Queue,Term)).
|
'$do_error'(instantiation_error,thread_send_message(Queue,Term)).
|
||||||
thread_send_message(Queue, Term) :-
|
thread_send_message(Queue, Term) :-
|
||||||
recorded('$thread_alias',[Id|Queue],_), !,
|
recorded('$thread_alias',[Id|Queue],_R), !,
|
||||||
thread_send_message(Id, Term).
|
'$message_queue_send'(Id, Term).
|
||||||
thread_send_message(Queue, Term) :-
|
thread_send_message(Queue, Term) :-
|
||||||
'$do_thread_send_message'(Queue, Term),
|
'$message_queue_send'(Queue, Term).
|
||||||
fail.
|
|
||||||
% release pointers
|
|
||||||
thread_send_message(_, _).
|
|
||||||
|
|
||||||
'$do_thread_send_message'(Queue, Term) :-
|
|
||||||
recorded('$queue',q(Queue,Mutex,Cond,_,Key),_), !,
|
|
||||||
'$lock_mutex'(Mutex),
|
|
||||||
'$db_enqueue_unlocked'(Key, Term),
|
|
||||||
% write(+Queue:Term),nl,
|
|
||||||
'$cond_signal'(Cond),
|
|
||||||
'$unlock_mutex'(Mutex).
|
|
||||||
'$do_thread_send_message'(Queue, Term) :-
|
|
||||||
'$do_error'(existence_error(queue,Queue),thread_send_message(Queue,Term)).
|
|
||||||
|
|
||||||
/** @pred thread_get_message(? _Term_)
|
/** @pred thread_get_message(? _Term_)
|
||||||
|
|
||||||
@ -1435,24 +1347,12 @@ to check whether a thread has swallowed a message sent to it.
|
|||||||
thread_get_message(Queue, Term) :- var(Queue), !,
|
thread_get_message(Queue, Term) :- var(Queue), !,
|
||||||
'$do_error'(instantiation_error,thread_get_message(Queue,Term)).
|
'$do_error'(instantiation_error,thread_get_message(Queue,Term)).
|
||||||
thread_get_message(Queue, Term) :-
|
thread_get_message(Queue, Term) :-
|
||||||
recorded('$thread_alias',[Id|Queue],_), !,
|
recorded('$thread_alias',[Id|Queue],_R), !,
|
||||||
thread_get_message(Id, Term).
|
'$message_queue_receive'(Id, Term).
|
||||||
thread_get_message(Queue, Term) :-
|
thread_get_message(Queue, Term) :-
|
||||||
recorded('$queue',q(Queue,Mutex,Cond,_,Key),_), !,
|
'$message_queue_receive'(Queue, Term).
|
||||||
'$lock_mutex'(Mutex),
|
|
||||||
% write(-Queue:Term),nl,
|
|
||||||
'$thread_get_message_loop'(Key, Term, Mutex, Cond).
|
|
||||||
thread_get_message(Queue, Term) :-
|
|
||||||
'$do_error'(existence_error(message_queue,Queue),thread_get_message(Queue,Term)).
|
|
||||||
|
|
||||||
|
|
||||||
'$thread_get_message_loop'(Key, Term, Mutex, _) :-
|
|
||||||
'$db_dequeue_unlocked'(Key, Term), !,
|
|
||||||
'$unlock_mutex'(Mutex).
|
|
||||||
'$thread_get_message_loop'(Key, Term, Mutex, Cond) :-
|
|
||||||
'$cond_wait'(Cond, Mutex),
|
|
||||||
'$thread_get_message_loop'(Key, Term, Mutex, Cond).
|
|
||||||
|
|
||||||
/** @pred thread_peek_message(? _Term_)
|
/** @pred thread_peek_message(? _Term_)
|
||||||
|
|
||||||
|
|
||||||
@ -1514,22 +1414,10 @@ work(Id, Goal) :-
|
|||||||
thread_peek_message(Queue, Term) :- var(Queue), !,
|
thread_peek_message(Queue, Term) :- var(Queue), !,
|
||||||
'$do_error'(instantiation_error,thread_peek_message(Queue,Term)).
|
'$do_error'(instantiation_error,thread_peek_message(Queue,Term)).
|
||||||
thread_peek_message(Queue, Term) :-
|
thread_peek_message(Queue, Term) :-
|
||||||
recorded('$thread_alias',[Id|Queue],_), !,
|
recorded('$thread_alias',[Id|Queue],_R), !,
|
||||||
thread_peek_message(Id, Term).
|
'$message_peek_message'(Id, Term).
|
||||||
thread_peek_message(Queue, Term) :-
|
tthread_peek_message(Queue, Term) :-
|
||||||
recorded('$queue',q(Queue,Mutex,_,_,Key),_), !,
|
'$message_queue_peek'(Queue, Term).
|
||||||
'$lock_mutex'(Mutex),
|
|
||||||
'$thread_peek_message2'(Key, Term, Mutex).
|
|
||||||
thread_peek_message(Queue, Term) :-
|
|
||||||
'$do_error'(existence_error(message_queue,Queue),thread_peek_message(Queue,Term)).
|
|
||||||
|
|
||||||
|
|
||||||
'$thread_peek_message2'(Key, Term, Mutex) :-
|
|
||||||
'$db_peek_queue'(Key, Term), !,
|
|
||||||
'$unlock_mutex'(Mutex).
|
|
||||||
'$thread_peek_message2'(_, _, Mutex) :-
|
|
||||||
'$unlock_mutex'(Mutex),
|
|
||||||
fail.
|
|
||||||
|
|
||||||
%% @}
|
%% @}
|
||||||
|
|
||||||
|
Reference in New Issue
Block a user