Вопрос

I'm under the impression that CFFI cant pass structs by value, but the CFFI documentation says:

To pass or return a structure by value to a function, load the cffi-libffi system and specify the structure as (:struct structure-name). To pass or return the pointer, you can use either :pointer or (:pointer (:struct structure-name)).

I'm re-wrapping the cl-opencv function get-size, which is a wrapper for this opencv function:

CvSize cvGetSize(const CvArr* arr)

and since I don't think CFFI had the ability to pass structs by value with the cffi-libffi system when the author of cl-opencv wrote the library, so he had to use all of the following code to wrap cvGetSize:

 (defmacro make-structure-serializers (struct slot1 slot2)
  "Create a serialization and deserialization function for the
structure STRUCT with integer slots SLOT1 and SLOT2. These functions
will pack and unpack the structure into an INT64."
  (let ((pack-fn (intern (concatenate 'string (string struct) 
                       (string '->int64))))
    (slot1-fn (intern (concatenate 'string (string struct) "-" 
                        (string slot1))))
    (slot2-fn (intern (concatenate 'string (string struct) "-" 
                        (string slot2))))
    (unpack-fn (intern (concatenate 'string (string 'int64->) 
                    (string struct))))
    (make-fn (intern (concatenate 'string (string 'make-) 
                       (string struct)))))
     `(progn
        (defun ,pack-fn (s)
     (+ (,slot1-fn s) (ash (,slot2-fn s) 32)))
        (defun ,unpack-fn (n)
     (,make-fn ,slot1 (logand n #x00000000ffffffff)
            ,slot2 (ash n -32))))))


;; CvSize - Input = (defparameter a (make-size :width 640 :height 480)) Output = #S(SIZE :WIDTH 640 :HEIGHT 480) for 
;; following the two.
(defstruct size (width 0) (height 0))
(make-structure-serializers :size :width :height)

;; CvSize cvGetSize(const CvArr* arr)
(cffi:defcfun ("cvGetSize" %get-size) :int64
  (arr cv-array))

(defun get-size (arr)
  "Get the dimensions of the OpenCV array ARR. Return a size struct with the
dimensions."
  (let ((nsize (%get-size arr)))
     (int64->size nsize)))

Given the CFFI documentation quoted above, how would I pass this cvGetSize struct CvSize by value?

I intend to update the cl-opencv package, and I would like to know where and how in the cl-opencv package I would "load the cffi-libffi system" as per the CFFI documentation, and where to "specify the structure as (:struct structure-name)" and "use either :pointer or (:pointer (:struct structure-name))" "to pass or return the pointer."

I could use detailed instructions on how to do that using the above cvGetSize wrapper:

;; CvSize cvGetSize(const CvArr* arr)
(cffi:defcfun ("cvGetSize" %get-size) :int64
  (arr cv-array))

(defun get-size (arr)
  "Get the dimensions of the OpenCV array ARR. Return a size struct with the
dimensions."
  (let ((nsize (%get-size arr)))
     (int64->size nsize)))

Edit for @Rörd

I appreciate your consice response

I get the same error either way...but for testing purposes lets say i load cffi-libffi into my current session like this(with output)

CL-OPENCV> (asdf:oos 'asdf:load-op :cffi-libffi) 
#<ASDF:LOAD-OP NIL {10076CCF13}>
NIL

it loads so i run just the defcfun and the defcstruct you provided like this (with output):

 CL-OPENCV> (cffi:defcstruct cv-size
           (width :int)
           (height :int))

  (:STRUCT CV-SIZE)
  CL-OPENCV> 
  (defcfun ("cvGetSize" %get-size) (:struct cv-size)
    (arr cv-array))
  ; in: DEFCFUN ("cvGetSize" %GET-SIZE)
  ;     ("cvGetSize" CL-OPENCV::%GET-SIZE)
  ; 
  ; caught ERROR:
  ;   illegal function call
  ; 
  ; compilation unit finished
  ;   caught 1 ERROR condition

  Execution of a form compiled with errors.
  Form:
    ("cvGetSize" %GET-SIZE)
  Compile-time error:
    illegal function call
     [Condition of type SB-INT:COMPILED-PROGRAM-ERROR]

  Restarts:
   0: [RETRY] Retry SLIME REPL evaluation request.
   1: [*ABORT] Return to SLIME's top level.
   2: [ABORT] Abort thread (#<THREAD "repl-thread" RUNNING {1007BA8063}>)

      Backtrace:
             0: ((LAMBDA ()))
                 [No Locals]
             1: (SB-INT:SIMPLE-EVAL-IN-LEXENV ("cvGetSize" %GET-SIZE) #<NULL-LEXENV>)
                 Locals:
                   SB-DEBUG::ARG-0 = ("cvGetSize" %GET-SIZE)
                   SB-DEBUG::ARG-1 = #<NULL-LEXENV>
             2: (SB-INT:SIMPLE-EVAL-IN-LEXENV (DEFCFUN ("cvGetSize" %GET-SIZE) (:STRUCT CV-SIZE) (ARR CV-ARRAY)) #<NULL-LEXENV>)
                 Locals:
                   SB-DEBUG::ARG-0 = (DEFCFUN ("cvGetSize" %GET-SIZE) (:STRUCT CV-SIZE) (ARR CV-ARRAY))
                   SB-DEBUG::ARG-1 = #<NULL-LEXENV>
             3: (EVAL (DEFCFUN ("cvGetSize" %GET-SIZE) (:STRUCT CV-SIZE) (ARR CV-ARRAY)))
                 Locals:

I know libffi is installed correctly because with gsll loaded (which uses cffi-libffi) i run the gsll tests and they all pass shown here(with output)

(ql:quickload "lisp-unit")
  (in-package :gsl)
  (lisp-unit:run-tests)
To load "lisp-unit":
  Load 1 ASDF system:
    lisp-unit
     Loading "lisp-unit"
..................................
Unit Test Summary
 | 4023 assertions total
 | 4022 passed
 | 1 failed
 | 0 execution errors
 | 0 missing tests

#<TEST-RESULTS-DB Total(4023) Passed(4022) Failed(1) Errors(0)>

It doesnt seem to be calling the defcfun with the (:struct cv-size) as the issue because when i call it like

(defcfun ("cvGetSize" %get-size) cv-size
  (arr cv-array))

i get same error

Execution of a form compiled with errors.
Form:
  ("cvGetSize" %GET-SIZE)
Compile-time error:

I can run my ipl-image struct though like this

CL-OPENCV> ;; ;(cffi:foreign-type-size '(:struct ipl-image)) = 144
(cffi:defcstruct ipl-image
(n-size :int)
(id :int)
(n-channels :int)
(alpha-channel :int)
(depth :int)
(color-model :pointer) 
(channel-seq :pointer) 
(data-order :int)
(origin :int)
(align :int)
(width :int)
(height :int)
(roi :pointer)
(mask-roi :pointer)
(image-id :pointer)
(tile-info :pointer)
(image-size :int)
(image-data :string)
(width-step :int)
(border-mode :pointer)
(border-const :pointer)
(image-data-origin :string))

   output>(:STRUCT IPL-IMAGE)

and my create-image wrapper now with cffi-libffi loaded and your (:struct ipl-image) on it runs fine it though ...shown with output

;; IplImage* cvCreateImage(CvSize size, int depth, int channels)
(cffi:defcfun ("cvCreateImage" %create-image) (:struct ipl-image)
  (size :int64)
  (depth :int)
  (channels :int))

(defun create-image (size depth channels)
  "Create an image with dimensions given by SIZE, DEPTH bits per
channel, and CHANNELS number of channels."
 (let ((nsize (size->int64 size)))
    (%create-image nsize depth channels)))

CREATE-IMAGE

but when i run

(defparameter img-size (make-size :width 640 :height 480))

(defparameter img (create-image img-size +ipl-depth-8u+ 1))

create an image at repl nothing happens the repl just hangs...

but when i run the create image wrapper with ipl-image instead of (:struct ipl-image)

i can run the :

 (defparameter img-size (make-size :width 640 :height 480))

 (defparameter img (create-image img-size +ipl-depth-8u+ 1))

fine then run this to access the struct values (with output)

 (cffi:with-foreign-slots ((
  n-size
  id
  n-channels
  alpha-channel
  depth
  color-model
  channel-seq
  data-order
  origin
  align
  width
  height
  roi
  mask-roi
  image-id
  tile-info
  image-size
  image-data
  width-step
  border-mode
  border-const
  image-data-origin) img (:struct ipl-image))
            (cffi:mem-ref img :char )
            (format t "n-size ~a ~%" n-size)
            (format t "id ~a ~%" id)
            (format t "n-channels ~a ~%" n-channels)
            (format t "alpha-channel ~a ~%" alpha-channel)
            (format t "depth ~a ~%" depth)
            (format t "color-model ~a ~%" color-model)
            (format t "channel-seq ~a ~%" channel-seq)
            (format t "data-order ~a ~%" data-order)
            (format t "origin ~a ~%" origin)
            (format t "align ~a ~%" align)
            (format t "width ~a ~%" width)
            (format t "height ~a ~%" height)
            (format t "roi ~a ~%" roi)
            (format t "mask-roi ~a ~%" mask-roi)
            (format t "image-id ~a ~%" image-id)
            (format t "tile-info ~a ~%" tile-info)
            (format t "image-size ~a ~%" image-size)
            (format t "image-data ~a ~%" image-data)
            (format t "width-step ~a ~%" width-step)
            (format t "border-mode ~a ~%" border-mode)
            (format t "border-const ~a ~%" border-const)
            (format t "image-data-origin ~a ~%" image-data-origin))
  output>
  n-size 144 
  id 0 
  n-channels 1 
  alpha-channel 0 
  depth 8 
  color-model #.(SB-SYS:INT-SAP #X59415247) 
  channel-seq #.(SB-SYS:INT-SAP #X400000000) 
  data-order 640 
  origin 480 
  align 0 
  width 0 
  height 0 
  roi #.(SB-SYS:INT-SAP #X00000000) 
  mask-roi #.(SB-SYS:INT-SAP #X00000000) 
  image-id #.(SB-SYS:INT-SAP #X0004B000) 
  tile-info #.(SB-SYS:INT-SAP #X7FFFF7F04020) 
  image-size 640 
  image-data NIL 
  width-step 0 
  border-mode #.(SB-SYS:INT-SAP #X00000000) 
  border-const #.(SB-SYS:INT-SAP #X00000000) 
  image-data-origin  

but im not getting a struct by value i get

 color-model #.(SB-SYS:INT-SAP #X59415247) 

which when i cout that value img->colorModel in c with this

IplImage* img=cvCreateImage(cvSize(640,480), IPL_DEPTH_8U, 3);
cout << "colorModel = " << endl << " " << img->colorModel << endl << endl;

output> colorModel = 
 RGB

so any help would be much appreciated

ok 1 more edit:

I tried it again and it worked here is my output

  CL-OPENCV> (asdf:oos 'asdf:load-op :cffi-libffi)
  #<ASDF:LOAD-OP NIL {1006D7B1F3}>
  NIL
  CL-OPENCV> 
  ;; ;(cffi:foreign-type-size '(:struct cv-size)) = 8
  (cffi:defcstruct cv-size
      (width :int)
      (height :int))

  ;; CvSize cvGetSize(const CvArr* arr)
  (cffi:defcfun ("cvGetSize" %get-size) (:struct cv-size)
    (arr cv-array))

  STYLE-WARNING: redefining CL-OPENCV::%GET-SIZE in DEFUN
  %GET-SIZE
  CL-OPENCV> 

   (defparameter img-size (make-size :width 640 :height 480))

  (defparameter img (create-image img-size +ipl-depth-8u+ 1))

  IMG
  CL-OPENCV> 

   (defparameter size (%get-size img))
  SIZE
  CL-OPENCV> size
  (HEIGHT 480 WIDTH 640)
  CL-OPENCV> 

dont know what i did wrong first time but...if you can check my results and verify i have just passed a struct by value i would be forever grateful

thanks Rord

ok another edit if your still interested in helping me debug Rord

if getting error:

  The value (HEIGHT 480 WIDTH 640)
   is not of type
   SB-SYS:SYSTEM-AREA-POINTER.
   [Condition of type TYPE-ERROR]

and here is the history that caused it(this happened directly after i posted the prev. edit so my emacs has all the prev. edits code loaded still):

   CL-OPENCV> (defun get-size (arr)
    "Get the dimensions of the OpenCV array ARR. Return a size struct with the
  dimensions."
    (cffi:with-foreign-slots ((width height) (%get-size arr) (:struct cv-size))
      (make-size :width width :height height)))
  STYLE-WARNING: redefining CL-OPENCV:GET-SIZE in DEFUN
  GET-SIZE
  CL-OPENCV> 

   (defparameter img-size (make-size :width 640 :height 480))

  (defparameter img (create-image img-size +ipl-depth-8u+ 1))

  IMG
  CL-OPENCV> 

   (defparameter size (get-size img))


  The value (HEIGHT 480 WIDTH 640)
   is not of type
   SB-SYS:SYSTEM-AREA-POINTER.
   [Condition of type TYPE-ERROR]

I get that because the:

(defparameter size (get-size img)) 

accesses your defun...i traced it so when i just run - shown with output:

CL-OPENCV> 
;; ;(cffi:foreign-type-size '(:struct cv-size)) = 8
(cffi:defcstruct cv-size
        (width :int)
        (height :int))

;; CvSize cvGetSize(const CvArr* arr)
 (cffi:defcfun ("cvGetSize" %get-size) (:struct cv-size)
  (arr cv-array))

STYLE-WARNING: redefining CL-OPENCV::%GET-SIZE in DEFUN
%GET-SIZE
CL-OPENCV> (defparameter capture (create-camera-capture 0))
CAPTURE
CL-OPENCV> (defparameter frame (query-frame capture))
FRAME
CL-OPENCV> 

(defparameter size (%get-size frame))
SIZE
CL-OPENCV> size
(HEIGHT 480 WIDTH 640)
CL-OPENCV> (cffi:with-foreign-slots ((width height) size (:struct cv-size))
        (list width height ))

i get error:

The value (HEIGHT 480 WIDTH 640)
  is not of type
    SB-SYS:SYSTEM-AREA-POINTER.
     [Condition of type 

I think its because the out put of your defcfun is just a list and with-foreign-slots needs a pointer

i ran this:

(HEIGHT 480 WIDTH 640)
CL-OPENCV> (first size)
HEIGHT

to verify and its just a list

btw i used these functions for test

(defparameter capture (create-camera-capture 0))

(defparameter frame (query-frame capture))

because the have a more pure output...create-image uses the hackery of the get-size i oroginally posted at the top of this ?

I'd like to use create-image and get-size w/o all the hackery and just use the structs for returns so i could stop using the make-size and make it more pure....so any advice on that would be gold...here is how i would like to have create-image...I just gotta get it to accept the output from your(Rord's) defcfun...I'm now tring to turn your defcfun output((HEIGHT 480 WIDTH 640)) to a pointer...so it will just run in this

;; IplImage* cvCreateImage(CvSize size, int depth, int channels)
(cffi:defcfun ("cvCreateImage" %create-image) ipl-image
  (size cv-size)
  (depth :int)
  (channels :int))

or is the whole make-size thing going to be a neccessity...

also fyi i changed the defun you added to

(defun get-size (arr)
  "Get the dimensions of the OpenCV array ARR. Return a size struct with the
dimensions."
  (setf arr (%get-size arr))
  (make-size :width (cadddr arr) :height (cadr arr)))

and it works now...still curios if i messed something up and if your defun would have been better

EDIT!!!!I GOT IT ALL FIGURED OUT!!!!!

here is the repl output :

; SLIME 2012-05-25
CL-OPENCV> ;; CvSize cvGetSize(const CvArr* arr)
(cffi:defcfun ("cvGetSize" get-size) (:pointer (:struct cv-size))
  (arr cv-array))
STYLE-WARNING: redefining CL-OPENCV:GET-SIZE in DEFUN
GET-SIZE
CL-OPENCV> ;; IplImage* cvCreateImage(CvSize size, int depth, int channels)
(cffi:defcfun ("cvCreateImage" create-image) (:pointer (:struct ipl-image))
   (size (:pointer (:struct ipl-image)))
  (depth :int)
  (channels :int))


STYLE-WARNING: redefining CL-OPENCV:CREATE-IMAGE in DEFUN
CREATE-IMAGE
CL-OPENCV> (defun detect-red-objects (&optional (camera-index 0))
   "Uses IN-RANGE-SCALAR to detect red objects"
  (with-capture (capture (create-camera-capture camera-index))
    (let ((window-name-1 "Video")
          (window-name-2 "Ball"))
           (named-window window-name-1)
           (named-window window-name-2)
           (move-window window-name-1 290 225)
           (move-window window-name-2 940 225)
      (do* ((frame (query-frame capture) (query-frame capture))
             (img (clone-image frame))
              (frame (clone-image img))
              (img-size (get-size frame))          
              (img-hsv (create-image img-size +ipl-depth-8u+ 3))
              (img-hsv-size (get-size img-hsv))
            (img-thresh (create-image img-hsv-size +ipl-depth-8u+ 1))
             (scalar-1 (make-cv-scalar 170.0 160.0 60.0))
             (scalar-2 (make-cv-scalar 180.0 256.0 256.0)))
         ((plusp (wait-key *millis-per-frame*)) nil)
             (smooth frame frame +gaussian+ 3 3)
             (cvt-color frame img-hsv +bgr2hsv+)
             (in-range-s img-hsv scalar-1 scalar-2 img-thresh)
             (smooth img-thresh img-thresh +gaussian+ 3 3)
             (show-image window-name-1 frame)
             (show-image window-name-2 img-thresh))
          (destroy-all-windows))))
DETECT-RED-OBJECTS

(the function detect-red-objects runs btw!...

EDIT!!!!I GOT IT ALL FIGURED OUT!!!!!...Part....II - Even Better!

I messed up the struct on create-image the first time but it still ran...weird...but it runs when put the create-image struct back to cv-size....so no prob there...here is revised repl output


; SLIME 2012-05-25
CL-OPENCV> ;; CvSize cvGetSize(const CvArr* arr)
(cffi:defcfun ("cvGetSize" get-size) (:pointer (:struct cv-size))
  (arr cv-array))
STYLE-WARNING: redefining CL-OPENCV:GET-SIZE in DEFUN
GET-SIZE
CL-OPENCV> ;; IplImage* cvCreateImage(CvSize size, int depth, int channels)
(cffi:defcfun ("cvCreateImage" create-image) (:pointer (:struct ipl-image))
  (size (:pointer (:struct cv-size)))
  (depth :int)
  (channels :int))

STYLE-WARNING: redefining CL-OPENCV:CREATE-IMAGE in DEFUN
CREATE-IMAGE
CL-OPENCV> (defun detect-red-objects (&optional (camera-index 0))
   "Uses IN-RANGE-SCALAR to detect red objects"
  (with-capture (capture (create-camera-capture camera-index))
    (let ((window-name-1 "Video")
          (window-name-2 "Ball"))
           (named-window window-name-1)
           (named-window window-name-2)
           (move-window window-name-1 290 225)
           (move-window window-name-2 940 225)
      (do* ((frame (query-frame capture) (query-frame capture))
             (img (clone-image frame))
              (frame (clone-image img))
              (img-size (get-size frame))           
              (img-hsv (create-image img-size +ipl-depth-8u+ 3))
              (img-hsv-size (get-size img-hsv))
            (img-thresh (create-image img-hsv-size +ipl-depth-8u+ 1))
             (scalar-1 (make-cv-scalar 170.0 160.0 60.0))
             (scalar-2 (make-cv-scalar 180.0 256.0 256.0)))
         ((plusp (wait-key *millis-per-frame*)) nil)
             (smooth frame frame +gaussian+ 3 3)
             (cvt-color frame img-hsv +bgr2hsv+)
             (in-range-s img-hsv scalar-1 scalar-2 img-thresh)
             (smooth img-thresh img-thresh +gaussian+ 3 3)
             (show-image window-name-1 frame)
             (show-image window-name-2 img-thresh)) 
          (destroy-all-windows))))
DETECT-RED-OBJECTS

@Liam Edit

ok I tried your translate-from-foreign method and it did work i have these defined in my structs.lisp file

(cffi:defcstruct (cv-size :class cv-size-type)
  (width :int)
  (height :int))

(defmethod cffi:translate-from-foreign (p (type cv-size-type))
  (let ((plist (call-next-method)))
    (make-size :width (getf plist 'width)
               :height (getf plist 'height))))

and get-size and create-image are defined like this

;; CvSize cvGetSize(const CvArr* arr)
 (cffi:defcfun ("cvGetSize" get-size) (:struct cv-size)
   (arr cv-arr))

 ;; IplImage* cvCreateImage(CvSize size, int depth, int channels)
 (cffi:defcfun ("cvCreateImage" %create-image) ipl-image
   (size :int64)
   (depth :int)
   (channels :int))

 (defun create-image (size depth channels)
   "Create an image with dimensions given by SIZE, DEPTH bits per
 channel, and CHANNELS number of channels."
   (let ((nsize (size->int64 size)))
     (%create-image nsize depth channels)))

here is the definition of size->int64

  (DEFUN SIZE->INT64 (S) (+ (SIZE-WIDTH S) (ASH (SIZE-HEIGHT S) 32)))

but i love the idea of the translate-foreign defmethod's

so i was wondering if you can show my how to make the translate-into-foreign version of the below from method this would really make my library sing...I'm aiming to make a complete cffi wrapper for opencv as good as gsll is to gsl so this would really help that happen quicker....Thanks again for your help on all this so far

(defmethod cffi:translate-from-foreign (p (type cv-size-type))
  (let ((plist (call-next-method)))
    (make-size :width (getf plist 'width)
               :height (getf plist 'height))))
Это было полезно?

Решение

To "load the cffi-libffi system", you need to specify it as dependency in the library's .asd file. (Note: cffi-libffi needs the C library libffi to be installed on your system.)

To be able to use (:struct structure-name), you need to first define the structure with cffi:defcstruct, like this (I will assume here that cffi:defcstruct, cffi:defcfun, and cffi:with-foreign-slots are imported in the current package):

(defcstruct cv-size
  (width :int)
  (height :int))

You can then use (:struct cv-size) in the defcfun like this:

(defcfun ("cvGetSize" %get-size) (:struct cv-size)
  (arr cv-array))

EDIT: Fixed get-size for passed-by-value structs.

And finally define get-size like this:

(defun get-size (arr)
  "Get the dimensions of the OpenCV array ARR. Return a size struct with the
dimensions."
  (let ((%size (%get-size arr)))
    (make-size :width (getf %size 'width)
               :height (getf %size 'height))))

EDIT 2:

If I understand Liam's answer correctly, this is how to write a translate-from-foreign method so that it creates the struct directly, without creating the intermediate plist:

(defmethod cffi:translate-from-foreign (p (type cv-size-type))
  (with-foreign-slots ((width height) p (:struct cv-size))
    (make-size :width width :height height)))

Другие советы

You don't have to define both %get-size and get-size. Instead, you could define

(defcstruct (cv-size :class cv-size-type)
  (width :int)
  (height :int))

(defmethod cffi:translate-from-foreign (p (type cv-size-type))
  (let ((plist (call-next-method)))
    (make-size :width (getf plist 'width)
               :height (getf plist 'height))))

and then define the function get-size directly with the defcfun.

The benefit of doing it this way is anytime you have a function that returns a cv-size, it will automatically get translated. And, if you have foreign functions to which you want to pass a cv-size, define the appropriate method for cffi:translate-into-foreign-memory. You will also get the translation automatically if you use mem-aref on a pointer to the structure. Or, if you call cffi:convert-from-foreign.

In this example, I have used the default plist translation method; you can if you wish directly access the slots without calling (call-next-method).

(BTW, the reason you were under the impression that CFFI could not pass structures by value was that it couldn't until recently; cffi-libffi was introduced with release 0.11.0.)

You just have to add :class xxx to cffi:defcstruct then (cffi:defmethod translate-into-foreign-memory (object (type xxx) pointer) yyyy), it will pass structure by value to a foreign function automatically!! Amazing!!

And (cffi:defmethod translate-from-foreign (pointer (type xxx)) zzzz) will convert the returned structure data into lisp data.

More information please check this answer also by me^_^

Лицензировано под: CC-BY-SA с атрибуция
Не связан с StackOverflow
scroll top