1 /* Part of SWI-Prolog
2
3 Author: Jan Wielemaker
4 E-mail: J.Wielemaker@vu.nl
5 WWW: http://www.swi-prolog.org
6 Copyright (c) 2017, University of Amsterdam
7 VU University Amsterdam
8 CWI, Amsterdam
9 All rights reserved.
10
11 Redistribution and use in source and binary forms, with or without
12 modification, are permitted provided that the following conditions
13 are met:
14
15 1. Redistributions of source code must retain the above copyright
16 notice, this list of conditions and the following disclaimer.
17
18 2. Redistributions in binary form must reproduce the above copyright
19 notice, this list of conditions and the following disclaimer in
20 the documentation and/or other materials provided with the
21 distribution.
22
23 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
24 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
25 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
26 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
27 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
28 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
29 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
30 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
31 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
32 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
33 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
34 POSSIBILITY OF SUCH DAMAGE.
35 */
36
37 #include "pl-incl.h"
38 #include "pl-thread.h"
39
40 #undef LD
41 #define LD LOCAL_LD
42
43 #ifdef O_PLMT
44 static void unalloc_mutex(pl_mutex *m);
45
46
47 /*******************************
48 * USER MUTEXES *
49 *******************************/
50
51 typedef struct mutexref
52 { pl_mutex *mutex;
53 } mutexref;
54
55 static int try_really_destroy_mutex(pl_mutex *m);
56
57 static int
write_mutexref(IOSTREAM * s,atom_t aref,int flags)58 write_mutexref(IOSTREAM *s, atom_t aref, int flags)
59 { mutexref *ref = PL_blob_data(aref, NULL, NULL);
60 (void)flags;
61
62 Sfprintf(s, "<mutex>(%p)", ref->mutex);
63 return TRUE;
64 }
65
66
67 static int
release_mutexref(atom_t aref)68 release_mutexref(atom_t aref)
69 { mutexref *ref = PL_blob_data(aref, NULL, NULL);
70 pl_mutex *m;
71
72 DEBUG(MSG_MUTEX_GC,
73 Sdprintf("GC mutex %p\n", ref->mutex));
74
75 if ( (m=ref->mutex) )
76 { if ( !m->destroyed )
77 deleteHTable(GD->thread.mutexTable, (void *)m->id);
78
79 if ( m->owner )
80 { Sdprintf("WARNING: <mutex>(%p) garbage collected "
81 "while owned by thread %d\n",
82 m, m->owner);
83
84 if ( m->owner == PL_thread_self() )
85 pthread_mutex_unlock(&m->mutex);
86 else
87 return TRUE;
88 }
89
90 if ( m->initialized )
91 pthread_mutex_destroy(&m->mutex);
92 unalloc_mutex(m);
93 }
94
95 return TRUE;
96 }
97
98
99 static int
save_mutexref(atom_t aref,IOSTREAM * fd)100 save_mutexref(atom_t aref, IOSTREAM *fd)
101 { mutexref *ref = PL_blob_data(aref, NULL, NULL);
102 (void)fd;
103
104 return PL_warning("Cannot save reference to <mutex>(%p)", ref->mutex);
105 }
106
107
108 static atom_t
load_mutexref(IOSTREAM * fd)109 load_mutexref(IOSTREAM *fd)
110 { (void)fd;
111
112 return PL_new_atom("<saved-mutex-ref>");
113 }
114
115
116 static PL_blob_t mutex_blob =
117 { PL_BLOB_MAGIC,
118 PL_BLOB_UNIQUE,
119 "mutex",
120 release_mutexref,
121 NULL,
122 write_mutexref,
123 NULL,
124 save_mutexref,
125 load_mutexref
126 };
127
128
129 static void
initMutexRef(void)130 initMutexRef(void)
131 { mutex_blob.atom_name = ATOM_mutex; /* avoid early initAtoms() */
132 PL_register_blob_type(&mutex_blob);
133 }
134
135
136 static void
unalloc_mutex(pl_mutex * m)137 unalloc_mutex(pl_mutex *m)
138 { freeHeap(m, sizeof(*m));
139 }
140
141
142 static void
destroy_mutex(pl_mutex * m)143 destroy_mutex(pl_mutex *m)
144 { if ( m->initialized )
145 { m->initialized = FALSE;
146 pthread_mutex_destroy(&m->mutex);
147 }
148 if ( !m->anonymous )
149 unalloc_mutex(m);
150 }
151
152 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
153 User-level mutexes. On Windows we can't use critical sections here as
154 TryEnterCriticalSection() is only defined on NT 4, not on Windows 95 and
155 friends.
156 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
157
158 static int
unify_mutex(term_t t,pl_mutex * m)159 unify_mutex(term_t t, pl_mutex *m)
160 { GET_LD
161
162 return PL_unify_atom(t, m->id);
163 }
164
165
166 static int
unify_mutex_owner(term_t t,int owner)167 unify_mutex_owner(term_t t, int owner)
168 { if ( owner )
169 return unify_thread_id(t, GD->thread.threads[owner]);
170 else
171 return PL_unify_nil(t);
172 }
173
174
175 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
176 (*) We must lock the atom, but threads are initialised before the atom
177 infrastructure :-( Note that this is hacky, but safe: m->id is an ATOM_*
178 built-in atom and needs not to be locked. Putting this test in
179 PL_register_atom() would be cleaner, but that routine is much more time
180 critical.
181 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
182
183 static pl_mutex *
mutexCreate(atom_t name)184 mutexCreate(atom_t name)
185 { pl_mutex *m;
186
187 if ( (m=allocHeap(sizeof(*m))) )
188 { memset(m, 0, sizeof(*m));
189 pthread_mutex_init(&m->mutex, NULL);
190 m->initialized = TRUE;
191
192 if ( name == NULL_ATOM )
193 { mutexref ref;
194 int new;
195
196 ref.mutex = m;
197 m->id = lookupBlob((void*)&ref, sizeof(ref), &mutex_blob, &new);
198 m->anonymous = TRUE;
199 } else
200 { m->id = name;
201 }
202
203 addNewHTable(GD->thread.mutexTable, (void *)m->id, m);
204 if ( m->anonymous )
205 PL_unregister_atom(m->id); /* reclaim on GC */
206 else if ( GD->atoms.builtin ) /* (*) */
207 PL_register_atom(m->id);
208 } else
209 PL_no_memory();
210
211 return m;
212 }
213
214
215 static pl_mutex *
unlocked_pl_mutex_create(term_t mutex)216 unlocked_pl_mutex_create(term_t mutex)
217 { GET_LD
218 atom_t name = NULL_ATOM;
219 pl_mutex *m;
220 word id;
221
222 if ( PL_get_atom(mutex, &name) )
223 { if ( lookupHTable(GD->thread.mutexTable, (void *)name) )
224 { PL_error("mutex_create", 1, NULL, ERR_PERMISSION,
225 ATOM_create, ATOM_mutex, mutex);
226 return NULL;
227 }
228 id = name;
229 } else if ( PL_is_variable(mutex) )
230 { id = NULL_ATOM;
231 } else
232 { PL_error("mutex_create", 1, NULL, ERR_TYPE, ATOM_mutex, mutex);
233 return NULL;
234 }
235
236 if ( (m=mutexCreate(id)) )
237 { if ( !unify_mutex(mutex, m) )
238 { destroy_mutex(m);
239 m = NULL;
240 }
241 }
242
243 return m;
244 }
245
246
247 static
248 PRED_IMPL("mutex_create", 1, mutex_create1, 0)
249 { int rval;
250
251 PL_LOCK(L_UMUTEX);
252 rval = (unlocked_pl_mutex_create(A1) ? TRUE : FALSE);
253 PL_UNLOCK(L_UMUTEX);
254
255 return rval;
256 }
257
258
259 static const opt_spec mutex_options[] =
260 { { ATOM_alias, OPT_ATOM },
261 { NULL_ATOM, 0 }
262 };
263
264
265 static
266 PRED_IMPL("mutex_create", 2, mutex_create2, 0)
267 { PRED_LD
268 int rval;
269 atom_t alias = 0;
270
271 if ( !scan_options(A2, 0,
272 ATOM_mutex_option, mutex_options,
273 &alias) )
274 fail;
275
276 if ( alias )
277 { if ( !PL_unify_atom(A1, alias) )
278 return PL_error("mutex_create", 2, NULL, ERR_UNINSTANTIATION, 1, A1);
279 }
280
281 PL_LOCK(L_UMUTEX);
282 rval = (unlocked_pl_mutex_create(A1) ? TRUE : FALSE);
283 PL_UNLOCK(L_UMUTEX);
284
285 return rval;
286 }
287
288
289 static int
get_mutex(term_t t,pl_mutex ** mutex,int create)290 get_mutex(term_t t, pl_mutex **mutex, int create)
291 { GET_LD
292 atom_t name;
293 word id = 0;
294 pl_mutex *m = NULL;
295
296 if ( PL_get_atom(t, &name) )
297 { PL_blob_t *type;
298 mutexref *ref = PL_blob_data(name, NULL, &type);
299
300 if ( type == &mutex_blob )
301 { m = ref->mutex;
302 goto out;
303 } else if ( isTextAtom(name) )
304 { id = name;
305 }
306 }
307
308 if ( !id )
309 { PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_mutex, t);
310 return FALSE;
311 }
312
313 PL_LOCK(L_UMUTEX);
314 if ( GD->thread.mutexTable &&
315 (m = lookupHTable(GD->thread.mutexTable, (void *)id)) )
316 { ;
317 } else if ( create )
318 { m = unlocked_pl_mutex_create(t);
319 } else
320 { PL_error(NULL, 0, NULL, ERR_EXISTENCE, ATOM_mutex, t);
321 }
322 PL_UNLOCK(L_UMUTEX);
323
324 out:
325 if ( m )
326 { if ( !m->destroyed )
327 { *mutex = m;
328 return TRUE;
329 }
330 PL_error(NULL, 0, NULL, ERR_EXISTENCE, ATOM_mutex, t);
331 }
332
333 return FALSE;
334 }
335
336
337
338 int
PL_mutex_lock(struct pl_mutex * m)339 PL_mutex_lock(struct pl_mutex *m)
340 { int self = PL_thread_self();
341
342 if ( self == m->owner )
343 { m->count++;
344 } else
345 { int rc;
346 #ifdef HAVE_PTHREAD_MUTEX_TIMEDLOCK
347 for(;;)
348 { struct timespec deadline;
349
350 get_current_timespec(&deadline);
351 deadline.tv_nsec += 250000000;
352 carry_timespec_nanos(&deadline);
353
354 if ( (rc=pthread_mutex_timedlock(&m->mutex, &deadline)) == ETIMEDOUT )
355 { if ( PL_handle_signals() < 0 )
356 return FALSE;
357 } else
358 break;
359 }
360 #else
361 rc = pthread_mutex_lock(&m->mutex);
362 #endif
363 assert(rc == 0);
364 m->count = 1;
365 m->owner = self;
366 }
367
368 return TRUE;
369 }
370
371
372 static
373 PRED_IMPL("mutex_lock", 1, mutex_lock, 0)
374 { pl_mutex *m;
375
376 if ( !get_mutex(A1, &m, TRUE) )
377 return FALSE;
378
379 return PL_mutex_lock(m);
380 }
381
382
383 static int
PL_mutex_trylock(struct pl_mutex * m)384 PL_mutex_trylock(struct pl_mutex *m)
385 { int self = PL_thread_self();
386 int rc;
387
388 if ( self == m->owner )
389 { m->count++;
390 } else if ( (rc = pthread_mutex_trylock(&m->mutex)) == 0 )
391 { m->count = 1;
392 m->owner = self;
393 } else
394 { assert(rc == EBUSY);
395 return FALSE;
396 }
397
398 return TRUE;
399 }
400
401
402 static
403 PRED_IMPL("mutex_trylock", 1, mutex_trylock, 0)
404 { pl_mutex *m;
405
406 if ( !get_mutex(A1, &m, TRUE) )
407 return FALSE;
408
409 return PL_mutex_trylock(m);
410 }
411
412
413 int
PL_mutex_unlock(struct pl_mutex * m)414 PL_mutex_unlock(struct pl_mutex *m)
415 { int self = PL_thread_self();
416
417 if ( self == m->owner )
418 { if ( --m->count == 0 )
419 { m->owner = 0;
420
421 pthread_mutex_unlock(&m->mutex);
422 }
423
424 return TRUE;
425 }
426
427 return FALSE;
428 }
429
430
431 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
432 The error message of this predicate is not thread-safe. I.e. it is
433 possible the message is wrong. This can only be fixed by modifying the
434 API of PL_mutex_unlock(), which is asking a bit too much for this small
435 error.
436 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
437
438 static
439 PRED_IMPL("mutex_unlock", 1, mutex_unlock, 0)
440 { pl_mutex *m;
441
442 if ( !get_mutex(A1, &m, FALSE) )
443 return FALSE;
444
445 if ( PL_mutex_unlock(m) )
446 { if ( m->auto_destroy )
447 { PL_LOCK(L_UMUTEX);
448 try_really_destroy_mutex(m);
449 PL_UNLOCK(L_UMUTEX);
450 }
451
452 return TRUE;
453 } else
454 { char *msg = m->owner ? "not owner" : "not locked";
455
456 return PL_error("mutex_unlock", 1, msg, ERR_PERMISSION,
457 ATOM_unlock, ATOM_mutex, A1);
458 }
459 }
460
461
462 static
463 PRED_IMPL("mutex_unlock_all", 0, mutex_unlock_all, 0)
464 { TableEnum e;
465 pl_mutex *m;
466 int tid = PL_thread_self();
467
468 e = newTableEnum(GD->thread.mutexTable);
469 while( advanceTableEnum(e, NULL, (void**)&m) )
470 { if ( m->owner == tid )
471 { m->count = 0;
472 m->owner = 0;
473 pthread_mutex_unlock(&m->mutex);
474 }
475 }
476 freeTableEnum(e);
477 return TRUE;
478 }
479
480
481 static int
try_really_destroy_mutex(pl_mutex * m)482 try_really_destroy_mutex(pl_mutex *m)
483 { if ( PL_mutex_trylock(m) )
484 { if ( m->count == 1 )
485 { m->destroyed = TRUE;
486 deleteHTable(GD->thread.mutexTable, (void *)m->id);
487 if ( !m->anonymous )
488 PL_unregister_atom(m->id);
489 m->count = 0;
490 m->owner = 0;
491 pthread_mutex_unlock(&m->mutex);
492 destroy_mutex(m);
493 return TRUE;
494 } else
495 PL_mutex_unlock(m);
496 }
497
498 return FALSE;
499 }
500
501
502 static
503 PRED_IMPL("mutex_destroy", 1, mutex_destroy, 0)
504 { pl_mutex *m;
505
506 if ( !get_mutex(A1, &m, FALSE) )
507 return FALSE;
508
509 PL_LOCK(L_UMUTEX);
510 if ( !try_really_destroy_mutex(m) )
511 m->auto_destroy = TRUE;
512 PL_UNLOCK(L_UMUTEX);
513
514 return TRUE;
515 }
516
517
518 /*******************************
519 * MUTEX_PROPERTY *
520 *******************************/
521
522 static int /* mutex_property(Mutex, alias(Name)) */
mutex_alias_property(pl_mutex * m,term_t prop ARG_LD)523 mutex_alias_property(pl_mutex *m, term_t prop ARG_LD)
524 { if ( !m->anonymous )
525 return PL_unify_atom(prop, m->id);
526
527 fail;
528 }
529
530
531 static int /* mutex_property(Mutex, status(locked(By, Count))) */
mutex_status_property(pl_mutex * m,term_t prop ARG_LD)532 mutex_status_property(pl_mutex *m, term_t prop ARG_LD)
533 { if ( m->owner )
534 { int owner = m->owner;
535 int count = m->count;
536 term_t owner_term = PL_new_term_ref();
537
538 return (PL_unify_term(prop, PL_FUNCTOR, FUNCTOR_locked2,
539 PL_TERM, owner_term,
540 PL_INT, count) &&
541 unify_mutex_owner(owner_term, owner));
542 } else
543 { return PL_unify_atom(prop, ATOM_unlocked);
544 }
545
546 fail;
547 }
548
549
550 static const tprop mprop_list [] =
551 { { FUNCTOR_alias1, mutex_alias_property },
552 { FUNCTOR_status1, mutex_status_property },
553 { 0, NULL }
554 };
555
556
557 typedef struct
558 { TableEnum e; /* Enumerator on mutex-table */
559 pl_mutex *m; /* current mutex */
560 const tprop *p; /* Pointer in properties */
561 int enum_properties; /* Enumerate the properties */
562 } mprop_enum;
563
564
565 static int
advance_mstate(mprop_enum * state)566 advance_mstate(mprop_enum *state)
567 { if ( state->enum_properties )
568 { state->p++;
569 if ( state->p->functor )
570 succeed;
571
572 state->p = mprop_list;
573 }
574 if ( state->e )
575 { pl_mutex *m;
576
577 if ( advanceTableEnum(state->e, NULL, (void**)&m) )
578 { state->m = m;
579
580 succeed;
581 }
582 }
583
584 fail;
585 }
586
587
588 static void
free_mstate(mprop_enum * state)589 free_mstate(mprop_enum *state)
590 { if ( state->e )
591 freeTableEnum(state->e);
592
593 freeForeignState(state, sizeof(*state));
594 }
595
596
597 static
598 PRED_IMPL("mutex_property", 2, mutex_property, PL_FA_NONDETERMINISTIC)
599 { PRED_LD
600 term_t mutex = A1;
601 term_t property = A2;
602 mprop_enum statebuf;
603 mprop_enum *state;
604
605 switch( CTX_CNTRL )
606 { case FRG_FIRST_CALL:
607 { memset(&statebuf, 0, sizeof(statebuf));
608 state = &statebuf;
609
610 if ( PL_is_variable(mutex) )
611 { switch( get_prop_def(property, ATOM_mutex_property,
612 mprop_list, &state->p) )
613 { case 1:
614 state->e = newTableEnum(GD->thread.mutexTable);
615 goto enumerate;
616 case 0:
617 state->e = newTableEnum(GD->thread.mutexTable);
618 state->p = mprop_list;
619 state->enum_properties = TRUE;
620 goto enumerate;
621 case -1:
622 fail;
623 }
624 } else if ( get_mutex(mutex, &state->m, FALSE) )
625 { switch( get_prop_def(property, ATOM_mutex_property,
626 mprop_list, &state->p) )
627 { case 1:
628 goto enumerate;
629 case 0:
630 state->p = mprop_list;
631 state->enum_properties = TRUE;
632 goto enumerate;
633 case -1:
634 fail;
635 }
636 } else
637 { fail;
638 }
639 }
640 case FRG_REDO:
641 state = CTX_PTR;
642 break;
643 case FRG_CUTTED:
644 state = CTX_PTR;
645 free_mstate(state);
646 succeed;
647 default:
648 assert(0);
649 fail;
650 }
651
652 enumerate:
653 if ( !state->m ) /* first time, enumerating mutexes */
654 { pl_mutex *m;
655
656 assert(state->e);
657 if ( advanceTableEnum(state->e, NULL, (void**)&m) )
658 { state->m = m;
659 } else
660 { freeTableEnum(state->e);
661 assert(state != &statebuf);
662 fail;
663 }
664 }
665
666
667 { term_t arg = PL_new_term_ref();
668
669 if ( !state->enum_properties )
670 _PL_get_arg(1, property, arg);
671
672 for(;;)
673 { if ( (*state->p->function)(state->m, arg PASS_LD) )
674 { if ( state->enum_properties )
675 { if ( !PL_unify_term(property,
676 PL_FUNCTOR, state->p->functor,
677 PL_TERM, arg) )
678 goto error;
679 }
680 if ( state->e )
681 { if ( !unify_mutex(mutex, state->m) )
682 goto error;
683 }
684
685 if ( advance_mstate(state) )
686 { if ( state == &statebuf )
687 { mprop_enum *copy = allocForeignState(sizeof(*copy));
688
689 *copy = *state;
690 state = copy;
691 }
692
693 ForeignRedoPtr(state);
694 }
695
696 if ( state != &statebuf )
697 free_mstate(state);
698 succeed;
699 }
700
701 if ( !advance_mstate(state) )
702 { error:
703 if ( state != &statebuf )
704 free_mstate(state);
705 fail;
706 }
707 }
708 }
709 }
710
711 /*******************************
712 * INITIALIZATION *
713 *******************************/
714
715 static void
unalloc_mutex_symbol(void * name,void * value)716 unalloc_mutex_symbol(void *name, void *value)
717 { unalloc_mutex(value);
718 }
719
720 void
initMutexes(void)721 initMutexes(void)
722 { GD->thread.mutexTable = newHTable(16);
723 GD->thread.mutexTable->free_symbol = unalloc_mutex_symbol;
724 initMutexRef();
725 }
726
727 #endif /*O_PLMT*/
728
729 /*******************************
730 * WITH-MUTEX *
731 *******************************/
732
733 foreign_t
pl_with_mutex(term_t mutex,term_t goal)734 pl_with_mutex(term_t mutex, term_t goal)
735 { int rval;
736
737 #ifdef O_PLMT
738 pl_mutex *m;
739
740 if ( !get_mutex(mutex, &m, TRUE) )
741 return FALSE;
742 PL_mutex_lock(m);
743 rval = callProlog(NULL, goal, PL_Q_PASS_EXCEPTION, NULL);
744 PL_mutex_unlock(m);
745 #else
746 rval = callProlog(NULL, goal, PL_Q_PASS_EXCEPTION, NULL);
747 #endif
748
749 return rval;
750 }
751
752
753 /*******************************
754 * PUBLISH PREDICATES *
755 *******************************/
756
757 #define NDET PL_FA_NONDETERMINISTIC
758
759 BeginPredDefs(mutex)
760 #ifdef O_PLMT
761 PRED_DEF("mutex_create", 1, mutex_create1, 0)
762 PRED_DEF("mutex_create", 2, mutex_create2, PL_FA_ISO)
763 PRED_DEF("mutex_destroy", 1, mutex_destroy, PL_FA_ISO)
764 PRED_DEF("mutex_lock", 1, mutex_lock, PL_FA_ISO)
765 PRED_DEF("mutex_trylock", 1, mutex_trylock, PL_FA_ISO)
766 PRED_DEF("mutex_unlock", 1, mutex_unlock, PL_FA_ISO)
767 PRED_DEF("mutex_unlock_all", 0, mutex_unlock_all, 0)
768 PRED_DEF("mutex_property", 2, mutex_property, NDET|PL_FA_ISO)
769 #endif
770 EndPredDefs
771