X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fpool.lisp;h=f58e752848a810a329760409a7b78b14f4e6c66a;hp=4eff915d3da66e0b66f3ece991ca1f319c59ef0b;hb=bada52b7a8fd2cc484dee33cccd64ca09a52ec3d;hpb=03a14eaaf7d95a8775ba523a44a2485ec9f9785a diff --git a/sql/pool.lisp b/sql/pool.lisp index 4eff915..f58e752 100644 --- a/sql/pool.lisp +++ b/sql/pool.lisp @@ -2,22 +2,21 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: pool.cl +;;;; Name: pool.lisp ;;;; Purpose: Support function for connection pool ;;;; Programmers: Kevin M. Rosenberg, Marc Battyani ;;;; Date Started: Apr 2002 ;;;; -;;;; $Id: pool.lisp,v 1.3 2002/10/21 14:11:09 kevin Exp $ +;;;; $Id$ ;;;; -;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg +;;;; This file, part of CLSQL, is Copyright (c) 2002-2003 by Kevin M. Rosenberg ;;;; ;;;; CLSQL users are granted the rights to distribute and use this software ;;;; as governed by the terms of the Lisp Lesser GNU Public License ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) -(in-package :clsql-sys) +(in-package clsql-sys) (defun make-process-lock (name) #+allegro (mp:make-process-lock :name name) @@ -49,7 +48,7 @@ (all-connections :accessor all-connections :initform (make-array 5 :fill-pointer 0 :adjustable t)) (lock :accessor conn-pool-lock - :initform (make-lock "Connection pool")))) + :initform (make-process-lock "Connection pool")))) (defun acquire-from-conn-pool (pool) (or (with-process-lock ((conn-pool-lock pool) "Acquire from pool") @@ -79,7 +78,7 @@ (defun find-or-create-connection-pool (connection-spec database-type) "Find connection pool in hash table, creates a new connection pool if not found" - (with-process-lock (*db-pool-lock* "Find connection") + (with-process-lock (*db-pool-lock* "Find-or-create connection") (let* ((key (list connection-spec database-type)) (conn-pool (gethash key *db-pool*))) (unless conn-pool @@ -99,7 +98,7 @@ (defun disconnect-pooled (&optional clear) "Disconnects all connections in the pool" - (with-process-lock (*db-pool-lock* "Find connection") + (with-process-lock (*db-pool-lock* "Disconnect pooled") (maphash #'(lambda (key conn-pool) (declare (ignore key)) @@ -107,4 +106,3 @@ *db-pool*) (when clear (clrhash *db-pool*))) t) -