[cffi-devel] stdcall callbacks on ClozureCL/win32

[Greg Santucci]

On Sun, Jun 7, 2009 at 9:22 AM, Luís Oliveira <luismbo at gmail.com> wrote:

> On Sat, Jun 6, 2009 at 10:14 PM, Greg Santucci<thecodewitch at gmail.com>
> wrote:
> > The transcript is in the attached file "latest-cffi-test.txt".
>
> So it seems like CCL crashes in the CALLBACKS.QSORT test (in
> cffi/tests/callbacks.lisp) somewhere within the call to qsort(). I
> would guess there is some bug related to callbacks. Try this:
>
> (ccl:defcallback qsort-callback (:address a :address b :signed-int)
>  (let ((x (ccl:%get-signed-long a))
>        (y (ccl:%get-signed-long b)))
>    (cond ((> x y) 1)
>          ((< x y) -1)
>          (t 0))))
>
> (defun test-callbacks-with-qsort ()
>  (ccl:%stack-block ((array 40))
>    (loop for i from 0
>          and n in '(7 2 10 4 3 5 1 6 9 8)
>          do (setf (ccl:%get-signed-long array (* i 4)) n))
>    (ccl:external-call "qsort" :address array :signed-int 10 :signed-int 4
>                       :address qsort-callback :void)
>    (loop for i from 0 below 10
>          collect (ccl:%get-signed-long array (* i 4)))))


That seems to work!

The output is in the attached file,  good-cffi-results.txt

Does this mean cffi can be patched again?

Regards,
Greg
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cffi-devel/attachments/20090607/fe23ff80/attachment.html>
-------------- next part --------------

C:\lispbox\ccl>wx86cl.exe
Welcome to Clozure Common Lisp Version 1.3  (WindowsX8632)!
? (load "init.lisp")
#P"C:/lispbox/ccl/init.lisp"
? (asdf:oos 'asdf:load-op :cffi)
; loading system definition from C:/lispbox/packages/cffi/cffi.asd into #<Package "ASDF0">
; registering #<SYSTEM CFFI #x8A74B6E> as CFFI
; loading system definition from C:/lispbox/packages/babel/babel.asd into #<Package "ASDF0">
; registering #<SYSTEM BABEL #x8AA63BE> as BABEL
; loading system definition from C:/lispbox/packages/alexandria/alexandria.asd into #<Package "ASDF0">
; registering #<SYSTEM :ALEXANDRIA #x8ADC39E> as ALEXANDRIA
; loading system definition from C:/lispbox/packages/trivial-features/trivial-features.asd into #<Package "ASDF0">
; registering #<SYSTEM TRIVIAL-FEATURES #x8A97AE6> as TRIVIAL-FEATURES
NIL
? (asdf:oos 'asdf:load-op :cffi-tests)
; loading system definition from C:/lispbox/packages/cffi/cffi-tests.asd into #<Package "ASDF0">
; registering #<SYSTEM CFFI-TESTS #x8C447D6> as CFFI-TESTS
; loading system definition from C:/lispbox/packages/rt/rt.asd into #<Package "ASDF0">
; registering #<SYSTEM :RT #x8C74996> as RT
;Compiler warnings for "C:/lispbox/packages/cffi/tests/funcall.lisp" :
;   In (EXPAND-TO-FOREIGN (T CHECK-NIL-SKIP-TYPE)): Unused lexical variable VAL
; Warning: COMPILE-FILE warned while performing #<COMPILE-OP NIL #x8C128FE> on #<CL-SOURCE-FILE "funcall" #x8C0EEC6>.
; While executing: #<STANDARD-METHOD ASDF:PERFORM (ASDF:COMPILE-OP ASDF:CL-SOURCE-FILE)>, in process listener(1).
NIL
? (ccl:defcallback qsort-callback (:address a :address b :signed-int)
 (let ((x (ccl:%get-signed-long a))
       (y (ccl:%get-signed-long b)))
   (cond ((> x y) 1)
         ((< x y) -1)
         (t 0))))
QSORT-CALLBACK
? (defun test-callbacks-with-qsort ()
 (ccl:%stack-block ((array 40))
   (loop for i from 0
         and n in '(7 2 10 4 3 5 1 6 9 8)
         do (setf (ccl:%get-signed-long array (* i 4)) n))
   (ccl:external-call "qsort" :address array :signed-int 10 :signed-int 4
                      :address qsort-callback :void)
   (loop for i from 0 below 10
         collect (ccl:%get-signed-long array (* i 4)))))
TEST-CALLBACKS-WITH-QSORT
? (test-callbacks-with-qsort)
(1 2 3 4 5 6 7 8 9 10)
?