[elephant-cvs] CVS elephant/src/memutil

ieslick ieslick at common-lisp.net
Sat Feb 3 00:57:34 UTC 2007


Update of /project/elephant/cvsroot/elephant/src/memutil
In directory clnet:/tmp/cvs-serv12026/src/memutil

Modified Files:
	memutil.lisp 
Log Message:
Fixed bug from last checkin; implemented abstraction for fast-locks for systems that have such a thing (such as without-interrupts in non-parallel lisps)

--- /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp	2007/02/01 15:19:50	1.18
+++ /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp	2007/02/03 00:57:34	1.19
@@ -21,7 +21,7 @@
   (:documentation "A low-level UFFI-based memory access and
     serialization toolkit.  Provides basic cross-platform
     binary serialization support for backends.")
-  (:use common-lisp uffi)
+  (:use common-lisp uffi elephant-utils)
   #+cmu
   (:use alien)
   #+sbcl
@@ -121,22 +121,15 @@
 (defvar +NULL-CHAR+ (make-null-pointer :char)
   "A null pointer to a char type.")
 
-
-(defmacro memutil-without-interrupts (&body body)
-  "Ensure platform dependent atomicity"
-  `(
-    #+allegro excl:without-interrupts
-    #+lispworks lispworks:without-interrupts
-    #+sbcl sb-sys:without-interrupts
-    #+cmu system:without-interrupts
-    #+openmcl ccl:without-interrupts
-    , at body))
-
+;;
 ;; Thread local storage (special variables)
+;;
 
 (defvar *buffer-streams* (make-array 0 :adjustable t :fill-pointer t)
   "Vector of buffer-streams, which you can grab / return.")
 
+(defvar *buffer-streams-lock* (ele-make-fast-lock))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; buffer-streams
@@ -156,13 +149,13 @@
   "Grab a buffer-stream from the *buffer-streams* resource pool."
   (if (= (length *buffer-streams*) 0)
       (make-buffer-stream)
-      (memutil-without-interrupts
+      (ele-with-fast-lock (*buffer-streams-lock*)
 	(vector-pop *buffer-streams*))))
 
 (defun return-buffer-stream (bs)
   "Return a buffer-stream to the *buffer-streams* resource pool."
   (reset-buffer-stream bs)
-  (memutil-without-interrupts
+  (ele-with-fast-lock (*buffer-streams-lock*)
     (vector-push-extend bs *buffer-streams*)))
 
 (defmacro with-buffer-streams (names &body body)




More information about the Elephant-cvs mailing list