X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=base%2Fpool.lisp;h=0564eb0e33f9651c2bc9af616e6c815d99111677;hb=09f07ac9d914a83f9426609f3264f4e66b5a6d97;hp=53730e3a462a87a267fd4faf99f4b107042f63eb;hpb=5068697a98c10224f3a3e0a7125ba64cf3d3b4fb;p=clsql.git diff --git a/base/pool.lisp b/base/pool.lisp index 53730e3..0564eb0 100644 --- a/base/pool.lisp +++ b/base/pool.lisp @@ -16,35 +16,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(in-package #:clsql-base-sys) - -(defun make-process-lock (name) - #+allegro (mp:make-process-lock :name name) - #+cmu (mp:make-lock name) - #+lispworks (mp:make-lock :name name) - #+openmcl (ccl:make-lock :name name) - #+sb-thread (sb-thread:make-mutex :name name) - #+scl (thread:make-lock name) - #-(or allegro cmu lispworks openmcl sb-thread scl) (declare (ignore name)) - #-(or allegro cmu lispworks openmcl sb-thread scl) nil) - -(defmacro with-process-lock ((lock desc) &body body) - #+(or cmu allegro lispworks openmcl sb-thread) - (declare (ignore desc)) - #+(or allegro cmu lispworks openmcl sb-thread) - (let ((l (gensym))) - `(let ((,l ,lock)) - #+allegro (mp:with-process-lock (,l) ,@body) - #+cmu `(mp:with-lock-held (,lock) ,@body) - #+openmcl (ccl:with-lock-grabbed (,lock) ,@body) - #+lispworks (mp:with-lock (,l) ,@body) - #+sb-thread (sb-thread:with-recursive-lock (,lock) ,@body) - )) - - #+scl `(thread:with-lock-held (,lock ,desc) ,@body) - - #-(or cmu allegro lispworks openmcl sb-thread scl) (declare (ignore lock desc)) - #-(or cmu allegro lispworks openmcl sb-thread scl) `(progn ,@body)) +(in-package #:clsql-base) (defvar *db-pool* (make-hash-table :test #'equal)) (defvar *db-pool-lock* (make-process-lock "DB Pool lock"))