db-oracle/alien-resources.lisp

   1 ;;; -*- Mode: Lisp -*-
   2 ;;; $Id$
   3
   4 ;;; This is copyrighted software.  See documentation for terms.
   5 ;;;
   6 ;;; oracle-sql.lisp --- SQL-Interface implementation for Oracle
   7 ;;;
   8 ;;; derived from postgresql.lisp
   9
  10 (in-package :clsql-oracle)
  11
  12 (declaim (optimize (speed 3)
  13                    (debug 1)))
  14
  15 (defparameter *alien-resource-hash* (make-hash-table :test #'equal))
  16
  17 (defun %get-resource (type sizeof)
  18   (let ((resources (gethash type *alien-resource-hash*)))
  19     (car (member-if
  20           #'(lambda (res)
  21               (and (= (alien-resource-sizeof res) sizeof)
  22                    (not (alien-resource-in-use res))))
  23           resources))))
  24
  25 (defun %insert-alien-resource (type res)
  26   (let ((resource (gethash type *alien-resource-hash*)))
  27     (setf (gethash type *alien-resource-hash*)
  28           (cons res (gethash type *alien-resource-hash*)))))
  29
  30 (defmacro acquire-alien-resource (type &optional size)
  31   `(let ((res (%get-resource ',type ,size)))
  32      (unless res
  33        (setf res (make-alien-resource
  34                   :type ',type :sizeof ,size
  35                   :buffer (make-alien ,type ,size)))
  36        (%insert-alien-resource ',type res))
  37      (claim-alien-resource res)))
  38
  39 (defstruct (alien-resource)
  40   (type (error "Missing TYPE.")
  41         :read-only t)
  42   (sizeof (error "Missing SIZEOF.")
  43           :read-only t)
  44   (buffer (error "Missing BUFFER.")
  45           :read-only t)
  46   (in-use nil :type boolean))
  47
  48 (defun free-alien-resource (ares)
  49   (setf (alien-resource-in-use ares) nil)
  50   ares)
  51
  52 (defun claim-alien-resource (ares)
  53   (setf (alien-resource-in-use ares) t)
  54   ares)
  55
  56
  57