begin of support for named mutexes.

C/adtdefs.c

@@ -1242,7 +1242,7 @@ Yap_PutValue(Atom a, Term v)
   WRITE_UNLOCK(p->VRWLock);
 }
 
-void
+bool
 Yap_PutAtomTranslation(Atom a, Int i)
 {
   AtomEntry *ae = RepAtom(a);
@@ -1255,7 +1255,7 @@ Yap_PutAtomTranslation(Atom a, Int i)
     p = (TranslationEntry *) Yap_AllocAtomSpace(sizeof(TranslationEntry));
     if (p == NULL) {
       WRITE_UNLOCK(ae->ARWLock);
-      return;
+      return false;
     }
     p->KindOfPE = TranslationProperty;
     p->Translation = i;
@@ -1264,6 +1264,32 @@ Yap_PutAtomTranslation(Atom a, Int i)
   /* take care that the lock for the property will be inited even
      if someone else searches for the property */
   WRITE_UNLOCK(ae->ARWLock);
+  return true;
+}
+
+bool
+Yap_PutAtomMutex(Atom a, void * i)
+{
+  AtomEntry *ae = RepAtom(a);
+  Prop p0;
+  MutexEntry *p;
+
+  WRITE_LOCK(ae->ARWLock);
+  p0 = GetAPropHavingLock(ae, MutexProperty);
+  if (p0 == NIL) {
+    p = (MutexEntry *) Yap_AllocAtomSpace(sizeof(MutexEntry));
+    if (p == NULL) {
+      WRITE_UNLOCK(ae->ARWLock);
+      return false;
+    }
+    p->KindOfPE = MutexProperty;
+    p->Mutex = i;
+    AddPropToAtom(RepAtom(a), (PropEntry *)p);
+  }
+  /* take care that the lock for the property will be inited even
+     if someone else searches for the property */
+  WRITE_UNLOCK(ae->ARWLock);
+  return true;
 }
 
 Term

C/threads.c

@@ -832,13 +832,10 @@ p_thread_exit( USES_REGS1 )
 static Int
 p_thread_set_concurrency( USES_REGS1 )
 {
-  Term tnew = Deref(ARG2);
-  int newc;
 #if HAVE_PTHREAD_GETCONCURRENCY
+  int newc;  
   int cur;
-#endif
+  Term tnew = Deref(ARG2);  
-
-
   if (IsVarTerm(tnew)) {
     newc = 0;
   } else if (IsIntegerTerm(tnew)) {
@@ -847,7 +844,6 @@ int cur;
     Yap_Error(TYPE_ERROR_INTEGER,tnew,"thread_set_concurrency/2");
     return(FALSE);
   }
-#if HAVE_PTHREAD_GETCONCURRENCY
   cur = MkIntegerTerm(pthread_getconcurrency());
   if (pthread_setconcurrency(newc) != 0) {
     return FALSE;
@@ -906,7 +902,11 @@ p_new_mutex( USES_REGS1 )
   pthread_mutex_init(&mutp->m, &mat);
   mutp->owners = 0;
   mutp->tid_own = 0;
-  return Yap_unify(ARG1, MkIntegerTerm((Int)mutp));
+  if (IsVarTerm((t1 = Deref(ARG1)))) {
+      return Yap_unify(t1, MkAddressTerm(mutp));
+  } else if(IsAtomTerm(t1)) {
+    return Yap_PutAtomMutex( AtomOfTerm(t1), mutp );
+  }
 }
 
 
@@ -1276,7 +1276,8 @@ p_new_mutex( USES_REGS1 )
 
   if (pthread_cond_broadcast(condp) < 0)
     return FALSE;
- v  return TRUE;
+  else
+    return TRUE;
 }
 
 static Int

H/Yatom.h

@@ -1252,7 +1252,7 @@ AbsTranslationProp (TranslationEntry * p)
 #endif
 #define	TranslationProperty  0xfff4
 
-void Yap_PutAtomTranslation(Atom a, Int i);
+bool Yap_PutAtomTranslation(Atom a, Int i);
 
 /* get translation prop for atom;               */
 static inline TranslationEntry *
@@ -1271,9 +1271,6 @@ Yap_GetTranslationProp(Atom at)
   return p;
 }
  
-
-/* only unary and binary expressions are acceptable */
-
 INLINE_ONLY inline EXTERN PropFlags IsTranslationProperty (int);
 
 INLINE_ONLY inline EXTERN PropFlags
@@ -1282,6 +1279,89 @@ IsTranslationProperty (int flags)
   return (PropFlags) ((flags == TranslationProperty));
 }
 
+/*** handle named mutexes */
+
+/*              translationnamed mutex property entry structure                            */
+ typedef struct mutex_entry
+ {
+   Prop NextOfPE;               /* used to chain properties             */
+   PropFlags KindOfPE;          /* kind of property                     */
+   void *Mutex;            /* used to hash the atom as an integer; */
+ }  MutexEntry;
+
+#if USE_OFFSETS_IN_PROPS
+
+ INLINE_ONLY inline EXTERN MutexEntry *RepMutexProp (Prop p);
+
+ INLINE_ONLY inline EXTERN MutexEntry *
+   RepMutexProp (Prop p)
+ {
+   return (MutexEntry *) (AtomBase + Unsigned (p));
+ }
+
+
+
+ INLINE_ONLY inline EXTERN Prop AbsMutexProp (MutexEntry * p);
+
+ INLINE_ONLY inline EXTERN Prop
+   AbsMutexProp (MutexEntry * p)
+ {
+   return (Prop) (Addr (p) - AtomBase);
+ }
+
+
+#else
+
+ INLINE_ONLY inline EXTERN MutexEntry *RepMutexProp (Prop p);
+
+ INLINE_ONLY inline EXTERN MutexEntry *
+   RepMutexProp (Prop p)
+ {
+   return (MutexEntry *) (p);
+ }
+
+
+
+ INLINE_ONLY inline EXTERN Prop AbsMutexProp (MutexEntry * p);
+
+ INLINE_ONLY inline EXTERN Prop
+   AbsMutexProp (MutexEntry * p)
+ {
+   return (Prop) (p);
+ }
+
+
+#endif
+#define MutexProperty  0xfff5
+
+ bool Yap_PutAtomMutex(Atom a, void *ptr);
+
+ /* get mutex prop for atom;               */
+ static inline MutexEntry *
+   Yap_GetMutexProp(Atom at)
+ {
+   Prop p0;
+   AtomEntry *ae = RepAtom(at);
+   MutexEntry *p;
+
+   READ_LOCK(ae->ARWLock);
+   p = RepMutexProp(p0 = ae->PropsOfAE);
+   while (p0 && p->KindOfPE != MutexProperty)
+     p = RepMutexProp(p0 = p->NextOfPE);
+   READ_UNLOCK(ae->ARWLock);
+   if (p0 == NIL) return NULL;
+   return p;
+ }
+
+ INLINE_ONLY inline EXTERN PropFlags IsMutexProperty (int);
+
+ INLINE_ONLY inline EXTERN PropFlags
+   IsMutexProperty (int flags)
+ {
+   return (PropFlags) ((flags == MutexProperty));
+ }
+
+ /* end of code for named mutexes */
  
 typedef enum {
   STATIC_ARRAY = 1,