apiv2/impl-scl.lisp

   1 ;;;; -*- indent-tabs-mode: nil -*-
   2
   3 (in-package :bordeaux-threads-2)
   4
   5 ;;;
   6 ;;; Threads
   7 ;;;
   8
   9 (deftype native-thread ()
  10   'thread:thread)
  11
  12 (defun %make-thread (function name)
  13   (thread:thread-create function :name name))
  14
  15 (defun %current-thread ()
  16   thread:*thread*)
  17
  18 (defun %thread-name (thread)
  19   (thread:thread-name thread))
  20
  21 (defun %join-thread (thread)
  22   (mp:process-wait (format nil "Waiting for thread ~A to complete" thread)
  23                    (named-lambda %thread-completed-p ()
  24                      (not (mp:process-alive-p thread)))))
  25
  26 (defun %thread-yield ()
  27   (mp:process-yield))
  28
  29 ;;;
  30 ;;; Introspection/debugging
  31 ;;;
  32
  33 (defun %all-threads ()
  34   (mp:all-processes))
  35
  36 (defun %interrupt-thread (thread function)
  37   (thread:thread-interrupt thread function))
  38
  39 (defun %destroy-thread (thread)
  40   (thread:destroy-thread thread))
  41
  42 (defun %thread-alive-p (thread)
  43   (mp:process-alive-p thread))
  44 \f
  45
  46 ;;;
  47 ;;; Non-recursive locks
  48 ;;;
  49
  50 (deftype native-lock () 'thread:lock)
  51
  52 (defun %make-lock (name)
  53   (thread:make-lock name))
  54
  55 (mark-not-implemented 'acquire-lock :timeout)
  56 (defun %acquire-lock (lock waitp timeout)
  57   (when timeout
  58     (signal-not-implemented 'acquire-lock :timeout))
  59   (thread::acquire-lock lock nil wait-p))
  60
  61 (defun %release-lock (lock)
  62   (thread::release-lock lock))
  63
  64 (mark-not-implemented 'with-lock-held :timeout)
  65 (defmacro %with-lock ((place timeout) &body body)
  66   (if timeout
  67       `(signal-not-implemented 'with-lock-held :timeout)
  68       `(thread:with-lock-held (,place) ,@body)))
  69
  70 ;;;
  71 ;;; Recursive locks
  72 ;;;
  73
  74 (deftype native-recursive-lock () 'thread:recursive-lock)
  75
  76 (defun %make-recursive-lock (name)
  77   (thread:make-lock name :type :recursive))
  78
  79 (mark-not-implemented 'acquire-recursive-lock)
  80 (defun %acquire-recursive-lock (lock waitp timeout)
  81   (declare (ignore lock waitp timeout))
  82   (signal-not-implemented 'acquire-recursive-lock))
  83
  84 (mark-not-implemented 'release-recursive-lock)
  85 (defun %release-recursive-lock (lock)
  86   (declare (ignore lock))
  87   (signal-not-implemented 'release-recursive-lock))
  88
  89 (mark-not-implemented 'with-recursive-lock-held :timeout)
  90 (defmacro %with-recursive-lock ((place timeout) &body body)
  91   (if timeout
  92       `(signal-not-implemented 'with-recursive-lock-held :timeout)
  93       `(thread:with-lock-held (,place)
  94          ,@body)))
  95 \f
  96
  97 ;;;
  98 ;;; Condition variables
  99 ;;;
 100
 101 (deftype condition-variable ()
 102   'thread:cond-var)
 103
 104 (defun %make-condition-variable (name)
 105   (thread:make-cond-var name))
 106
 107 (defun %condition-wait (cv lock timeout)
 108   (if timeout
 109       (thread:cond-var-timedwait cv lock timeout)
 110       (thread:cond-var-wait cv lock)))
 111
 112 (defun %condition-notify (cv)
 113   (thread:cond-var-signal cv))
 114
 115 (defun %condition-broadcast (cv)
 116   (thread:cond-var-broadcast v))