[armedbear-cvs] r12213 - trunk/abcl/src/org/armedbear/lisp

[Erik Huelsmann]

Author: ehuelsmann
Date: Fri Oct 23 16:03:55 2009
New Revision: 12213

Log:
Move the implementation of the Mutex functionality to the THREADS package
*and* move the implementation to Lisp.

Removed:
   trunk/abcl/src/org/armedbear/lisp/Mutex.java
   trunk/abcl/src/org/armedbear/lisp/with-mutex.lisp
Modified:
   trunk/abcl/src/org/armedbear/lisp/Autoload.java
   trunk/abcl/src/org/armedbear/lisp/autoloads.lisp
   trunk/abcl/src/org/armedbear/lisp/compile-system.lisp
   trunk/abcl/src/org/armedbear/lisp/threads.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/Autoload.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Autoload.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Autoload.java	Fri Oct 23 16:03:55 2009
@@ -665,10 +665,6 @@
         autoload(PACKAGE_SYS, "std-allocate-instance", "StandardObjectFunctions", true);
         autoload(PACKAGE_SYS, "zip", "zip", true);
 
-        autoload(PACKAGE_THREADS, "make-mutex", "Mutex", true);
-        autoload(PACKAGE_THREADS, "get-mutex", "Mutex", true);
-        autoload(PACKAGE_THREADS, "release-mutex", "Mutex", true);
-
         autoload(Symbol.COPY_LIST, "copy_list");
 
         autoload(Symbol.SET_CHAR, "StringFunctions");

Modified: trunk/abcl/src/org/armedbear/lisp/autoloads.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/autoloads.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/autoloads.lisp	Fri Oct 23 16:03:55 2009
@@ -292,20 +292,39 @@
 (autoload 'socket-peer-address "socket")
 
 (in-package "THREADS")
-(sys::export '(mailbox-send mailbox-empty-p mailbox-read mailbox-peek))
-(sys::autoload '(mailbox-send mailbox-empty-p mailbox-read mailbox-peek)
-    "threads")
 
-(sys::export '(make-thread-lock thread-lock thread-unlock with-thread-lock))
-(sys::autoload '(make-thread-lock thread-lock thread-unlock) "threads")
-(sys::autoload-macro 'with-thread-lock "threads")
 
-;; block to be removed at 0.22
+(autoload '(;; Mailbox
+            make-mailbox mailbox-send mailbox-empty-p
+            mailbox-read mailbox-peek
 
-(in-package "EXTENSIONS")
+            ;; Lock
+            make-thread-lock thread-lock thread-unlock
+
+            ;; Mutex
+            make-mutex get-mutex release-mutex)
+    "threads")
 
-(export '(mailbox-send mailbox-empty-p mailbox-read mailbox-peek))
+(autoload-macro '(;; Lock
+                  with-thread-lock
+
+                  ;; Mutex
+                  with-mutex)
+                "threads")
+
+(export '(make-mailbox mailbox-send mailbox-empty-p
+          mailbox-read mailbox-peek))
 (export '(make-thread-lock thread-lock thread-unlock with-thread-lock))
+(export '(make-mutex get-mutex release-mutex with-mutex))
+
+(progn
+  ;; block to be removed at 0.22
+  ;; It exists solely for pre-0.17 compatibility
+  ;; FIXME 0.22
+  (in-package "EXTENSIONS")
+  (export '(mailbox-send mailbox-empty-p mailbox-read mailbox-peek))
+  (export '(make-thread-lock thread-lock thread-unlock with-thread-lock))
+  (export '(with-mutex make-mutex get-mutex release-mutex)))
 
 ;; end of 0.22 block
 
@@ -340,6 +359,3 @@
 (export 'compiler-let)
 (autoload 'compiler-let)
 
-(in-package "THREADS")
-(export 'with-mutex)
-(ext:autoload-macro 'with-mutex)

Modified: trunk/abcl/src/org/armedbear/lisp/compile-system.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compile-system.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/compile-system.lisp	Fri Oct 23 16:03:55 2009
@@ -256,7 +256,6 @@
                            "with-accessors.lisp"
                            "with-hash-table-iterator.lisp"
                            "with-input-from-string.lisp"
-                           "with-mutex.lisp"
                            "with-open-file.lisp"
                            "with-output-to-string.lisp"
                            "with-package-iterator.lisp"

Modified: trunk/abcl/src/org/armedbear/lisp/threads.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/threads.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/threads.lisp	Fri Oct 23 16:03:55 2009
@@ -38,7 +38,7 @@
 ;;
 
 ;; this export statement is also in autoloads.lisp
-(export '(mailbox-send mailbox-empty-p mailbox-read mailbox-peek))
+(export '(make-mailbox mailbox-send mailbox-empty-p mailbox-read mailbox-peek))
 
 (defstruct mailbox
   queue)
@@ -82,6 +82,43 @@
 
 
 ;;
+;; Mutex implementation
+;;
+
+
+;; this export statement is also in autoloads.lisp
+(export '(make-mutex get-mutex release-mutex))
+
+(defstruct mutex
+  in-use)
+
+(defun get-mutex (mutex)
+  "Acquires a lock on the `mutex'."
+  (synchronized-on mutex
+    (loop
+       while (mutex-in-use mutex)
+       do (object-wait mutex))
+    (setf (mutex-in-use mutex) T)))
+
+(defun release-mutex (mutex)
+  "Releases a lock on the `mutex'."
+  (synchronized-on mutex
+    (setf (mutex-in-use mutex) NIL)
+    (object-notify mutex)))
+
+(defmacro with-mutex ((mutex) &body body)
+  "Acquires a lock on `mutex', executes the body
+and releases the lock."
+  (let ((m (gensym)))
+    `(let ((,m ,mutex))
+       (when (get-mutex ,m)
+         (unwind-protect
+          (progn
+            , at body)
+          (release-mutex ,m))))))
+
+
+;;
 ;; Lock implementation
 ;;
 
@@ -90,6 +127,7 @@
   (gensym))
 
 (defmacro with-thread-lock ((lock) &body body)
+  "Acquires a lock on the `lock', executes `body' and releases the lock."
   (let ((glock (gensym)))
     `(let ((,glock ,lock))
        (synchronized-on ,glock