libffi/cstruct.lisp

   1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; cstruct.lisp --- Hook to defcstruct
   4 ;;;
   5 ;;; Copyright (C) 2009, 2010, 2011 Liam Healy  <lhealy@common-lisp.net>
   6 ;;;
   7 ;;; Permission is hereby granted, free of charge, to any person
   8 ;;; obtaining a copy of this software and associated documentation
   9 ;;; files (the "Software"), to deal in the Software without
  10 ;;; restriction, including without limitation the rights to use, copy,
  11 ;;; modify, merge, publish, distribute, sublicense, and/or sell copies
  12 ;;; of the Software, and to permit persons to whom the Software is
  13 ;;; furnished to do so, subject to the following conditions:
  14 ;;;
  15 ;;; The above copyright notice and this permission notice shall be
  16 ;;; included in all copies or substantial portions of the Software.
  17 ;;;
  18 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  19 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  20 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  21 ;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
  22 ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
  23 ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  24 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
  25 ;;; DEALINGS IN THE SOFTWARE.
  26 ;;;
  27
  28 (in-package #:cffi)
  29
  30 (defun slot-multiplicity (slot)
  31   (if (typep slot 'cffi::aggregate-struct-slot)
  32       (cffi::slot-count slot)
  33       1))
  34
  35 (defun number-of-items (structure-type)
  36   "Total number of items in the foreign structure."
  37   (loop for val being the hash-value of (cffi::structure-slots structure-type)
  38         sum (slot-multiplicity val)))
  39
  40 (defmethod libffi-type-pointer ((type foreign-struct-type))
  41   (or (call-next-method)
  42       (set-libffi-type-pointer
  43        type
  44        (let* ((ptr (cffi:foreign-alloc '(:struct ffi-type)))
  45               (nitems (number-of-items type))
  46               (type-pointer-array
  47                 (cffi:foreign-alloc :pointer :count (1+ nitems))))
  48          (loop for slot in (slots-in-order type)
  49                for ltp = (libffi-type-pointer (cffi::slot-type slot))
  50                with slot-counter = 0
  51                do (if ltp
  52                       (loop
  53                         repeat (slot-multiplicity slot)
  54                         do (setf
  55                             (cffi:mem-aref
  56                              type-pointer-array :pointer slot-counter)
  57                             ltp)
  58                            (incf slot-counter))
  59                       (error
  60                        "Slot type ~a in foreign structure is unknown to libffi."
  61                        (cffi::unparse-type (cffi::slot-type slot)))))
  62          (setf
  63           (cffi:mem-aref type-pointer-array :pointer nitems)
  64           (cffi:null-pointer)
  65           ;; The ffi-type
  66           (cffi:foreign-slot-value ptr '(:struct ffi-type) 'size)
  67           0
  68           (cffi:foreign-slot-value ptr '(:struct ffi-type) 'alignment)
  69           0
  70           (cffi:foreign-slot-value ptr '(:struct ffi-type) 'type)
  71           +type-struct+
  72           (cffi:foreign-slot-value ptr '(:struct ffi-type) 'elements)
  73           type-pointer-array)
  74          ptr))))