Wed Jul 14 22:46:00 BRT 2010 Gustavo Henrique Milare * Added support for argument direction for %defcfun. New patches: [Added support for argument direction for %defcfun. Gustavo Henrique Milare **20100715014600 Ignore-this: d2581a286cbf6a15bbb84283f662fb85 ] { hunk ./src/functions.lisp 43 ;;; TRANSLATE-OBJECTS as the CALL-FORM argument) instead of ;;; CFFI-SYS:%FOREIGN-FUNCALL to call the foreign-function. + +(defun parse-defcfun-args (args) + "Helper to deal with different direction arguments." + (let (in-args alloc-args copy-args trans-args caller-args) + (loop for (name type direction) in args + for alloc-sym = (gensym (symbol-name name)) + for trans-sym = (gensym (symbol-name name)) + do (ecase direction + ((:in nil) + ;; external lisp function receive value in NAME + (push (list name type) in-args) + ;; translate-objects translates NAME into TRANS-SYM + (push (list trans-sym name type) trans-args) + ;; internal C function receives TRANS-SYM as value + (push (list trans-sym type) caller-args)) + (:out + ;; with-foreign-objects allocates a pointer in ALLOC-SYM + (push (list alloc-sym type direction) alloc-args) + ;; internal C function receives the pointer ALLOC-SYM as value + (push (list alloc-sym :pointer) caller-args)) + ((:copy :in-out) + ;; external lisp function receive value in NAME + (push (list name type) in-args) + ;; allocating-pointers allocates a pointer in ALLOC-SYM + (push (list alloc-sym type direction) alloc-args) + ;; translate-objects translates NAME into TRANS-SYM + (push (list trans-sym name type) trans-args) + ;; binding ALLOC-SYM's value to TRANS-SYM + (push (list alloc-sym trans-sym type) copy-args) + ;; internal C function receives the pointer ALLOC-SYM as value + (push (list alloc-sym :pointer) caller-args)))) + (values (nreverse in-args) (nreverse alloc-args) (nreverse copy-args) + (nreverse trans-args) (nreverse caller-args)))) + +(defun allocating-pointers (args return-type form) + "Allocates pointers and returns :OUT and :IN-OUT pointers as values." + (let ((returned-values + (loop for (pointer type direction) in args + if (member direction '(:in-out :out)) + collect `(mem-ref ,pointer ,type)))) + `(with-foreign-objects + ,(loop for (pointer type direction) in args + collect `(,pointer ,type)) + ,(if (eq (parse-type return-type) (parse-type :void)) + `(progn ,form + (values ,@returned-values)) + `(values ,form + ,@returned-values))))) + +(defun copying-pointers (args form) + "Sets pointers to values (after translation and before the C function call)." + `(progn + ,@(loop for (pointer value type) in args + collect `(%mem-set ,value ,pointer ,type)) + ,form)) + (defun translate-objects (syms args types rettype call-form) "Helper function for FOREIGN-FUNCALL and DEFCFUN." (if (null args) hunk ./src/functions.lisp 238 ,@options))))) (defun %defcfun (lisp-name foreign-name return-type args options docstring) - (let ((arg-names (mapcar #'car args)) - (arg-types (mapcar #'cadr args)) - (syms (make-gensym-list (length args)))) - (multiple-value-bind (prelude caller) - (defcfun-helper-forms - foreign-name lisp-name (canonicalize-foreign-type return-type) - syms (mapcar #'canonicalize-foreign-type arg-types) options) - `(progn - ,prelude - (defun ,lisp-name ,arg-names - ,@(ensure-list docstring) - ,(translate-objects - syms arg-names arg-types return-type caller)))))) + (multiple-value-bind (in-args alloc-args copy-args trans-args caller-args) + (parse-defcfun-args args) + (let ((in-arg-names (mapcar #'car in-args)) + (caller-syms (mapcar #'car caller-args)) + (caller-types (mapcar #'cadr caller-args)) + (trans-syms (mapcar #'car trans-args)) + (trans-names (mapcar #'cadr trans-args)) + (trans-types (mapcar #'caddr trans-args))) + (multiple-value-bind (prelude caller) + (defcfun-helper-forms + foreign-name lisp-name (canonicalize-foreign-type return-type) + caller-syms (mapcar #'canonicalize-foreign-type caller-types) + options) + `(progn + ,prelude + (defun ,lisp-name ,in-arg-names + ,@(ensure-list docstring) + ,(allocating-pointers + alloc-args return-type + (translate-objects + trans-syms trans-names trans-types return-type + (copying-pointers copy-args caller))))))))) (defun %defcfun-varargs (lisp-name foreign-name return-type args options doc) (with-unique-names (varargs) hunk ./tests/defcfun.lisp 410 finally (return (stdcall-fun 1 2 3))) 6)) +(defcfun "sum_out" :void + (dest :int :out) + (a :int :in) + (b :int :in)) + +(deftest defcfun.directions.sum-out + (sum-out 4 7) + 11) + +(defcfun "sum_and_sub_out" :void + (sum :int :out) + (sub :int :out) + (a :int :in) + (b :int :in)) + +(deftest defcfun.directions.sum-and-sub-out + (sum-and-sub-out 4 7) + 11 -3) + +(defcfun "read_next_char_out" :int + (dest :char :out) + (string ::string) + (start :int)) + +(deftest defcfun.directions.read-next-char-out + (read-next-char-out " a bc " 0) + 2 #.(char-code #\a)) + +(deftest defcfun.directions.read-next-char-out-2 + (read-next-char-out " a bc " 3) + 4 #.(char-code #\b)) + +(defcfun "sum_in_out" :void + (dest :int :in-out) + (a :int :in) + (b :int :in)) + +(deftest defcfun.directions.sum-in-out + (sum-in-out 2 4 7) + 13) + +(defcfun "sum_and_sub_in_out" :void + (sum :int :in-out) + (sub :int :in-out) + (a :int :in) + (b :int :in)) + +(deftest defcfun.directions.sum-and-sub-in-out + (sum-and-sub-in-out 2 3 4 7) + 13 0) + +(defcfun "hash_copy" :void + (value :int :in-out) + (hash1 :int :copy) + (hash2 :int :copy)) + +(deftest defcfun.directions.hash-copy + (hash-copy 97 5 3) + 488) + hunk ./tests/libtest.c 879 /* vim: ts=4 et */ +/* + * DEFCFUN.DIRECTIONS.SUM-OUT + */ + +DLLEXPORT +void sum_out(int *dest, int a, int b) +{ + *dest = a + b; +} + +/* + * DEFCFUN.DIRECTIONS.SUM-AND-SUB-OUT + */ + +DLLEXPORT +void sum_and_sub_out(int *sum, int *sub, int a, int b) +{ + *sum = a + b; + *sub = a - b; +} + +/* + * DEFCFUN.DIRECTIONS.READ-NEXT-CHAR-OUT + * DEFCFUN.DIRECTIONS.READ-NEXT-CHAR-OUT-2 + */ + +DLLEXPORT +int read_next_char_out(char *dest, char *string, int start) +{ + int i; + + for (i=start; string[i]==' '; i++); + + *dest = string[i]; + + return i; +} + +/* + * DEFCFUN.DIRECTIONS.SUM-IN-OUT + */ + +DLLEXPORT +void sum_in_out(int *dest, int a, int b) +{ + *dest = *dest + a + b; +} + +/* + * DEFCFUN.DIRECTIONS.SUM-AND-SUB-IN-OUT + */ + +DLLEXPORT +void sum_and_sub_in_out(int *sum, int *sub, int a, int b) +{ + *sum = *sum + a + b; + *sub = *sub + a - b; +} + +/* + * DEFCFUN.DIRECTIONS.HASH-CHAR-COPY + */ + +DLLEXPORT +void hash_copy(int *value, int *hash1, int *hash2) +{ + *value = (*value) * (*hash1) + (*hash2); +} + } Context: [cffi-ecl: always push no-long-long Luis Oliveira **20100428225604 Ignore-this: 784c1c4b1567455e551ceeee0381cee8 LONG-LONG is not supported by ECL's interpreter yet. ] [cffi-tests: don't use FOREIGN-FREE for malloc()ed memory Luis Oliveira **20100428225337 Ignore-this: 5c02fbd1880a2f69a7bb59f8bb22f66b Patch courtesy of Juan Jose Garcia-Ripoll. ] [New pointer-related tests Luis Oliveira **20100428224243 Ignore-this: 6a2f040e2212317b46441a48851d48ac Testing error situations for some pointer operations. ] [cffi-ecl: simplify shareable vector implementation Luis Oliveira **20100425231232 Ignore-this: 75b0d4bba44f7313d3a629184ee93d42 Patch courtesy of Juan Jose Garcia-Ripoll. ] [cffi-ecl: inline %mem-set and %mem-ref Luis Oliveira **20100425230219 Ignore-this: 121b7b707e867051fc5ef8b45a306234 Patch courtesy of Juan Jose Garcia-Ripoll. ] [cffi-ecl: use C-INLINE when producing compiled code Luis Oliveira **20100425225004 Ignore-this: 30c083fea4568be7c20f4f819d5a8ffa Using the ECL extension EXT:WITH-BACKEND, CFFI can produce code that works differently when using the interpreter than when using the lisp2C compiler. This leads to more efficient code. This change is backwards compatible. Patch courtesy of Juan Jose Garcia-Ripoll. ] [cffi-ecl: reexport NULL-POINTER-P from SI Luis Oliveira **20100425223914 Ignore-this: 7dd39ad27e6827545c1b16fc071fa4b5 Patch courtesy of Juan Jose Garcia-Ripoll. ] [cffi-ecl: use ECL's :long-long feature Luis Oliveira **20100425223748 Ignore-this: a58e16e0ef93b05576d05852f47fda6f Patch courtesy of Juan Jose Garcia-Ripoll. ] [Allegro: fix WITH-FOREIGN-POINTER Luis Oliveira **20100425122443 Ignore-this: 275a83ec9e6b161c046644ef2e4b79a5 - Fixes previous patch. - New test: WITH-FOREIGN-POINTER.CONSTANT-SIZE. ] [Allow the use of constants in WITH-FOREIGN-OBJECT for Allegro. Jianshi Huang **20100421091956 Ignore-this: 612e375c10cae6e070b94baddf231e0d ] [Remove unused C macro SIGNED_ from common.h Stelian Ionescu **20100219173353 Ignore-this: 127d3fac79151d22b23ce435cab3558 ] [cffi-manual: navigation improvements. Luis Oliveira **20100106232110 Ignore-this: 5944e0d6072d1357b41a42d2658708d4 - Add WITH-FOREIGN-OBJECTS and WITH-FOREIGN-STRINGS to the dictionary menus. (This unfortunately seems to require specifying the @node declarations in full.) - Make the table of contents more manageable by turning @unnumberedsecs into @headings. - Fix docstring in DEFSTRUCT example. ] [cffi-lispworks: add IGNORE declaration to CREATE-FOREIGN-FUNCALLABLE Luis Oliveira **20100101174635 Ignore-this: a6fbc492c01a1b45339b0fde226f6cb7 ] [cffi-lispworks: make null-pointer-p check its argument's type Luis Oliveira **20100101174529 Ignore-this: 5aa0ba3afae82dd729f849c03582ac6c ] [Documentation: add note about RT, update description of no-long-long. Luis Oliveira **20100101173443 Ignore-this: 97430803980a0492290dafbd29cb062f ] [Preliminary support for ABCL. Luis Oliveira **20100101172600 Ignore-this: 1b9e5eb2ba0718bff2756f1897ad08b3 ] [Update email address. Stelian Ionescu **20091211164938 Ignore-this: c8aab03fe8a070fc83fb39ab3fa3ad42 ] [Remove spurious PRINT call. Stelian Ionescu **20091211164909 Ignore-this: ea138b4aff965ed7547956a93c98bfac ] [cffi-manual: the :STRING type does not support ub8 arrays anymore Luis Oliveira **20091124232002 Ignore-this: 509d08ce9acceacbe694a678552746bc ] [libtest: support 64-bit on OSX Leopard Luis Oliveira **20091124231741 Ignore-this: d7997fa0aca44a1f0351bdde32ea91f8 ] [cffi-tests: show Lispworks the full path to libm.dylib Luis Oliveira **20091124231442 Ignore-this: ccf9bfdc692e726f7760b1dd0ecfb985 ] [cffi-lispworks: turns out Lispworks does support llong on 32-bit platforms Luis Oliveira **20091124231321 Ignore-this: 8e131fb8e20f9d1448dd740d336ec1b4 ] [Deprecate groveler clause FLAG in favour of CC-FLAGS. Stelian Ionescu **20090823121108 Ignore-this: e1537717a9e7356b208d5cd14b34ba50 ] [cffi-allegro: define long long types on 64-bit platforms Luis Oliveira **20090821210052 Patch courtesy of John Fremlin. ] [cffi-tests: fix pointer-to-integer casts in libtest.c Luis Oliveira **20090821205447] [cffi-tests: don't use stdcall #ifndef WIN32 Luis Oliveira **20090821205144] [Also canonicalize search paths in library specs. Stelian Ionescu **20090809005356 Ignore-this: 86a039c7ebbc757c9934fe99368ae0bb ] [Update manual. Stelian Ionescu **20090808222834 Ignore-this: 15e832e5220a6ca70722730d81edf283 DEFCFUN & co. now take only :CONVENTION. ] [Whitespace. Stelian Ionescu **20090808221547 Ignore-this: 18d99969b97b190176e88d9eb24a94ce ] [Declare DEFCALLBACK, DEFCFUN and DEFINE-FOREIGN-LIBRARY's keyword args :CCONV and :CALLING-CONVENTION obsolete, use :CONVENTION instead. Stelian Ionescu **20090808221055 Ignore-this: 9e90dfde20f4a4dfd764c5250d8b2ea6 ] [Fix docstring of LIST-FOREIGN-LIBRARIES. Stelian Ionescu **20090807164116 Ignore-this: 5c65a2d7608718e9bc0560e780855bf1 ] [Fix reloading a library in LOAD-FOREIGN-LIBRARY. Stelian Ionescu **20090807162733 Ignore-this: 267edf226a87d24d0441bf85515cc437 ] [Use type :wrapper for wrapper libraries generated by the groveler. Stelian Ionescu **20090804204132 Ignore-this: d61f9a69cfb323905d8abbb40bf84be9 ] [Use type :test for the test libraries. Stelian Ionescu **20090720154312 Ignore-this: 6dad3c93d47cd22e27c73c6ba7f2e8d1 ] [Add the ability to specify a foreign library's type and search path. Stelian Ionescu **20090720154028 Ignore-this: 7de87b54da57c74f9a7c994d6255df84 Also export: - FOREIGN-LIBRARY - FOREIGN-LIBRARY-PATHNAME - FOREIGN-LIBRARY-TYPE - FOREIGN-LIBRARY-LOADED-P - LIST-FOREIGN-LIBRARIES ] [Cosmetic changes (cconv -> calling-convention). Stelian Ionescu **20090720153925 Ignore-this: 38bc21d362c69fbf2dc10d268615b4fb ] [Groveler fixes for ECL. Stelian Ionescu **20090804193738 Ignore-this: b834b25942f10bf4a42fdc3e9d0a2a0e ] [ECL: support more vector types in CFFI-SYS:WITH-POINTER-TO-VECTOR-DATA Luis Oliveira **20090725231330 Patch courtesy of Andy Hefner. ] [cffi-openmcl: prepend _ to external names on #+darwin, not just #+darwinppc Luis Oliveira **20090710180832] [grovel: don't use cffi-features. Luis Oliveira **20090702201557] [clisp: small fix to %FOREIGN-ALLOC Luis Oliveira **20090701185918 - Deal with (%foreign-alloc 0) gracefully by turning it into a one byte allocation. This is similar to what glibc's malloc() does, IIUC. - Regression test: FOREIGN-ALLOC.6. Reported by Tobias Rautenkranz. ] [Don't trim #\VT. Stelian Ionescu **20090625164315 Ignore-this: d8d498764120b505ef429533a31e7ad4 ] [Groveler: trim-whitespace not strip-whitespace. Stelian Ionescu **20090622215252 Ignore-this: 4cf64b68c733985620a54547172f0acc ] [Groveler: fix typo. Stelian Ionescu **20090622213353 Ignore-this: 6611cf5e23cf79f39487005c3cd54cea ] [Groveler: small refactoring, create *EXE-EXTENSION* Stelian Ionescu **20090622212626 Ignore-this: e05a49eac29b50b75d739d7a8a4d5376 ] [Groveler: move boilerplate C code to common.h Stelian Ionescu **20090622211857 Ignore-this: eb1d4dfe79eda50736030b8a58245fa ] [Groveller: fix usage of *CC-FLAGS*. Stelian Ionescu **20090622205142 Ignore-this: 8ec1dee6e977bb621978a140d00d4df6 ] [Include with the groveler boilerplate code. Stelian Ionescu **20090622201324 Ignore-this: a61b2c378174118bda30f34881fd0d16 ] [Move the DEFPACKAGE and INVOKE out of grovel.lisp Stelian Ionescu **20090622200317 Ignore-this: 684f7b807e38f1562c83987999f5f2f6 ] [Style change. Stelian Ionescu **20090622194557 Ignore-this: d5fec823114054a26e5d3f868a51e61d ] [Groveler: use WITH-STANDARD-IO-SYNTAX when processing grovel files. Stelian Ionescu **20090622190429 Ignore-this: b2de6817830cfa76780382f6f58b04ee ] [Groveler: implement %INVOKE for ABCL. Stelian Ionescu **20090622190326 Ignore-this: 1131c355c7fbef55c972c5444bed2bf7 ] [TAG 0.10.5 Luis Oliveira **20090616162007 Ignore-this: f21c050e8ca02edcf2e2bac58555deb9 ] Patch bundle hash: 44e6ce753ade7963ca5d959c3571375ce2e0cd8b