compiles on lispworks 6

diff --git a/ChangeLog b/ChangeLog
index 0311cb2c718ab273239528a496f555730a871900..ddb6896a8a9c9ec26ce1acdab6a28918b45ab7e7 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+7 Jan 2009  Kevin Rosenberg <kevin@rosenberg.net>
+       * Version 4.2.1
+       * sql/utils.lisp: Changes to support Lispworks 6
+

 10 Dec 2009  Kevin Rosenberg <kevin@rosenberg.net>
        * Version 4.2.0
        * doc/ref-ooddl.lisp: Add needed CDATA escapes
 10 Dec 2009  Kevin Rosenberg <kevin@rosenberg.net>
        * Version 4.2.0
        * doc/ref-ooddl.lisp: Add needed CDATA escapes

diff --git a/debian/changelog b/debian/changelog
index 2d8e192e4975004e1a20a0262c354c8e59bc03ae..1247648feb17eaec0451b5a78965b82459407f0c 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+cl-sql (4.2.1-1) unstable; urgency=low
+
+  * New upstream
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Thu, 07 Jan 2010 11:03:33 -0700
+

 cl-sql (4.2.0-1) unstable; urgency=low
 
   * New upstream
 cl-sql (4.2.0-1) unstable; urgency=low
 
   * New upstream

diff --git a/sql/utils.lisp b/sql/utils.lisp
index e6176cbb0a18f110620931938172e74b91472d3b..51eef9ebe20b5ff52a1c9c7bbaf821279a37f175 100644 (file)
--- a/sql/utils.lisp
+++ b/sql/utils.lisp
@@ -57,11 +57,24 @@
                      (string identifier))))
     (substitute #\_ #\- unescaped)))
 
                      (string identifier))))
     (substitute #\_ #\- unescaped)))
 

+#+lispworks
+(defvar +lw-has-without-preemption+
+  #+lispworks6 nil
+  #-lispworks6 t)
+#+lispworks
+(defvar +lw-global-lock+
+  (unless +lw-has-without-preemption+
+    (mp:make-lock :name "CLSQL" :important-p nil :safep t :recursivep nil)))
+

 (defmacro without-interrupts (&body body)
   #+allegro `(mp:without-scheduling ,@body)
   #+clisp `(progn ,@body)
   #+cmu `(system:without-interrupts ,@body)
 (defmacro without-interrupts (&body body)
   #+allegro `(mp:without-scheduling ,@body)
   #+clisp `(progn ,@body)
   #+cmu `(system:without-interrupts ,@body)

-  #+lispworks `(mp:without-preemption ,@body)
+  #+lispworks
+  (if +lw-has-without-preemption+
+      `(mp:without-preemption ,@body)
+      `(mp:with-exclusive-lock (+lw-global-lock+)
+         ,@body))

   #+openmcl `(ccl:without-interrupts ,@body)
   #+sbcl `(sb-sys::without-interrupts ,@body))
 
   #+openmcl `(ccl:without-interrupts ,@body)
   #+sbcl `(sb-sys::without-interrupts ,@body))