[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