[Bordeaux-threads-devel] Patch for the unsupported backend
Stelian Ionescu
sionescu at common-lisp.net
Sat Dec 8 17:32:18 UTC 2007
I've attached a patch that ensures that every bordeaux-threads form
is a noop in the unsupported backend: all generic functions get a
default method and macros expand to PROGN.
--
Stelian Ionescu a.k.a. fe[nl]ix
Quidquid latine dictum sit, altum videtur.
-------------- next part --------------
diff -rN -u old-bordeaux-threads/src/bordeaux-threads.lisp new-bordeaux-threads/src/bordeaux-threads.lisp
--- old-bordeaux-threads/src/bordeaux-threads.lisp 2007-12-08 18:32:09.000000000 +0100
+++ new-bordeaux-threads/src/bordeaux-threads.lisp 2007-12-08 18:32:09.000000000 +0100
@@ -108,7 +108,9 @@
(defgeneric current-thread ()
(:documentation "Returns the thread object for the calling
thread. This is the same kind of object as would be returned by
- MAKE-THREAD."))
+ MAKE-THREAD.")
+ (:method ()
+ nil))
(defgeneric threadp (object)
(:documentation "Returns true if object is a thread, otherwise NIL.")
@@ -118,7 +120,10 @@
(defgeneric thread-name (thread)
(:documentation "Returns the name of the thread, as supplied to
- MAKE-THREAD"))
+ MAKE-THREAD")
+ (:method (thread)
+ (declare (ignore thread))
+ "Main thread"))
;;; Resource contention: locks and recursive locks
@@ -206,7 +211,9 @@
(defgeneric make-condition-variable ()
(:documentation "Returns a new condition-variable object for use
- with CONDITION-WAIT and CONDITION-NOTIFY."))
+ with CONDITION-WAIT and CONDITION-NOTIFY.")
+ (:method ()
+ nil))
(defgeneric condition-wait (condition-variable lock)
(:documentation "Atomically release LOCK and enqueue the calling
@@ -250,7 +257,9 @@
(defgeneric all-threads ()
(:documentation "Returns a sequence of all of the threads. This
may or may not be freshly-allocated, so the caller should not modify
- it."))
+ it.")
+ (:method ()
+ (error (make-threading-support-error))))
(defgeneric interrupt-thread (thread function)
(:documentation "Interrupt THREAD and cause it to evaluate FUNCTION
diff -rN -u old-bordeaux-threads/src/unsupported.lisp new-bordeaux-threads/src/unsupported.lisp
--- old-bordeaux-threads/src/unsupported.lisp 2007-12-08 18:32:09.000000000 +0100
+++ new-bordeaux-threads/src/unsupported.lisp 2007-12-08 18:32:09.000000000 +0100
@@ -6,9 +6,31 @@
(in-package :bordeaux-threads)
-(defmethod current-thread ()
+(defun make-lock (&optional name)
+ (declare (ignore name))
nil)
-(cerror "Ignore and continue"
- "There is no Bordeaux-Threads support for your implementation, some features may not work.
-Feel free to implement it, or bug one of the maintainers to do so if your lisp supports threads at all.")
\ No newline at end of file
+(defmacro with-lock-held ((place) &body body)
+ (declare (ignore place))
+ `(progn , at body))
+
+(defun make-recursive-lock (&optional name)
+ (declare (ignore name))
+ nil)
+
+(defmacro with-recursive-lock-held ((place) &body body)
+ (declare (ignore place))
+ `(progn , at body))
+
+(defun make-thread (function &key name)
+ (declare (ignore function name))
+ (error (make-threading-support-error)))
+
+(defun thread-yield ()
+ (error (make-threading-support-error)))
+
+(warn "Either there is no Bordeaux-Threads support for your
+implementation, or your implementation does not support threads
+therefore some features may not work.
+Feel free to implement it, or bug one of the maintainers to do so
+if your lisp supports threads at all.")
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 189 bytes
Desc: not available
URL: <https://mailman.common-lisp.net/pipermail/bordeaux-threads-devel/attachments/20071208/eff6046e/attachment.sig>
More information about the bordeaux-threads-devel
mailing list