src/lispworks.lisp

   1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
   2
   3 #|
   4 Copyright 2006, 2007 Greg Pfeil
   5
   6 Distributed under the MIT license (see LICENSE file)
   7 |#
   8
   9 (in-package #:bordeaux-threads)
  10
  11 ;;; documentation on the LispWorks Multiprocessing interface can be found at
  12 ;;; http://www.lispworks.com/documentation/lw445/LWUG/html/lwuser-156.htm
  13
  14 (mp:initialize-multiprocessing)
  15
  16 ;;; Thread Creation
  17
  18 (defun make-thread (function &key name)
  19   (mp:process-run-function name nil (binding-default-specials function)))
  20
  21 (defun current-thread ()
  22   mp:*current-process*)
  23
  24 (defun threadp (object)
  25   (typep object 'mp:process))
  26
  27 (defun thread-name (thread)
  28   (mp:process-name thread))
  29
  30 ;;; Resource contention: locks and recursive locks
  31
  32 (defun make-lock (&optional name)
  33   (mp:make-lock :name name))
  34
  35 (defun acquire-lock (lock &optional (wait-p t))
  36   (mp:process-lock lock nil (if wait-p
  37                                 (if (typep wait-p 'number) wait-p nil)
  38                                 0)))
  39
  40 (defun release-lock (lock)
  41   (mp:process-unlock lock))
  42
  43 ;;; Apparently this EVAL-WHEN is needed so that the macro is available
  44 ;;; when compiling condition-variables.lisp
  45 (eval-when (:compile-toplevel :load-toplevel :execute)
  46   (defmacro with-lock-held ((place) &body body)
  47     `(mp:with-lock (,place) ,@body)))
  48
  49 ;;; Resource contention: condition variables
  50
  51 (defun thread-yield ()
  52   (mp:process-allow-scheduling))
  53
  54 ;;; Introspection/debugging
  55
  56 (defun all-threads ()
  57   (mp:list-all-processes))
  58
  59 (defun interrupt-thread (thread function)
  60   (mp:process-interrupt thread function))
  61
  62 (defun destroy-thread (thread)
  63   (signal-error-if-current-thread thread)
  64   (mp:process-kill thread))
  65
  66 (defun thread-alive-p (thread)
  67   (mp:process-alive-p thread))
  68
  69 (mark-supported)