FFI: :malloc-free allocation (was: FFI guru/wizard award to be re warded)

Hoehle, Joerg-Cyril writes:

 > Using (setf (slot (element DBT-pool 0) 'data) "foobar")
 > invokes malloc(). We can free() that memory using
 > (setf (slot (element DBT-pool pool-index) 'data) nil)

really interesting! I wasn't aware of this feature.

 > On creating and using foreign-objects dynamically instead of the
 > def-c-var trick 

I used this approach. I wrote the following macro:

(defmacro with-dbt ((dbt value) &body body)
  (let ((val (gensym))
        (data (gensym ))
        (foreign-type-decl (gensym))
        (foreign-length (gensym)))
    `(let ((,val ,value)
           (,dbt (make-dbt :ulen 0 :dlen 0 :doff 0 :flags 0)))
       (multiple-value-bind (,foreign-type-decl ,foreign-length)
           (make-foreign-type-decl ,val)
         (with-c-var (,data  ,foreign-type-decl ,val)
            (setf (dbt-data ,dbt) (c-var-address ,data))
            (setf (dbt-size ,dbt) ,foreign-length)
            ,@body)))))

(in my definition of DBT, data is a c-pointer). Polymorphism is
managed by MAKE-FOREIGN-TYPE-DECL, a generic functions which dispatch
on the type of its argument:

(defmethod make-foreign-type-decl ((value integer))
  (typecase value
    (fixnum (values 'int sizeof-int))
    (otherwise (signal-db-error (format nil "Integer type ~A not supported"
                                        (type-of value))))))

(defmethod make-foreign-type-decl ((value string))
  (let ((l (length value)))
    (values `(c-array character ,l) l)))

etc.

I also wrote a thin C wrapper around DB functions, since it is almost
impossible to use DB structure and its function pointers from Lisp:

(def-c-type DB c-pointer)
(def-c-type DB-TXN c-pointer)

(def-call-out ffi-db-get
  (:name "db_get")
  (:arguments  (db DB :in) (txn DB-TXN :in) (key (c-ptr DBT) :in)
               (data (c-ptr DBT) :out) (flags uint32 :in))
  (:return-type int))

int 
db_get (DB *dbp, DB_TXN *txnid, DBT *key, DBT *data, u_int32_t flags)
{
  int r;
  
  db_log (3, "db_get: dbp = %p, txnid = %p, key = %p, data = %p, "
          "flags = %u", dbp, txnid, key, data, flags);
  data->flags = DB_DBT_MALLOC;
  r = dbp->get (dbp, txnid, key, data, flags);
  dbFuncLog (db->get, r);
  return r;
}

My Lisp version of DB->get:

(defun db-get (key &key (db *default-db*) (txn *default-txn*) (flags 0) 
                   (data-type '(unsigned-byte 8)))
  "Retrieves key/data pairs from database."
  (if (valid-data-type-p data-type)
    (with-dbt (key-dbt key)
      (multiple-value-bind (r data)
          (ffi-db-get (foreign-object-address db) (foreign-object-address txn)
                      key-dbt flags)
        (unwind-protect
            (cond
             ;; Success, key found.
             ((= r 0) (values r
                              (get-foreign-data (dbt-data data)
                                                (dbt-size data) data-type)))
             ;; Success, key not found.
             ((not-found-error-p r)  (values r nil))
             ;; Error.
             (t (signal-db-error "db-get" r)))
          ;; Free DBT data.
          (linux:free (dbt-data data)))))
    (signal-db-error (format nil "Invalid data type: ~A" data-type))))

IMHO, this solution is quite simple and intuitive. Probably
performances can be improved, but for my needs they are accetable.


-------------------------------------------------------
This SF.net email is sponsored by: ValueWeb: 
Dedicated Hosting for just $79/mo with 500 GB of bandwidth! 
No other company gives more support or power for your dedicated server
http://click.atdmt.com/AFF/go/sdnxxaff00300020aff/direct/01/