src/impl-abcl.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 ;;; the implementation of the Armed Bear thread interface can be found in
  12 ;;; src/org/armedbear/lisp/LispThread.java
  13
  14 ;;; Thread Creation
  15
  16 (defun %make-thread (function name)
  17   (ext:make-thread function :name name))
  18
  19 (defun current-thread ()
  20   (ext:current-thread))
  21
  22 (defun thread-name (thread)
  23   (ext:thread-name thread))
  24
  25 ;;; Yes, this is nasty
  26 (defun threadp (object)
  27   (handler-case (progn (thread-name object) t)
  28     (type-error () nil)))
  29
  30 ;;; Resource contention: locks and recursive locks
  31
  32 ;;; Don't know what the arguments to MAKE-THREAD-LOCK are, but it
  33 ;;; doesn't mind being a thunk
  34 (defun make-lock (&optional name)
  35   (declare (ignore name))
  36   (ext:make-thread-lock))
  37
  38 (defun acquire-lock (lock &optional (wait-p t))
  39   (declare (ignore wait-p))
  40   (ext:thread-lock lock))
  41
  42 (defun release-lock (lock)
  43   (ext:thread-unlock lock))
  44
  45 (defmacro with-lock-held ((place) &body body)
  46   `(ext:with-thread-lock (,place) ,@body))
  47
  48 ;;; Resource contention: condition variables
  49
  50 (defun thread-yield ()
  51   (sleep 0))
  52
  53 ;;; Introspection/debugging
  54
  55 (defun interrupt-thread (thread function)
  56   (ext:interrupt-thread thread function))
  57
  58 (defun destroy-thread (thread)
  59   (signal-error-if-current-thread thread)
  60   (ext:destroy-thread thread))
  61
  62 (defun thread-alive-p (thread)
  63   (ext:thread-alive-p thread))
  64
  65 (mark-supported)