From 1b3caecb5cce215e87a89f440c0db752f850c36d Mon Sep 17 00:00:00 2001 From: tony Date: Mon, 2 Jun 2008 08:39:35 +0200 Subject: [PATCH] Update local CFFI to darcs from 1.6.08 --- external/cffi.darcs/TODO | 17 +- external/cffi.darcs/_darcs/inventory | 240 ++++++- external/cffi.darcs/_darcs/pristine/TODO | 17 +- external/cffi.darcs/_darcs/pristine/cffi-tests.asd | 1 + external/cffi.darcs/_darcs/pristine/cffi.asd | 1 + .../_darcs/pristine/doc/cffi-manual.texinfo | 750 +++++++++++++++------ .../_darcs/pristine/examples/examples.lisp | 2 +- .../_darcs/pristine/examples/gethostname.lisp | 2 +- .../_darcs/pristine/src/cffi-allegro.lisp | 21 +- .../cffi.darcs/_darcs/pristine/src/cffi-clisp.lisp | 25 +- .../cffi.darcs/_darcs/pristine/src/cffi-cmucl.lisp | 18 +- .../_darcs/pristine/src/cffi-corman.lisp | 17 +- .../cffi.darcs/_darcs/pristine/src/cffi-ecl.lisp | 22 +- .../cffi.darcs/_darcs/pristine/src/cffi-gcl.lisp | 2 +- .../_darcs/pristine/src/cffi-lispworks.lisp | 63 +- .../_darcs/pristine/src/cffi-openmcl.lisp | 17 +- .../cffi.darcs/_darcs/pristine/src/cffi-sbcl.lisp | 21 +- .../cffi.darcs/_darcs/pristine/src/cffi-scl.lisp | 21 +- .../cffi.darcs/_darcs/pristine/src/features.lisp | 21 +- .../cffi.darcs/_darcs/pristine/src/functions.lisp | 5 +- .../cffi.darcs/_darcs/pristine/src/libraries.lisp | 17 +- .../cffi.darcs/_darcs/pristine/src/package.lisp | 4 +- .../cffi.darcs/_darcs/pristine/src/strings.lisp | 281 ++++++-- external/cffi.darcs/_darcs/pristine/src/types.lisp | 148 +++- external/cffi.darcs/_darcs/pristine/src/utils.lisp | 81 +-- .../cffi.darcs/_darcs/pristine/tests/defcfun.lisp | 8 +- .../_darcs/pristine/tests/foreign-globals.lisp | 48 +- .../cffi.darcs/_darcs/pristine/tests/memory.lisp | 60 +- .../_darcs/pristine/tests/misc-types.lisp | 12 +- .../cffi.darcs/_darcs/pristine/tests/struct.lisp | 104 +-- .../_darcs/pristine/uffi-compat/uffi-compat.lisp | 11 +- external/cffi.darcs/cffi-tests.asd | 1 + external/cffi.darcs/cffi.asd | 1 + external/cffi.darcs/doc/cffi-manual.texinfo | 750 +++++++++++++++------ external/cffi.darcs/examples/examples.lisp | 2 +- external/cffi.darcs/examples/gethostname.lisp | 2 +- external/cffi.darcs/src/cffi-allegro.lisp | 21 +- external/cffi.darcs/src/cffi-clisp.lisp | 25 +- external/cffi.darcs/src/cffi-cmucl.lisp | 18 +- external/cffi.darcs/src/cffi-corman.lisp | 17 +- external/cffi.darcs/src/cffi-ecl.lisp | 22 +- external/cffi.darcs/src/cffi-gcl.lisp | 2 +- external/cffi.darcs/src/cffi-lispworks.lisp | 63 +- external/cffi.darcs/src/cffi-openmcl.lisp | 17 +- external/cffi.darcs/src/cffi-sbcl.lisp | 21 +- external/cffi.darcs/src/cffi-scl.lisp | 21 +- external/cffi.darcs/src/features.lisp | 21 +- external/cffi.darcs/src/functions.lisp | 5 +- external/cffi.darcs/src/libraries.lisp | 17 +- external/cffi.darcs/src/package.lisp | 4 +- external/cffi.darcs/src/strings.lisp | 281 ++++++-- external/cffi.darcs/src/types.lisp | 148 +++- external/cffi.darcs/src/utils.lisp | 81 +-- external/cffi.darcs/tests/defcfun.lisp | 8 +- external/cffi.darcs/tests/foreign-globals.lisp | 48 +- external/cffi.darcs/tests/memory.lisp | 60 +- external/cffi.darcs/tests/misc-types.lisp | 12 +- external/cffi.darcs/tests/struct.lisp | 104 +-- external/cffi.darcs/uffi-compat/uffi-compat.lisp | 11 +- 59 files changed, 2485 insertions(+), 1355 deletions(-) diff --git a/external/cffi.darcs/TODO b/external/cffi.darcs/TODO index 0ad65c2..d64ad09 100644 --- a/external/cffi.darcs/TODO +++ b/external/cffi.darcs/TODO @@ -23,11 +23,7 @@ This is a collection of TODO items and ideas in no particular order. -> Implement a declarative interface for FOREIGN-FUNCALL-PTR, similar to DEFCUN/FOREIGN-FUNCALL. --> Figure out how to portably define types like: time_t, size_t, wchar_t, - etc... Likely to involve something like SB-GROVEL and possibly avoiding - this step on known platforms? -> Implement the proposed interfaces (see doc/). --> Implement CFFI-SYS:ERRNO-VALUE (name?). -> Extend FOREIGN-SLOT-VALUE and make it accept multiple "indices" for directly accessing structs inside structs, arrays inside structs, etc... -> Implement EXPLAIN-FOREIGN-SLOT-VALUE. @@ -40,12 +36,6 @@ This is a collection of TODO items and ideas in no particular order. -> Implement byte swapping routines (see /usr/include/linux/byteorder) -> [Lost Idea] Implement UB8-REF? -> [Lost Idea] Something about MEM-READ-C-STRING returning multiple value? --> Implement an array type? Useful when we're working with ranks >= 2? --> External encodings for the :STRING type. See: - --> Define a lisp type for pointers in the backends. Eg: for clisp: - (deftype pointer-type (or ffi:foreign-address null)) - Useful for type declarations. -> Warn about :void in places where it doesn't make sense. ### Underspecified Semantics @@ -63,7 +53,6 @@ This is a collection of TODO items and ideas in no particular order. and a lisp double to :float. We should either coerce on lisps that don't accept this or check-type on lisps that do. Probably the former is better since on lispworks/x86 double == float. --> What happens when the same library is loaded twice. ### Possible Optimizations @@ -92,8 +81,6 @@ This is a collection of TODO items and ideas in no particular order. used in many places throughout the code is apparently not 100% safe. -> On ECL platforms without DFFI we need to build a non-linked version of libtest. --> LOAD-FOREIGN-LIBRARY should give better errors. On ECL with DFFI - it should show the error that %LOAD-FOREIGN-LIBRARY is signalling. -> foreign-enum-keyword/value should have their own error condition? [2007-02-22 LO] @@ -103,6 +90,10 @@ This is a collection of TODO items and ideas in no particular order. -> Update the CFFI-SYS Specification. -> have two versions of the manual on the website +### CFFI-Grovel + +-> Look into making the C output more concise. + ### Other -> Type-checking pointer interface. diff --git a/external/cffi.darcs/_darcs/inventory b/external/cffi.darcs/_darcs/inventory index 42231d2..984e723 100644 --- a/external/cffi.darcs/_darcs/inventory +++ b/external/cffi.darcs/_darcs/inventory @@ -308,4 +308,242 @@ Luis Oliveira **20080406233331] [Define FOREIGN-LIBRARY class before it's used... Luis Oliveira **20080406233631] [cffi-tests: Lispworks needs to have libm.so loaded -Luis Oliveira **20080407111146] \ No newline at end of file +Luis Oliveira **20080407111146] +[TAG before cffi+lotsastuff merge +Luis Oliveira **20080531141112] +[Integrate cffi-grovel +Luis Oliveira **20070617231923 + + Added a groveller based on Dan Knap's and Matthew Backes's cffi-grovel + and Stelian Ionescu's fork iolib-grovel. cffi-grovel is inspired by + SBCL's groveller. This is a preliminary version. + + Includes a new wrapper generator syntax to simplify the writing of + C glue libraries among other minor features. + + - Updated TODO items related to grovelling. + - Integrated documentation into the CFFI manual. + - src/libraries: use ".so" as the default library suffix. +] +[manual: Use @deffn instead of @itemize for grovel forms. +Luis Oliveira **20070618082056] +[Encoding support using Babel +Luis Oliveira **20070608022612 + + - Preliminary (likely buggy) version. Includes documentation and tests. + - New cffi-features: big-endian and little-endian determined with CFFI + code. + - Needs cleaning up. +] +[add :null-teminated-p keyword param to foreign-string-alloc +tomi.borbely@gmail.com**20070625144637] +[Added :byte-size-variable keyword arg to with-foreign-string +attila.lendvai@gmail.com**20070625145836] +[Added remove-from-plist into cffi-utils, copied from alexandria +attila.lendvai@gmail.com**20070625145923] +[Use the foreign-pointer type in strings.lisp +Luis Oliveira **20070628154056] +[WITH-FOREIGN-STRING changes +Luis Oliveira **20070629204256 + + - WITH-FOREIGN-STRING's new syntax: + with-foreign-string (binding &rest args) &body + binding := { var | (var &optional byte-size-var) } + - Update the documentation, not complete. + - New test: STRING.CONVERSION.BASIC.2 +] +[cffi-manual: small change to the grovel example +Luis Oliveira **20070629205005] +[cffi-grovel: slightly better handling of packages +Luis Oliveira **20070629205115 + + - in-package now has a read time effect on *package* which will determine + to which package various symbols (such as type names) will belong to. +] +[Don't autoexport grovel definitions. +Luis Oliveira **20070706003642] +[cffi-grovel: defwrapper: handle foreign/lisp names +Luis Oliveira **20070706003836] +[with-foreign-pointer-as-string: take additional arguments +Luis Oliveira **20070706130018 + + Changed to match the new WITH-FOREIGN-STRING syntax. Document later. +] +[Foreign string changes +Luis Oliveira **20070708034538 + + - LISP-STRING-TO-FOREIGN takes new arguments START, END and OFFSET. Also, + instead of bailing out when STRING needs more octets than BUFSIZE, it + fills in as much as possible. + - test STRING.SHORT-WRITE.1 now passes. + - FOREIGN-STRING-TO-LISP takes new argument MAX-CHARS. +] +[Fix "endianness" typo +Luis Oliveira **20070708035010] +[Remove outdated comments re test string.short-write.1 +Luis Oliveira **20070709190222] +[Bug fixes +Luis Oliveira **20070717031151 + + - Fix :LICENSE -> :LICENCE in cffi-grovel.asd + - grovel.lisp fixes: + * fix OpenMCL's INVOKE + * have INVOKE call NATIVE-NAMESTRING + * add IGNORABLE declaration to DEFINE-GROVEL-SYNTAX + - CMUCL's EXT:UNIX-NAMESTRING is buggy, don't use it. + - strings.lisp: pass missing max-octets argument to OCTET-COUNTER + in FOREIGN-STRING-ALLOC. +] +[Update strings.lisp to match Babel's accessor changes. +Luis Oliveira **20070717031627] +[FOREIGN-STRING-TO-LISP: return number of octets read +Luis Oliveira **20070717033110 + + - Update test suite to reflect this change. +] +[Use trivial-features. +Luis Oliveira **20070719182016 + + Not sure if this is a great idea yet. In any case, CFFI-FEATURES is + still there for backwards compatibility for the time being. +] +[New feature: emulated long-long types +Luis Oliveira **20070719182557 + + (initial suggestion and patch courtesy of Stelian Ionescu) + + - Update test suite to reflect this. + - Tested on Allegro and Lispworks. Should work for ECL as well. +] +[Remove outdated TODO items +Luis Oliveira **20070720020208] +[Minor change to src/types.lisp +Luis Oliveira **20070720020227] +[cffi-grovel: x86-64 compat changes +Luis Oliveira **20070726183645 + + - use :long instead of :int to try and determine word size. + - use -fPIC for 64-bit shared libraries. +] +[grovel: use :[u]int64 without worries +Luis Oliveira **20070726195250 + + No need to check for cffi-features:no-long-long now that we have + emulated long long type. +] +[Adjustments for using cffi-grovel on windows. +Luis Oliveira **20070729012113] +[grovel: constantenum: signal warnings properly +Luis Oliveira **20070729012200] +[grovel: fix invoke-cc's conditional library arguments +Luis Oliveira **20070729044812] +[Cleaned up compiler invokation by the groveller. +Stelian Ionescu **20070729193633] +[grovel: fix conflict and indentation +Luis Oliveira **20070729195747] +[New macro: DEFINE-C-STRUCT-WRAPPER +Luis Oliveira **20070730022329 + + With tests STRUCT-WRAPPER.[12] +] +[grovel: fix symbol names in in-package forms +Luis Oliveira **20070730040942] +[grovel: update comment regarding cstruct-and-class +Luis Oliveira **20070730205330] +[Add new types :intptr and :uintptr +Luis Oliveira **20070730231111] +[grovel: fix FORM-KIND +Luis Oliveira **20070801143432] +[Fix use of PROGN form by the groveller. +Stelian Ionescu **20070801144656] +[grovel: ugh, fix wording in form-kind comment +Luis Oliveira **20070801145618] +[grovel: fix invoke on clisp/win32 +Luis Oliveira **20070803202545] +[grovel: fix handling of alternatives in constantenum +Luis Oliveira **20070803202607] +[grovel: fix defwrapper handling of types in #'cffi-type +Luis Oliveira **20070806014001] +[Fix WITH-FOREIGN-POINTER-AS-STRING return values +Luis Oliveira **20070806014305 + + - Don't return second value of FOREIGN-STRING-TO-LISP. +] +[Don't use aggresive compilation declarations in BABEL-ENCODINGS:I-C-M. +Luis Oliveira **20070813194957] +[Add missing :after qualifier in DEFINE-C-STRUCT-WRAPPER. +Luis Oliveira **20070813201639] +[Update tests to reflect changes in WITH-FOREIGN-POINTER-AS-STRING +Luis Oliveira **20070813230427] +[Fix strings.lisp +Luis Oliveira **20070813230454 + + - Work around apparent SBCL bug. + - Handle :RE endianness in BGET and BSET. +] +[grovel: fix Lispworks's %INVOKE +Luis Oliveira **20070823032714] +[Fix WITH-FOREIGN-POINTER-AS-STRING usage in examples. +Luis Oliveira **20071208222510] +[Fix WITH-FOREIGN-POINTER-AS-STRING usage in examples. (again) +Luis Oliveira **20071208222804] +[Unicode string update +Luis Oliveira **20071210102001 + + - Remove outdated comments. + - Use BABEL:SIMPLE-UNICODE-STRING type. + - Document *DEFAULT-FOREIGN-ENCODINGS*. + - Add :FREE-FROM-FOREIGN and :FREE-TO-FOREIGN boolean + parameters to the :STRING type. +] +[Make sure that the groveller can handle nested PROGN forms. +Stelian Ionescu **20071221204127] +[Simplify :[u]intptr definitons. +Luis Oliveira **20080225231321 + + - This patch makes CMUCL happier. +] +[uffi-compat: fix bitrot in CONVERT-FROM-FOREIGN-STRING +Luis Oliveira **20080316132603 + + Reported by Christophe Rhodes. Passes all of uffi-tests again. +] +[Mark DEFCFUN.VARARGS.DOCSTRING as an expected failure on CLISP +Luis Oliveira **20080405205812] +[cffi-lispworks: add long-long support on 64-bit platforms +Luis Oliveira **20080407105414 + + Initial patch and testing courtesy of Tian Chun. +] +[Groveler: small fix for ECL. +Stelian Ionescu **20080208224019] +[Add groveler directive for inline C code, as for the wrapper. +Stelian Ionescu **20080405231846] +[Add dependency on ALEXANDRIA, remove redundant code from CFFI-UTILS package. +Stelian Ionescu **20071230233920] +[Fix conflict in cffi-openmcl.lisp +Luis Oliveira **20080531141647] +[Minor fixes to cffi-manual.texinfo +Luis Oliveira **20080531163724 + + Restores buildability. Courtesy of Rupert Swarbrick. +] +[added support for :cc-flags for grovel-file to specify additional flags to the compiler (like -I /foo/bar) +attila.lendvai@gmail.com**20080517190231] +[minor change to foreign-string-to-lisp +Luis Oliveira **20080601045624 + + Make max-chars default to (1- array-total-size-limit). +] +[Update manual +Luis Oliveira **20080601051732 + + - Fix @result{} in the HTML output. + - Revamp the "Implementation support" chapter. + - Fix misc documentation rot. + - Delete empty sections. + - Document the emulation of long-long types. + - Remove UTF-8 characters since texinfo has not entered + the 21st century yet. + - Finish the documentation for the new encoding support. +] \ No newline at end of file diff --git a/external/cffi.darcs/_darcs/pristine/TODO b/external/cffi.darcs/_darcs/pristine/TODO index 0ad65c2..d64ad09 100644 --- a/external/cffi.darcs/_darcs/pristine/TODO +++ b/external/cffi.darcs/_darcs/pristine/TODO @@ -23,11 +23,7 @@ This is a collection of TODO items and ideas in no particular order. -> Implement a declarative interface for FOREIGN-FUNCALL-PTR, similar to DEFCUN/FOREIGN-FUNCALL. --> Figure out how to portably define types like: time_t, size_t, wchar_t, - etc... Likely to involve something like SB-GROVEL and possibly avoiding - this step on known platforms? -> Implement the proposed interfaces (see doc/). --> Implement CFFI-SYS:ERRNO-VALUE (name?). -> Extend FOREIGN-SLOT-VALUE and make it accept multiple "indices" for directly accessing structs inside structs, arrays inside structs, etc... -> Implement EXPLAIN-FOREIGN-SLOT-VALUE. @@ -40,12 +36,6 @@ This is a collection of TODO items and ideas in no particular order. -> Implement byte swapping routines (see /usr/include/linux/byteorder) -> [Lost Idea] Implement UB8-REF? -> [Lost Idea] Something about MEM-READ-C-STRING returning multiple value? --> Implement an array type? Useful when we're working with ranks >= 2? --> External encodings for the :STRING type. See: - --> Define a lisp type for pointers in the backends. Eg: for clisp: - (deftype pointer-type (or ffi:foreign-address null)) - Useful for type declarations. -> Warn about :void in places where it doesn't make sense. ### Underspecified Semantics @@ -63,7 +53,6 @@ This is a collection of TODO items and ideas in no particular order. and a lisp double to :float. We should either coerce on lisps that don't accept this or check-type on lisps that do. Probably the former is better since on lispworks/x86 double == float. --> What happens when the same library is loaded twice. ### Possible Optimizations @@ -92,8 +81,6 @@ This is a collection of TODO items and ideas in no particular order. used in many places throughout the code is apparently not 100% safe. -> On ECL platforms without DFFI we need to build a non-linked version of libtest. --> LOAD-FOREIGN-LIBRARY should give better errors. On ECL with DFFI - it should show the error that %LOAD-FOREIGN-LIBRARY is signalling. -> foreign-enum-keyword/value should have their own error condition? [2007-02-22 LO] @@ -103,6 +90,10 @@ This is a collection of TODO items and ideas in no particular order. -> Update the CFFI-SYS Specification. -> have two versions of the manual on the website +### CFFI-Grovel + +-> Look into making the C output more concise. + ### Other -> Type-checking pointer interface. diff --git a/external/cffi.darcs/_darcs/pristine/cffi-tests.asd b/external/cffi.darcs/_darcs/pristine/cffi-tests.asd index be0d0d9..d885e26 100644 --- a/external/cffi.darcs/_darcs/pristine/cffi-tests.asd +++ b/external/cffi.darcs/_darcs/pristine/cffi-tests.asd @@ -67,6 +67,7 @@ (:file "callbacks") (:file "foreign-globals") (:file "memory") + (:file "strings") (:file "struct") (:file "union") (:file "enum") diff --git a/external/cffi.darcs/_darcs/pristine/cffi.asd b/external/cffi.darcs/_darcs/pristine/cffi.asd index 280bd0e..1f00797 100644 --- a/external/cffi.darcs/_darcs/pristine/cffi.asd +++ b/external/cffi.darcs/_darcs/pristine/cffi.asd @@ -37,6 +37,7 @@ :author "James Bielman " :version "0.9.2" :licence "MIT" + :depends-on (alexandria trivial-features babel) :components ((:module src :serial t diff --git a/external/cffi.darcs/_darcs/pristine/doc/cffi-manual.texinfo b/external/cffi.darcs/_darcs/pristine/doc/cffi-manual.texinfo index 9a02d0e..de3199a 100644 --- a/external/cffi.darcs/_darcs/pristine/doc/cffi-manual.texinfo +++ b/external/cffi.darcs/_darcs/pristine/doc/cffi-manual.texinfo @@ -6,14 +6,12 @@ @c @documentencoding utf-8 -@ignore -Style notes: - -* The reference section names and "See Also" list are roman, not - @code. This is to follow the format of CLHS. - -* How it looks in HTML is the priority. -@end ignore +@c Style notes: +@c +@c * The reference section names and "See Also" list are roman, not +@c @code. This is to follow the format of CLHS. +@c +@c * How it looks in HTML is the priority. @c ============================= Macros ============================= @c The following macros are used throughout this manual. @@ -85,6 +83,27 @@ Style notes: @alias lispcmt = asis @end ifclear +@c My copy of makeinfo is not generating any HTML for @result{} for +@c some odd reason. (It certainly used to...) +@ifhtml +@macro result +=> +@end macro +@end ifhtml + +@c Similar macro to @result. Its purpose is to work around the fact +@c that ⇒ does not work properly inside @lisp. +@ifhtml +@macro res +@html +⇒ +@end html +@end macro +@end ifhtml + +@ifnothtml +@alias res = result +@end ifnothtml @c ============================= Macros ============================= @@ -152,6 +171,7 @@ software or the use or other dealings in the software.} * Functions:: * Libraries:: * Callbacks:: +* The Groveller:: * Limitations:: * Platform-specific features:: Details about the underlying system. * Glossary:: List of CFFI-specific terms and meanings. @@ -183,11 +203,12 @@ Foreign Types * foreign-type-alignment:: Returns the alignment of a foreign type. * foreign-type-size:: Returns the size of a foreign type. * free-converted-object:: Outside interface to typed object deallocators. -* free-translated-object:: Free a type translated foreign object. -* translate-from-foreign:: Translate a foreign object to a Lisp object. -* translate-to-foreign:: Translate a Lisp object to a foreign object. +* free-translated-object:: Defines how to free a oreign object. +* translate-from-foreign:: Defines a foreign-to-Lisp object translation. +* translate-to-foreign:: Defines a Lisp-to-foreign object translation. * with-foreign-object:: Allocates a foreign object with dynamic extent. -* with-foreign-slots:: Access the slots of a foreign structure. +@c * with-foreign-objects:: Plural form of @code{with-foreign-object}. +* with-foreign-slots:: Accesses the slots of a foreign structure. Pointers @@ -208,11 +229,13 @@ Pointers Strings +* *default-foreign-encoding*:: Default encoding for the string types. * foreign-string-alloc:: Converts a Lisp string to a foreign string. * foreign-string-free:: Deallocates memory used by a foreign string. * foreign-string-to-lisp:: Converts a foreign string to a Lisp string. * lisp-string-to-foreign:: Copies a Lisp string into a foreign string. * with-foreign-string:: Allocates a foreign string with dynamic extent. +@c * with-foreign-strings:: Plural form of @code{with-foreign-string}. * with-foreign-pointer-as-string:: Similar to CL's with-output-to-string. Variables @@ -306,120 +329,76 @@ for performance, use a compiler-macro instead. @cffi{} supports various free and commercial Lisp implementations: Allegro CL, Corman CL, @sc{clisp}, @acronym{CMUCL}, @acronym{ECL}, -LispWorks, Open@acronym{MCL}, @acronym{SBCL} and the Scieneer CL. - -There are also plans to support Digitool @acronym{MCL}, and @acronym{GCL}. - +LispWorks, Clozure CL, @acronym{SBCL} and the Scieneer CL. -@section Allegro CL +In general, you should work with the latest versions of each +implementation since those will usually be tested against recent +versions of CFFI more often and might include necessary features or +bug fixes. Reasonable patches for compatibility with earlier versions +are welcome nevertheless. -@strong{Tested platforms:} linux/x86, linux/ppc, win32/x86, darwin/ppc. +@section Limitations -Version 7.0 is supported. The 8.0 beta is also known to work. Earlier -versions are untested and unsupported but patches to support them -are welcome. +Some features are not supported in all implementations. +@c TODO: describe these features here. +@c flat-namespace too -@subheading Limitations +@subheading Allegro CL @itemize @item -Does not support the @code{:long-long} type. +Does not support the @code{:long-long} type natively. +@item +Unicode support is limited to the Basic Multilingual Plane (16-bit +code points). @end itemize -@section Corman CL - -@strong{Tested platforms:} win32/x86. +@section CMUCL -Versions prior to 2.51 are untested and unsupported. Also, you will -need to avoid Corman's buggy @code{COMPILE-FILE} and fasl -loader. Please follow @uref{http://www.weitz.de/corman-asdf/, these -instructions} by Edi Weitz to setup ASDF for Corman CL in a way that -works around these issues. +@itemize +@item +No Unicode support. (8-bit code points) +@end itemize -@subheading Limitations +@subheading Corman CL @itemize @item Does not support @code{foreign-funcall}. @end itemize +@subheading @acronym{ECL} -@section @sc{clisp} - -@strong{Tested platforms:} linux/x86, linux/ppc, win32/x86, darwin/ppc. - -Version is 2.34 or newer is required on win32/x86. For other platforms -version 2.35 or newer is required. - - -@section @acronym{CMUCL} - -@strong{Tested platforms:} linux/x86, darwin/ppc. - -Versions prior to 19B are untested. For darwin/ppc, the 2006-02 (19C) -snapshot or later is recommended. - - -@section @acronym{ECL} - -@strong{Tested platforms:} @emph{needs testing...} - -As of November 2005, the CVS version of ECL is required. It is -reported to pass all tests. - -@subheading Limitations @itemize @item -Does not support the @code{:long-long} type. - -@item On platforms where ECL's dynamic FFI is not supported (ie. when @code{:dffi} is not present in @code{*features*}), @code{cffi:load-foreign-library} does not work and you must use ECL's own @code{ffi:load-foreign-library} with a constant string argument. +@item +Does not support the @code{:long-long} type natively. +@item +Unicode support is not enabled by default. @end itemize +@subheading Lispworks -@section Lispworks - -@strong{Tested platforms:} linux/x86, win32/x86, darwin/ppc. - -Versions prior to 4.4 are untested. - -@subheading Limitations @itemize @item -Does not support the @code{:long-long} type. +Does not support the @code{:long-long} type natively, except in 64-bit +platforms. +@item +Unicode support is limited to the Basic Multilingual Plane (16-bit +code points). @end itemize - -@section Open@acronym{MCL} - -@strong{Tested platforms:} darwin/ppc, linux/ppc. - -Open@acronym{MCL} 1.0 or newer is recommended. - - -@section @acronym{SBCL} - -@strong{Tested platforms:} linux/x86, linux/ppc, darwin/ppc. - -Version 0.9.6 or newer is recommended. - -@subheading Limitations +@subheading @acronym{SBCL} @itemize @item Not all platforms support callbacks. -@end itemize - - -@section Scieneer CL -@strong{Tested platforms:} linux/x86, linux/amd64. - -Version 1.2.10 or newer is recommended. Passes all tests. -The x86 and AMD64 ports feature long-double support. +@end itemize @c =================================================================== @@ -667,10 +646,10 @@ Let's pick this apart into appropriate Lisp code: (flags :long)) @end lisp -@impnote{CFFI currently assumes the UNIX viewpoint that there is one C -symbol namespace, containing all symbols in all loaded objects. This -is not so on Windows and Darwin. The interface may be changed to deal -with this.} +@impnote{By default, CFFI assumes the UNIX viewpoint that there is one +C symbol namespace, containing all symbols in all loaded objects. +This is not so on Windows and Darwin, but we emulate UNIX's behaviour +there. @ref{defcfun} for more details.} Note the parallels with the original C declaration. We've defined @code{curl-code} as a wrapping type for @code{:int}; right now, it @@ -1655,9 +1634,8 @@ likely that either code or a good reason for lack of code is already present. @impnote{There are some other things in @cffi{} that might deserve -tutorial sections, such as define-foreign-type, -free-translated-object, or structs. Let us know which ones you care -about.} +tutorial sections, such as free-translated-object, or structs. Let us +know which ones you care about.} @c =================================================================== @@ -1742,7 +1720,6 @@ define new types. * Foreign Type Translators:: * Optimizing Type Translators:: * Foreign Structure Types:: -* Operations on Types:: * Allocating Foreign Objects:: Dictionary @@ -1792,6 +1769,13 @@ Dictionary These types correspond to the native C integer types according to the @acronym{ABI} of the Lisp implementation's host system. +@code{:long-long} and @code{:unsigned-long-long} are not supported +natively on all implementations. However, they are emulated by +@code{mem-ref} and @code{mem-set}. + +When those types are @strong{not} available, the symbol +@code{cffi-features:no-long-long} is pushed into @code{*features*}. + @ForeignType{:uchar} @ForeignType{:ushort} @ForeignType{:uint} @@ -1804,11 +1788,6 @@ For convenience, the above types are provided as shortcuts for @code{unsigned-long}, @code{long-long} and @code{unsigned-long-long}, respectively. -@code{:long-long} and @code{:unsigned-long-long} are not supported on -all implementations. When those types are @strong{not} available, the -symbol @code{cffi-features:no-long-long} is pushed into -@code{*features*}. - @ForeignType{:int8} @ForeignType{:uint8} @ForeignType{:int16} @@ -2229,9 +2208,6 @@ The equivalent @code{defcstruct} form follows: (reason :string)) @end lisp -@cffi{} knows how to align C @code{struct}s, and how to figure in -padding between struct elements. - Please note that this interface is only for those that must know about the values contained in a relevant struct. If the library you are interfacing returns an opaque pointer that needs only be passed to @@ -2239,10 +2215,7 @@ other C library functions, by all means just use @code{:pointer} or a type-safe definition munged together with @code{defctype} and type translation. -@node Operations on Types -@section Operations on Types - -@impnote{Which ``operations'' are worth going over here? --stephen} +@ref{defcstruct} for more details. @node Allocating Foreign Objects @section Allocating Foreign Objects @@ -2259,7 +2232,7 @@ translation. @node convert-from-foreign @unnumberedsec convert-from-foreign @subheading Syntax -@Function{convert-from-foreign foreign-value type @result{} value} +@Function{convert-from-foreign foreign-value type @res{} value} @subheading Arguments and Values @@ -2301,6 +2274,7 @@ CFFI-USER> (convert-from-foreign * :string) @subheading See Also @seealso{convert-to-foreign} @* +@seealso{free-converted-object} @* @seealso{translate-from-foreign} @@ -2310,7 +2284,7 @@ CFFI-USER> (convert-from-foreign * :string) @node convert-to-foreign @unnumberedsec convert-to-foreign @subheading Syntax -@Function{convert-to-foreign value type @result{} foreign-value, alloc-params} +@Function{convert-to-foreign value type @res{} foreign-value, alloc-params} @subheading Arguments and Values @@ -2421,7 +2395,7 @@ which is @code{:int} by default. :rdwr ;@lispcmt{@dots{}} :nonblock :append - (:creat #x0200)) + (:creat #x0200)) ;; @lispcmt{etc@dots{}} CFFI> (foreign-bitfield-symbols 'open-flags #b1101) @@ -2454,7 +2428,7 @@ CFFI> (unix-open "/tmp/foo" '(:wronly :creat) #o644) @node defcstruct @unnumberedsec defcstruct @subheading Syntax -@Macro{defcstruct name-and-options &body doc-and-slots @result{} name} +@Macro{defcstruct name-and-options &body doc-and-slots @res{} name} name-and-options ::= structure-name | (structure-name &key size) @@ -2573,7 +2547,7 @@ CFFI> (foreign-type-size 'foo) @node defcunion @unnumberedsec defcunion @subheading Syntax -@Macro{defcunion name &body doc-and-slots @result{} name} +@Macro{defcunion name &body doc-and-slots @res{} name} doc-and-slots ::= [docstring] @{ (slot-name slot-type &key count) @}* @@ -2638,11 +2612,9 @@ A documentation string, currently ignored. @subheading Description The @code{defctype} macro provides a mechanism similar to C's @code{typedef} to define new types. The new type inherits -@var{base-type}'s translators, if any. - -There is no way to define translations for types for types defined -with @code{defctype}. For that, you should use -@ref{define-foreign-type}. +@var{base-type}'s translators, if any. There is no way to define +translations for types for types defined with @code{defctype}. For +that, you should use @ref{define-foreign-type}. @subheading Examples @lisp @@ -2734,7 +2706,7 @@ CFFI> (foreign-enum-keyword 'numbers 2) @node define-foreign-type @unnumberedsec define-foreign-type @subheading Syntax -@Macro{define-foreign-type class-name supers slots &rest options @result{} class-name} +@Macro{define-foreign-type class-name supers slots &rest options @res{} class-name} options ::= (@code{:actual-type} @var{type}) | @ (@code{:simple-parser} @var{symbol}) | @ @@ -2800,7 +2772,7 @@ CFFI> (canonicalize-foreign-type '(:boolean :float)) @node define-parse-method @unnumberedsec define-parse-method @subheading Syntax -@Macro{define-parse-method name lambda-list &body body @result{} name} +@Macro{define-parse-method name lambda-list &body body @res{} name} @subheading Arguments and Values @@ -2892,7 +2864,7 @@ CFFI> (canonicalize-foreign-type '(:boolean :float)) @node foreign-bitfield-symbols @unnumberedsec foreign-bitfield-symbols @subheading Syntax -@Function{foreign-bitfield-symbols type value @result{} symbols} +@Function{foreign-bitfield-symbols type value @res{} symbols} @subheading Arguments and Values @@ -2934,7 +2906,7 @@ CFFI> (foreign-bitfield-symbols 'boolean #b101) @node foreign-bitfield-value @unnumberedsec foreign-bitfield-value @subheading Syntax -@Function{foreign-bitfield-value type symbols @result{} value} +@Function{foreign-bitfield-value type symbols @res{} value} @subheading Arguments and Values @@ -2975,7 +2947,7 @@ CFFI> (foreign-bitfield-value 'flags '(flag-a flag-c)) @node foreign-enum-keyword @unnumberedsec foreign-enum-keyword @subheading Syntax -@Function{foreign-enum-keyword type value &key errorp @result{} keyword} +@Function{foreign-enum-keyword type value &key errorp @res{} keyword} @subheading Arguments and Values @@ -3023,7 +2995,7 @@ CFFI> (foreign-enum-keyword 'boolean 1) @node foreign-enum-value @unnumberedsec foreign-enum-value @subheading Syntax -@Function{foreign-enum-value type keyword &key errorp @result{} value} +@Function{foreign-enum-value type keyword &key errorp @res{} value} @subheading Arguments and Values @@ -3071,7 +3043,7 @@ CFFI> (foreign-enum-value 'boolean :yes) @node foreign-slot-names @unnumberedsec foreign-slot-names @subheading Syntax -@Function{foreign-slot-names type @result{} names} +@Function{foreign-slot-names type @res{} names} @subheading Arguments and Values @@ -3111,7 +3083,7 @@ CFFI> (foreign-slot-names 'timeval) @node foreign-slot-offset @unnumberedsec foreign-slot-offset @subheading Syntax -@Function{foreign-slot-offset type slot-name @result{} offset} +@Function{foreign-slot-offset type slot-name @res{} offset} @subheading Arguments and Values @@ -3155,7 +3127,7 @@ CFFI> (foreign-slot-offset 'timeval 'tv-usecs) @node foreign-slot-pointer @unnumberedsec foreign-slot-pointer @subheading Syntax -@Function{foreign-slot-pointer ptr type slot-name @result{} pointer} +@Function{foreign-slot-pointer ptr type slot-name @res{} pointer} @subheading Arguments and Values @@ -3208,7 +3180,7 @@ CFFI> (with-foreign-object (ptr 'point) @node foreign-slot-value @unnumberedsec foreign-slot-value @subheading Syntax -@Accessor{foreign-slot-value ptr type slot-name @result{} object} +@Accessor{foreign-slot-value ptr type slot-name @res{} object} @subheading Arguments and Values @@ -3272,7 +3244,7 @@ CFFI> (with-foreign-object (ptr 'point) @unnumberedsec foreign-type-alignment @subheading Syntax @c XXX: This is actually a generic function. -@Function{foreign-type-alignment type @result{} alignment} +@Function{foreign-type-alignment type @res{} alignment} @subheading Arguments and Values @@ -3317,7 +3289,7 @@ CFFI> (foreign-type-alignment 'foo) @unnumberedsec foreign-type-size @subheading Syntax @c XXX: this is actually a generic function. -@Function{foreign-type-size type @result{} size} +@Function{foreign-type-size type @res{} size} @subheading Arguments and Values @@ -3453,7 +3425,7 @@ the @code{defctype} macro. @unnumberedsec translate-from-foreign @subheading Syntax @GenericFunction{translate-from-foreign foreign-value type-name @ - @result{} lisp-value} + @res{} lisp-value} @subheading Arguments and Values @@ -3499,7 +3471,7 @@ defined for built-in types. @unnumberedsec translate-to-foreign @subheading Syntax @GenericFunction{translate-to-foreign lisp-value type-name @ - @result{} foreign-value, alloc-param} + @res{} foreign-value, alloc-param} @subheading Arguments and Values @@ -3719,7 +3691,7 @@ dereference @code{*} in C; use @code{mem-aref} for array indexing and @node foreign-free @unnumberedsec foreign-free @subheading Syntax -@Function{foreign-free ptr @result{} undefined} +@Function{foreign-free ptr @res{} undefined} @subheading Arguments and Values @@ -3754,7 +3726,7 @@ CFFI> (foreign-free *) @unnumberedsec foreign-alloc @subheading Syntax @Function{foreign-alloc type &key initial-element initial-contents (count 1) @ - null-terminated-p @result{} pointer} + null-terminated-p @res{} pointer} @subheading Arguments and Values @@ -3865,7 +3837,7 @@ CFFI> (progn @node foreign-symbol-pointer @unnumberedsec foreign-symbol-pointer @subheading Syntax -@Function{foreign-symbol-pointer foreign-name &key library @result{} pointer} +@Function{foreign-symbol-pointer foreign-name &key library @res{} pointer} @subheading Arguments and Values @@ -3922,7 +3894,7 @@ CFFI> (foreign-symbol-pointer "inexistent symbol") @node inc-pointer @unnumberedsec inc-pointer @subheading Syntax -@Function{inc-pointer pointer offset @result{} new-pointer} +@Function{inc-pointer pointer offset @res{} new-pointer} @subheading Arguments and Values @@ -3964,7 +3936,7 @@ CFFI> (foreign-string-to-lisp *) @node incf-pointer @unnumberedsec inc-pointer @subheading Syntax -@Macro{incf-pointer place &optional (offset 1) @result{} new-pointer} +@Macro{incf-pointer place &optional (offset 1) @res{} new-pointer} @subheading Arguments and Values @@ -4013,7 +3985,7 @@ CFFI> (foreign-string-to-lisp *two-words*) @node make-pointer @unnumberedsec make-pointer @subheading Syntax -@Function{make-pointer address @result{} ptr} +@Function{make-pointer address @res{} ptr} @subheading Arguments and Values @@ -4120,7 +4092,7 @@ CFFI> (with-foreign-object (array :int 10) @node mem-ref @unnumberedsec mem-ref @subheading Syntax -@Accessor{mem-ref ptr type &optional offset @result{} object} +@Accessor{mem-ref ptr type &optional offset @res{} object} @subheading Arguments and Values @@ -4167,7 +4139,7 @@ CFFI> (mem-ref ptr-to-int :int) @node null-pointer @unnumberedsec null-pointer @subheading Syntax -@Function{null-pointer @result{} pointer} +@Function{null-pointer @res{} pointer} @subheading Arguments and Values @@ -4199,7 +4171,7 @@ CFFI> (pointerp *) @node null-pointer-p @unnumberedsec null-pointer-p @subheading Syntax -@Function{null-pointer-p ptr @result{} boolean} +@Function{null-pointer-p ptr @res{} boolean} @subheading Arguments and Values @@ -4244,7 +4216,7 @@ CFFI> (contains-str-p "Popcorns" "salt") @node pointerp @unnumberedsec pointerp @subheading Syntax -@Function{pointerp ptr @result{} boolean} +@Function{pointerp ptr @res{} boolean} @subheading Arguments and Values @@ -4286,7 +4258,7 @@ CFFI> (pointerp "this is not a pointer") @node pointer-address @unnumberedsec pointer-address @subheading Syntax -@Function{pointer-address ptr @result{} address} +@Function{pointer-address ptr @res{} address} @subheading Arguments and Values @@ -4327,7 +4299,7 @@ CFFI> (pointer-address (make-pointer 123)) @node pointer-eq @unnumberedsec pointer-eq @subheading Syntax -@Function{pointer-eq ptr1 ptr2 @result{} boolean} +@Function{pointer-eq ptr1 ptr2 @res{} boolean} @subheading Arguments and Values @@ -4480,6 +4452,7 @@ without referring to any implementation-specific symbols. @menu Dictionary +* *default-foreign-encoding*:: * foreign-string-alloc:: * foreign-string-free:: * foreign-string-to-lisp:: @@ -4490,35 +4463,95 @@ Dictionary @c =================================================================== +@c *DEFAULT-FOREIGN-ENCODING* + +@node *default-foreign-encoding* +@unnumberedsec *default-foreign-encoding* +@subheading Syntax + +@Variable{*default-foreign-encoding*} + +@subheading Value type + +A keyword. + +@subheading Initial value + +@code{:utf-8} + +@subheading Description + +This special variable holds the default foreign encoding. + +@subheading Examples + +@lisp +CFFI> *default-foreign-encoding* +:utf-8 +CFFI> (foreign-funcall "strdup" (:string :encoding :utf-16) "foo" :string) +"f" +CFFI> (let ((*default-foreign-encoding* :utf-16)) + (foreign-funcall "strdup" (:string :encoding :utf-16) "foo" :string)) +"foo" +@end lisp + +@subheading See also + +@seealso{Other Types} (@code{:string} type) @* +@seealso{foreign-string-alloc} @* +@seealso{foreign-string-to-lisp} @* +@seealso{lisp-string-to-foreign} @* +@seealso{with-foreign-string} @* +@seealso{with-foreign-pointer-as-string} + + +@c =================================================================== @c FOREIGN-STRING-ALLOC @node foreign-string-alloc @unnumberedsec foreign-string-alloc @subheading Syntax -@Function{foreign-string-alloc string-or-ub8-array @result{} pointer} +@Function{foreign-string-alloc string &key encoding null-terminated-p @ + start end @res{} pointer} @subheading Arguments and Values @table @var -@item string-or-ub8-array -A Lisp string or a Lisp array with element-type @code{(unsigned-byte 8)}. +@item string +A Lisp string. + +@item encoding +Foreign encoding. Defaults to @code{*default-foreign-encoding*}. + +@item null-terminated-p +Boolean, defaults to true. + +@item start, end +Bounding index designators of @var{string}. 0 and @code{nil}, by +default. @item pointer A pointer to the newly allocated foreign string. @end table @subheading Description -The @code{foreign-string-alloc} function allocates a foreign string -containing a Lisp string or @code{(unsigned-byte 8)} array. +The @code{foreign-string-alloc} function allocates foreign memory +holding a copy of @var{string} converted using the specified +@var{encoding}. @var{Start} specifies an offset into @var{string} and +@var{end} marks the position following the last element of the foreign +string. This string must be freed with @code{foreign-string-free}. +If @var{null-terminated-p} is false, the string will not be +null-terminated. + @subheading Examples @lisp -CFFI> (setq str (foreign-string-alloc "Hello, foreign world!")) +CFFI> (defparameter *str* (foreign-string-alloc "Hello, foreign world!")) @result{} # -CFFI> (foreign-funcall "strlen" :pointer str :int) +CFFI> (foreign-funcall "strlen" :pointer *str* :int) @result{} 21 @end lisp @@ -4559,8 +4592,8 @@ allocated by @code{foreign-string-alloc}. @node foreign-string-to-lisp @unnumberedsec foreign-string-to-lisp @subheading Syntax -@Function{foreign-string-to-lisp ptr &optional size null-terminated-p @ - @result{} string} +@Function{foreign-string-to-lisp ptr &optional offset count max-chars @ + encoding @res{} string} @subheading Arguments and Values @@ -4568,23 +4601,32 @@ allocated by @code{foreign-string-alloc}. @item ptr A pointer. -@item size -The maximum string size. @code{array-total-size-limit}, by default. +@item offset +An integer greater than or equal to 0. Defauls to 0. -@item null-terminated-p -Specifies if the string @var{ptr} points to is null terminated. True, -by default. +@item count +Either @code{nil} (the default), or an integer greater than or equal to 0. + +@item max-chars +An integer greater than or equal to 0. +@code{(1- array-total-size-limit)}, by default. + +@item encoding +Foreign encoding. Defaults to @code{*default-foreign-encoding*}. + +@item string +A Lisp string. @end table @subheading Description -The @code{foreign-string-to-lisp} function copies at most @var{size} -characters from @var{ptr} into a Lisp string. +The @code{foreign-string-to-lisp} function converts at most +@var{count} octets from @var{ptr} into a Lisp string, using the +defined @var{encoding}. -When @var{null-terminated-p} is true (the default), characters are -copied until @var{size} is reached or a @code{NULL} character is -found. +If @var{count} is @code{nil} (the default), characters are copied +until @var{max-chars} is reached or a @code{NULL} character is found. -If @var{ptr} is a null pointer, returns nil. +If @var{ptr} is a null pointer, returns @code{nil}. Note that the @code{:string} type will automatically convert between Lisp strings and foreign strings. @@ -4610,25 +4652,41 @@ CFFI> (foreign-string-to-lisp *) @node lisp-string-to-foreign @unnumberedsec lisp-string-to-foreign @subheading Syntax -@Function{lisp-string-to-foreign string-or-ub8-array ptr size} +@Function{lisp-string-to-foreign string buffer bufsize &key start @ + end offset encoding @res{} buffer} @subheading Arguments and Values @table @var -@item string-or-ub8-array -A Lisp string or a Lisp @code{(unsigned-byte 8)} array. +@item string +A Lisp string. -@item ptr +@item buffer A foreign pointer. -@item size +@item bufsize An integer. + +@item start, end +Bounding index designators of @var{string}. 0 and @code{nil}, by +default. + +@item offset +An integer greater than or equal to 0. Defauls to 0. + +@item encoding +Foreign encoding. Defaults to @code{*default-foreign-encoding*}. @end table @subheading Description -The @code{lisp-string-to-foreign} function copies at most @var{size}-1 -characters from a Lisp string or @code{(unsigned-byte 8)} arrayto -@var{ptr}. The foreign string will be null-terminated. +The @code{lisp-string-to-foreign} function copies at most +@var{bufsize}-1 octets from a Lisp @var{string} using the specified +@var{encoding} into @var{buffer}+@var{offset}. The foreign string will +be null-terminated. + +@var{Start} specifies an offset into @var{string} and +@var{end} marks the position following the last element of the foreign +string. @subheading Examples @@ -4636,13 +4694,6 @@ characters from a Lisp string or @code{(unsigned-byte 8)} arrayto CFFI> (with-foreign-pointer-as-string (str 255) (lisp-string-to-foreign "Hello, foreign world!" str 6)) @result{} "Hello" - -CFFI> (with-foreign-pointer-as-string (str 255) - (lisp-string-to-foreign - (make-array 6 :element-type '(unsigned-byte 8) - :initial-contents '(65 66 67 68 69 60)) - str 4)) -@result{} "ABC" @end lisp @subheading See Also @@ -4657,16 +4708,20 @@ CFFI> (with-foreign-pointer-as-string (str 255) @node with-foreign-string @unnumberedsec with-foreign-string @subheading Syntax -@Macro{with-foreign-string (var lisp-string-or-ub8-array) &body body} +@Macro{with-foreign-string (var-or-vars string &rest args) &body body} +@Macro{with-foreign-strings (bindings) &body body} + +var-or-vars ::= var | (var &optional octet-size-var) +bindings ::= @{(var-or-vars string &rest args)@}* @subheading Arguments and Values @table @var -@item var +@item var, byte-size-var A symbol. -@item lisp-string-or-ub8-array -A Lisp string or a Lisp array with element type @code{(unsigned-byte 8)}. +@item string +A Lisp string. @item body A list of forms to be executed. @@ -4674,7 +4729,11 @@ A list of forms to be executed. @subheading Description The @code{with-foreign-string} macro will bind @var{var} to a newly -allocated foreign string containing @var{lisp-string-or-ub8-array}. +allocated foreign string containing @var{string}. @var{Args} is passed +to the underlying @code{foreign-string-alloc} call. + +If @var{octet-size-var} is provided, it will be bound the length of +foreign string in octets including the null terminator. @subheading Examples @@ -4701,7 +4760,8 @@ CFFI> (let ((array (coerce #(84 117 114 97 110 103 97) @node with-foreign-pointer-as-string @unnumberedsec with-foreign-pointer-as-string @subheading Syntax -@Macro{with-foreign-pointer-as-string (var size &optional size-var) &body body} +@Macro{with-foreign-pointer-as-string (var size &optional size-var @ + &rest args) &body body @res{} string} @subheading Arguments and Values @@ -4709,7 +4769,7 @@ CFFI> (let ((array (coerce #(84 117 114 97 110 103 97) @item var A symbol. -@item lisp-string +@item string A Lisp string. @item body @@ -4718,13 +4778,14 @@ List of forms to be executed. @subheading Description The @code{with-foreign-pointer-as-string} macro is similar to -@code{with-foreign-pointer} except that @var{var}, as a Lisp string, is -used as the returned value of an implicit @code{progn} around @var{body}. +@code{with-foreign-pointer} except that @var{var} is used as the +returned value of an implicit @code{progn} around @var{body}, after +being converted to a Lisp string using the provided @var{args}. @subheading Examples @lisp -CFFI> (with-foreign-pointer-as-string (str 6 str-size) +CFFI> (with-foreign-pointer-as-string (str 6 str-size :encoding :ascii) (lisp-string-to-foreign "Hello, foreign world!" str str-size)) @result{} "Hello" @end lisp @@ -4754,10 +4815,10 @@ Dictionary @node defcvar @unnumberedsec defcvar @subheading Syntax -@Macro{defcvar name-and-options type documentation @result{} lisp-name} +@Macro{defcvar name-and-options type &optional documentation @res{} lisp-name} -name-and-options ::= name | (name &key read-only (library :default)) -name ::= lisp-name [foreign-name] | foreign-name [lisp-name] +@var{name-and-options} ::= name | (name &key read-only (library :default)) @* +@var{name} ::= lisp-name [foreign-name] | foreign-name [lisp-name] @subheading Arguments and Values @@ -4831,7 +4892,7 @@ C standard library.} @node get-var-pointer @unnumberedsec get-var-pointer @subheading Syntax -@Function{get-var-pointer symbol @result{} pointer} +@Function{get-var-pointer symbol @res{} pointer} @subheading Arguments and Values @@ -4872,8 +4933,8 @@ CFFI> (mem-ref * :int) @chapter Functions @menu -* Calling Foreign Functions:: -* Defining Foreign Functions:: +@c * Defining Foreign Functions:: +@c * Calling Foreign Functions:: Dictionary @@ -4882,11 +4943,11 @@ Dictionary * foreign-funcall-pointer:: @end menu -@node Calling Foreign Functions -@section Calling Foreign Functions +@c @node Calling Foreign Functions +@c @section Calling Foreign Functions -@node Defining Foreign Functions -@section Defining Foreign Functions +@c @node Defining Foreign Functions +@c @section Defining Foreign Functions @c =================================================================== @@ -4896,13 +4957,11 @@ Dictionary @unnumberedsec defcfun @subheading Syntax @Macro{defcfun name-and-options return-type &body arguments [&rest] @ - @result{} lisp-name} + @res{} lisp-name} -@table @asis -@item @var{name-and-options} name | (name &key library calling-convention cconv) -@item @var{name} ::= @var{lisp-name} [@var{foreign-name}] | @var{foreign-name} [@var{lisp-name}] -@item @var{arguments} ::= @{ (arg-name arg-type) @}* -@end table +@var{name-and-options} name | (name &key library calling-convention cconv) @* +@var{name} ::= @var{lisp-name} [@var{foreign-name}] | @var{foreign-name} [@var{lisp-name}] @* +@var{arguments} ::= @{ (arg-name arg-type) @}* @* @subheading Arguments and Values @@ -4954,7 +5013,6 @@ care of doing argument promotion. Note that in this case function and will only work for Lisps that support @code{foreign-funcall.} - @subheading Examples @lisp @@ -4996,7 +5054,7 @@ CFFI> (with-foreign-pointer-as-string (s 100) @node foreign-funcall @unnumberedsec foreign-funcall @subheading Syntax -@Macro{foreign-funcall name-and-options &rest arguments @result{} return-value} +@Macro{foreign-funcall name-and-options &rest arguments @res{} return-value} arguments ::= @{ arg-type arg @}* [return-type] name-and-options ::= name | ( name &key library calling-convention cconv) @@ -5094,7 +5152,7 @@ CFFI> (foreign-funcall "printf" :string (format nil "%s: %d.~%") @node foreign-funcall-pointer @unnumberedsec foreign-funcall-pointer @subheading Syntax -@Macro{foreign-funcall pointer options &rest arguments @result{} return-value} +@Macro{foreign-funcall pointer options &rest arguments @res{} return-value} arguments ::= @{ arg-type arg @}* [return-type] options ::= ( &key calling-convention cconv ) @@ -5136,7 +5194,7 @@ Corman Lisp does not support @code{foreign-funcall}. On implementations that @strong{don't} support @code{foreign-funcall} @code{cffi-features:no-foreign-funcall} will be present in @code{*features*}. Note: in these Lisps you can still use the -@code{defcfun} interface. +@code{defcfun} interface. @end itemize @subheading Examples @@ -5244,7 +5302,7 @@ little about. --stephen} @node close-foreign-library @unnumberedsec close-foreign-library @subheading Syntax -@Function{close-foreign-library library @result{} success} +@Function{close-foreign-library library @res{} success} @subheading Arguments and Values @@ -5321,7 +5379,7 @@ CFFI> (load-foreign-library '(:framework "OpenGL")) @subheading Syntax -@Macro{define-foreign-library name-and-options @{ load-clause @}* @result{} name} +@Macro{define-foreign-library name-and-options @{ load-clause @}* @res{} name} name-and-options ::= name | (name &key calling-convention cconv) load-clause ::= (feature library &key calling-convention cconv) @@ -5517,7 +5575,7 @@ The following example would achieve the same effect: @node load-foreign-library @unnumberedsec load-foreign-library @subheading Syntax -@Function{load-foreign-library library @result{} handler} +@Function{load-foreign-library library @res{} handler} @subheading Arguments and Values @@ -5687,7 +5745,7 @@ Dictionary @node callback @unnumberedsec callback @subheading Syntax -@Macro{callback symbol @result{} pointer} +@Macro{callback symbol @res{} pointer} @subheading Arguments and Values @@ -5726,7 +5784,7 @@ CFFI> (callback sum) @node defcallback @unnumberedsec defcallback @subheading Syntax -@Macro{defcallback name-and-options return-type arguments &body body @result{} name} +@Macro{defcallback name-and-options return-type arguments &body body @res{} name} name-and-options ::= name | (name &key calling-convention cconv) arguments ::= (@{ (arg-name arg-type) @}*) @@ -5802,7 +5860,7 @@ CFFI> (with-foreign-object (array :int 10) @node get-callback @unnumberedsec get-callback @subheading Syntax -@Accessor{get-callback symbol @result{} pointer} +@Accessor{get-callback symbol @res{} pointer} @subheading Arguments and Values @@ -5833,6 +5891,260 @@ CFFI> (get-callback 'sum) @seealso{callback} @* @seealso{defcallback} + +@c =================================================================== +@c CHAPTER: The Groveller + +@node The Groveller +@chapter The Groveller + +@c Manual and software copyright @copyright{} 2005, 2006 Matthew Backes +@c and Dan Knapp . + +@cffi{}-Grovel is a tool which makes it easier to write @cffi{} +declarations for libraries that are implemented in C. That is, it +grovels through the system headers, getting information about types +and structures, so you don't have to. This is especially important +for libraries which are implemented in different ways by different +vendors, such as the @sc{unix}/@sc{posix} functions. The @cffi{} +declarations are usually quite different from platform to platform, +but the information you give to @cffi{}-Grovel is the same. Hence, +much less work is required! + +If you use @acronym{ASDF}, @cffi{}-Grovel is integrated, so that it +will run automatically when your system is building. This feature was +inspired by SB-Grovel, a similar @acronym{SBCL}-specific project. +@cffi{}-Grovel can also be used without @acronym{ASDF}. + +@section Building FFIs with CFFI-Grovel + +@cffi{}-Grovel uses a specification file (*.lisp) describing the +features that need groveling. The C compiler is used to retrieve this +data and write a Lisp file (*.cffi.lisp) which contains the necessary +@cffi{} definitions to access the variables, structures, constants, and +enums mentioned in the specification. + +@c This is most similar to the SB-Grovel package, upon which it is +@c based. Unlike SB-Grovel, we do not currently support defining +@c regular foreign functions in the specification file; those are best +@c defined in normal Lisp code. + +@cffi{}-Grovel provides an @acronym{ASDF} component for handling the +necessary calls to the C compiler and resulting file management. + +@c See the included CFFI-Unix package for an example of how to +@c integrate a specification file with ASDF-built packages. + +@menu +* Groveller Syntax:: How grovel files should look like. +* Groveller ASDF Integration:: ASDF components for grovel files. +* Groveller Implementation Notes:: Implementation notes. +@end menu + +@node Groveller Syntax +@section Specification File Syntax + +The specification files are read by the normal Lisp reader, so they +have syntax very similar to normal Lisp code. In particular, +semicolon-comments and reader-macros will work as expected. + +There are several forms recognized by @cffi{}-Grovel: + +@deffn {Grovel Form} progn &rest forms + +Processes a list of forms. Useful for conditionalizing several +forms. For example: +@end deffn + +@lisp +#+cffi-features:freebsd +(progn + (constant (ev-enable "EV_ENABLE")) + (constant (ev-disable "EV_DISABLE"))) +@end lisp + +@deffn {Grovel Form} include &rest files + +Include the specified files (specified as strings) in the generated C +source code. +@end deffn + +@deffn {Grovel Form} in-package symbol + +Set the package to be used for the final Lisp output. +@end deffn + +@deffn {Grovel Form} ctype lisp-name signedness size-designator + +Define a @cffi{} foreign type for the string in @var{size-designator}, +e.g. @code{(ctype :pid :unsigned "pid_t")}. +@end deffn + +@deffn {Grovel Form} constant (lisp-name &rest c-names) &key documentation optional + +Search for the constant named by the first @var{c-name} string found +to be known to the C preprocessor and define it as @var{lisp-name}. +If optional is true, no error will be raised if all the @var{c-names} +are unknown. +@end deffn + +@deffn {Grovel Form} define name &optional value + +Defines an additional C preprocessor symbol, which is useful for +altering the behavior of included system headers. +@end deffn + +@deffn {Grovel Form} flag flag-string + +Adds @var{flag-string} to the flags used for the C compiler +invocation. +@end deffn + +@deffn {Grovel Form} cstruct lisp-name c-name slots + +Define a @cffi{} foreign struct with the slot data specfied. Slots +are of the form @code{(lisp-name c-name &key type count (signed t))}. +@end deffn + +@deffn {Grovel Form} cunion lisp-name c-name slots + +Identical to @code{cstruct}, but defines a @cffi{} foreign union. +@end deffn + +@deffn {Grovel Form} cstruct-and-class c-name slots + +Defines a @cffi{} foreign struct, as with @code{cstruct} and defines a +@acronym{CLOS} class to be used with it. This is useful for mapping +foreign structures to application-layer code that shouldn't need to +worry about memory allocation issues. +@end deffn + +@deffn {Grovel Form} cvar namespec type &key read-only + +Defines a foreign variable of the specified type, even if that +variable is potentially a C preprocessor pseudo-variable. e.g. +@code{(cvar ("errno" errno) errno-values)}, assuming that errno-values +is an enum or equivalent to type @code{:int}. + +The @var{namespec} is similar to the one used in @ref{defcvar}. +@end deffn + +@deffn {Grovel Form} cenum name &rest elements + +Defines a true C enum, with elements specified as @code{((lisp-name +&rest c-names) &key optional documentation)}. +@end deffn + +@deffn {Grovel Form} constantenum name &rest elements + +Defines an enumeration of pre-processor constants, with elements +specified as @code{((lisp-name &rest c-names) &key optional +documentation)}. + +This example defines @code{:af-inet} to represent the value held by +@code{AF_INET} or @code{PF_INET}, whichever the pre-processor finds +first. Similarly for @code{:af-packet}, but no error will be +signalled if the platform supports neither @code{AF_PACKET} nor +@code{PF_PACKET}. +@end deffn + +@lisp +(constantenum address-family + ((:af-inet "AF_INET" "PF_INET") + :documentation "IPv4 Protocol family") + ((:af-local "AF_UNIX" "AF_LOCAL" "PF_UNIX" "PF_LOCAL") + :documentation "File domain sockets") + ((:af-inet6 "AF_INET6" "PF_INET6") + :documentation "IPv6 Protocol family") + ((:af-packet "AF_PACKET" "PF_PACKET") + :documentation "Raw packet access" + :optional t)) +@end lisp + + +@c =================================================================== +@c SECTION: Groveller ASDF Integration + +@node Groveller ASDF Integration +@section ASDF Integration + +An example software project might contain four files; an +@acronym{ASDF} file, a package definition file, an implementation +file, and a @cffi{}-Grovel specification file. + +The @acronym{ASDF} file defines the system and its dependencies. +Notice the use of @code{eval-when} to ensure @cffi{}-Grovel is present +and the use of @code{(cffi-grovel:grovel-file name &key cc-flags)} +instead of @code{(:file name)}. + +@lisp +;;; CFFI-Grovel is needed for processing grovel-file components +(cl:eval-when (:load-toplevel :execute) + (asdf:operate 'asdf:load-op 'cffi-grovel)) + +(asdf:defsystem example-software + :depends-on (cffi) + :serial t + :components + ((:file "package") + (cffi-grovel:grovel-file "example-grovelling") + (:file "example"))) +@end lisp + +The ``package.lisp'' file would contain several @code{defpackage} +forms, to remove circular dependencies and make building the project +easier. Note that you may or may not want to @code{:use} your +internal package. + +@impnote{Mention that it's a not a good idea to :USE when names may +clash with, say, CL symbols.} + +@lisp +(defpackage #:example-internal + (:use) + (:nicknames #:exampleint)) + +(defpackage #:example-software + (:export ...) + (:use #:cl #:cffi #:exampleint)) +@end lisp + +The internal package is created by Lisp code output from the C program +written by @cffi{}-Grovel; if your specification file is +exampleint.lisp, the exampleint.cffi.lisp file will contain the +@cffi{} definitions needed by the rest of your project. +@xref{Groveller Syntax}. + +@node Groveller Implementation Notes +@section Implementation Notes + +@impnote{This info might not be up-to-date.} + +For @code{foo-internal.lisp}, the resulting @code{foo-internal.c}, +@code{foo-internal}, and @code{foo-internal.cffi.lisp} are all +platform-specific, either because of possible reader-macros in +foo-internal.lisp, or because of varying C environments on the host +system. For this reason, it is not helpful to distribute any of those +files; end users building @cffi{}-Grovel based software will need +@code{cffi}-Grovel anyway. + +If you build with multiple architectures in the same directory +(e.g. with NFS/AFS home directories), it is critical to remove these +generated files or the resulting constants will be very incorrect. + +@impnote{Maybe we should tag the generated names with something host +or OS-specific?} + +@impnote{For now, after some experimentation with @sc{clisp} having no +long-long, it seems appropriate to assert that the generated @code{.c} +files are architecture and operating-system dependent, but +lisp-implementation independent. This way the same @code{.c} file +(and so the same @code{.grovel-tmp.lisp} file) will be shareable +between the implementations running on a given system.} + +@c TODO: document the new wrapper stuff. + + @c =================================================================== @c CHAPTER: Limitations @@ -5855,8 +6167,6 @@ details. C @code{struct}s cannot be passed by value. @end itemize -@c more? - @node Platform-specific features @appendix Platform-specific features @@ -5870,7 +6180,7 @@ The exact meanings of the features follow. Though you will usually refer to these symbols as keywords, @cffi{} internally views them in the package @code{cffi-features}. -@table @code +@table @var @item flat-namespace This Lisp has a flat namespace for foreign symbols meaning that you won't be able to load two different libraries with homograph functions diff --git a/external/cffi.darcs/_darcs/pristine/examples/examples.lisp b/external/cffi.darcs/_darcs/pristine/examples/examples.lisp index 231eddf..6093acb 100644 --- a/external/cffi.darcs/_darcs/pristine/examples/examples.lisp +++ b/external/cffi.darcs/_darcs/pristine/examples/examples.lisp @@ -46,7 +46,7 @@ ;; Calling a varargs function. (defun sprintf-test () "Test calling a varargs function." - (with-foreign-pointer-as-string (buf 255 buf-size) + (with-foreign-pointer-as-string ((buf buf-size) 255) (foreign-funcall "snprintf" :pointer buf :int buf-size :string "%d %f #x%x!" :int 666 diff --git a/external/cffi.darcs/_darcs/pristine/examples/gethostname.lisp b/external/cffi.darcs/_darcs/pristine/examples/gethostname.lisp index d079639..f37d275 100644 --- a/external/cffi.darcs/_darcs/pristine/examples/gethostname.lisp +++ b/external/cffi.darcs/_darcs/pristine/examples/gethostname.lisp @@ -47,5 +47,5 @@ ;;; WITH-FOREIGN-POINTER-AS-STRING is used to allocate a temporary ;;; buffer and return it as a Lisp string. (defun gethostname () - (with-foreign-pointer-as-string (buf 255 bufsize) + (with-foreign-pointer-as-string ((buf bufsize) 255) (%gethostname buf bufsize))) diff --git a/external/cffi.darcs/_darcs/pristine/src/cffi-allegro.lisp b/external/cffi.darcs/_darcs/pristine/src/cffi-allegro.lisp index 505da48..bfa4bdd 100644 --- a/external/cffi.darcs/_darcs/pristine/src/cffi-allegro.lisp +++ b/external/cffi.darcs/_darcs/pristine/src/cffi-allegro.lisp @@ -28,7 +28,7 @@ ;;;# Administrivia (defpackage #:cffi-sys - (:use #:common-lisp #:cffi-utils) + (:use #:common-lisp #:cffi-utils #:alexandria) (:export #:canonicalize-symbol-name-case #:foreign-pointer @@ -60,23 +60,14 @@ (in-package #:cffi-sys) -;;;# Features +;;;# Mis-features (eval-when (:compile-toplevel :load-toplevel :execute) (mapc (lambda (feature) (pushnew feature *features*)) - '(;; Backend mis-features. - cffi-features:no-long-long - cffi-features:flat-namespace - ;; OS/CPU features. - #+macosx cffi-features:darwin - #+unix cffi-features:unix - #+mswindows cffi-features:windows - #+powerpc cffi-features:ppc32 - #+x86 cffi-features:x86 - #+x86-64 cffi-features:x86-64 - ))) - -;;; Symbol case. + '(cffi-features:no-long-long + cffi-features:flat-namespace))) + +;;;# Symbol Case (defun canonicalize-symbol-name-case (name) (declare (string name)) diff --git a/external/cffi.darcs/_darcs/pristine/src/cffi-clisp.lisp b/external/cffi.darcs/_darcs/pristine/src/cffi-clisp.lisp index 7eddc18..40f6a09 100644 --- a/external/cffi.darcs/_darcs/pristine/src/cffi-clisp.lisp +++ b/external/cffi.darcs/_darcs/pristine/src/cffi-clisp.lisp @@ -3,7 +3,7 @@ ;;; cffi-clisp.lisp --- CFFI-SYS implementation for CLISP. ;;; ;;; Copyright (C) 2005-2006, James Bielman -;;; (C) 2005-2006, Joerg Hoehle +;;; Copyright (C) 2005-2006, Joerg Hoehle ;;; ;;; Permission is hereby granted, free of charge, to any person ;;; obtaining a copy of this software and associated documentation @@ -29,7 +29,7 @@ ;;;# Administrivia (defpackage #:cffi-sys - (:use #:common-lisp #:cffi-utils) + (:use #:common-lisp #:cffi-utils #:alexandria) (:export #:canonicalize-symbol-name-case #:foreign-pointer @@ -60,26 +60,7 @@ (in-package #:cffi-sys) -;;; FIXME: long-long could be supported anyway on 64-bit machines. --luis - -;;;# Features - -(eval-when (:compile-toplevel :load-toplevel :execute) - (mapc (lambda (feature) (pushnew feature *features*)) - '(;; OS/CPU features. - #+:macos cffi-features:darwin - #+:unix cffi-features:unix - #+:win32 cffi-features:windows - )) - (cond ((string-equal (machine-type) "X86_64") - (pushnew 'cffi-features:x86-64 *features*)) - ((member :pc386 *features*) - (pushnew 'cffi-features:x86 *features*)) - ;; FIXME: probably catches PPC64 as well - ((string-equal (machine-type) "POWER MACINTOSH") - (pushnew 'cffi-features:ppc32 *features*)))) - -;;; Symbol case. +;;;# Symbol Case (defun canonicalize-symbol-name-case (name) (declare (string name)) diff --git a/external/cffi.darcs/_darcs/pristine/src/cffi-cmucl.lisp b/external/cffi.darcs/_darcs/pristine/src/cffi-cmucl.lisp index 64e7d76..789a0e0 100644 --- a/external/cffi.darcs/_darcs/pristine/src/cffi-cmucl.lisp +++ b/external/cffi.darcs/_darcs/pristine/src/cffi-cmucl.lisp @@ -28,7 +28,7 @@ ;;;# Administrivia (defpackage #:cffi-sys - (:use #:common-lisp #:alien #:c-call #:cffi-utils) + (:use #:common-lisp #:alien #:c-call #:cffi-utils #:alexandria) (:export #:canonicalize-symbol-name-case #:foreign-pointer @@ -63,16 +63,9 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (mapc (lambda (feature) (pushnew feature *features*)) - '(;; OS/CPU features. - #+darwin cffi-features:darwin - #+unix cffi-features:unix - #+x86 cffi-features:x86 - #+(and ppc (not ppc64)) cffi-features:ppc32 - ;; Misfeatures - cffi-features:flat-namespace - ))) + '(cffi-features:flat-namespace))) -;;; Symbol case. +;;;# Symbol Case (defun canonicalize-symbol-name-case (name) (declare (string name)) @@ -375,7 +368,10 @@ WITH-POINTER-TO-VECTOR-DATA." (setf (car lib) (sys:int-sap 0)))) (defun native-namestring (pathname) - (ext:unix-namestring pathname)) + ;; UNIX-NAMESTRING seems to be buggy? + ;; (ext:unix-namestring #p"/tmp/foo bar baz/bar") => NIL + #-(and) (ext:unix-namestring pathname) + (namestring pathname)) ;;;# Foreign Globals diff --git a/external/cffi.darcs/_darcs/pristine/src/cffi-corman.lisp b/external/cffi.darcs/_darcs/pristine/src/cffi-corman.lisp index bf31b00..f712648 100644 --- a/external/cffi.darcs/_darcs/pristine/src/cffi-corman.lisp +++ b/external/cffi.darcs/_darcs/pristine/src/cffi-corman.lisp @@ -32,7 +32,7 @@ ;;;# Administrivia (defpackage #:cffi-sys - (:use #:common-lisp #:c-types #:cffi-utils) + (:use #:common-lisp #:c-types #:cffi-utils #:alexandria) (:export #:canonicalize-symbol-name-case #:foreign-pointer @@ -62,19 +62,14 @@ (in-package #:cffi-sys) -;;;# Features +;;;# Mis-features (eval-when (:compile-toplevel :load-toplevel :execute) (mapc (lambda (feature) (pushnew feature *features*)) - '(;; Backend mis-features. - cffi-features:no-long-long - cffi-features:no-foreign-funcall - ;; OS/CPU features. - cffi-features:windows - cffi-features:x86 - ))) - -;;; Symbol case. + '(cffi-features:no-long-long + cffi-features:no-foreign-funcall))) + +;;;$ Symbol Case (defun canonicalize-symbol-name-case (name) (declare (string name)) diff --git a/external/cffi.darcs/_darcs/pristine/src/cffi-ecl.lisp b/external/cffi.darcs/_darcs/pristine/src/cffi-ecl.lisp index 6cdf94d..f538a4f 100644 --- a/external/cffi.darcs/_darcs/pristine/src/cffi-ecl.lisp +++ b/external/cffi.darcs/_darcs/pristine/src/cffi-ecl.lisp @@ -28,7 +28,7 @@ ;;;# Administrivia (defpackage #:cffi-sys - (:use #:common-lisp #:cffi-utils) + (:use #:common-lisp #:cffi-utils #:alexandria) (:export #:canonicalize-symbol-name-case #:foreign-pointer @@ -58,24 +58,14 @@ (in-package #:cffi-sys) -;;;# Features +;;;# Mis-features (eval-when (:compile-toplevel :load-toplevel :execute) (mapc (lambda (feature) (pushnew feature *features*)) - '(;; Backend mis-features. - cffi-features:no-long-long - cffi-features:flat-namespace - ;; OS/CPU features. - #+:darwin cffi-features:darwin - #+:darwin cffi-features:unix - #+:unix cffi-features:unix - #+:win32 cffi-features:windows - ;; XXX: figure out a way to get a X86 feature - ;;#+:athlon cffi-features:x86 - #+:powerpc7450 cffi-features:ppc32 - ))) - -;;; Symbol case. + '(cffi-features:no-long-long + cffi-features:flat-namespace))) + +;;;# Symbol Case (defun canonicalize-symbol-name-case (name) (declare (string name)) diff --git a/external/cffi.darcs/_darcs/pristine/src/cffi-gcl.lisp b/external/cffi.darcs/_darcs/pristine/src/cffi-gcl.lisp index fa13809..4a6bd04 100644 --- a/external/cffi.darcs/_darcs/pristine/src/cffi-gcl.lisp +++ b/external/cffi.darcs/_darcs/pristine/src/cffi-gcl.lisp @@ -42,7 +42,7 @@ ;;;# Administrivia (defpackage #:cffi-sys - (:use #:common-lisp) + (:use #:common-lisp #:alexandria) (:export #:canonicalize-symbol-name-case #:pointerp diff --git a/external/cffi.darcs/_darcs/pristine/src/cffi-lispworks.lisp b/external/cffi.darcs/_darcs/pristine/src/cffi-lispworks.lisp index 0b0102c..9c53faf 100644 --- a/external/cffi.darcs/_darcs/pristine/src/cffi-lispworks.lisp +++ b/external/cffi.darcs/_darcs/pristine/src/cffi-lispworks.lisp @@ -28,7 +28,7 @@ ;;;# Administrivia (defpackage #:cffi-sys - (:use #:cl #:cffi-utils) + (:use #:cl #:cffi-utils #:alexandria) (:export #:canonicalize-symbol-name-case #:foreign-pointer @@ -60,21 +60,13 @@ (in-package #:cffi-sys) -;;;# Features +;;;# Mis-features (eval-when (:compile-toplevel :load-toplevel :execute) (mapc (lambda (feature) (pushnew feature *features*)) - '(;; Backend mis-features. - cffi-features:no-long-long - ;; OS/CPU features. - #+darwin cffi-features:darwin - #+unix cffi-features:unix - #+win32 cffi-features:windows - #+harp::pc386 cffi-features:x86 - #+harp::powerpc cffi-features:ppc32 - ))) - -;;; Symbol case. + '(#-lispworks-64bit cffi-features:no-long-long))) + +;;;# Symbol Case (defun canonicalize-symbol-name-case (name) (declare (string name)) @@ -155,27 +147,32 @@ be stack allocated if supported by the implementation." (defun convert-foreign-type (cffi-type) "Convert a CFFI type keyword to an FLI type." (ecase cffi-type - (:char :byte) - (:unsigned-char '(:unsigned :byte)) - (:short :short) - (:unsigned-short '(:unsigned :short)) - (:int :int) - (:unsigned-int '(:unsigned :int)) - (:long :long) - (:unsigned-long '(:unsigned :long)) - (:float :float) - (:double :double) - (:pointer :pointer) - (:void :void))) + (:char :byte) + (:unsigned-char '(:unsigned :byte)) + (:short :short) + (:unsigned-short '(:unsigned :short)) + (:int :int) + (:unsigned-int '(:unsigned :int)) + (:long :long) + (:unsigned-long '(:unsigned :long)) + #+lispworks-64bit + (:long-long '(:long :long)) + #+lispworks-64bit + (:unsigned-long-long '(:unsigned :long :long)) + (:float :float) + (:double :double) + (:pointer :pointer) + (:void :void))) ;;; Convert a CFFI type keyword to a symbol suitable for passing to ;;; FLI:FOREIGN-TYPED-AREF. #+#.(cl:if (cl:find-symbol "FOREIGN-TYPED-AREF" "FLI") '(and) '(or)) (defun convert-foreign-typed-aref-type (cffi-type) (ecase cffi-type - ((:char :short :int :long) + ((:char :short :int :long #+lispworks-64bit :long-long) `(signed-byte ,(* 8 (%foreign-type-size cffi-type)))) - ((:unsigned-char :unsigned-short :unsigned-int :unsigned-long) + ((:unsigned-char :unsigned-short :unsigned-int :unsigned-long + #+lispworks-64bit :unsigned-long-long) `(unsigned-byte ,(* 8 (%foreign-type-size cffi-type)))) (:float 'single-float) (:double 'double-float))) @@ -186,13 +183,20 @@ be stack allocated if supported by the implementation." (setf ptr (inc-pointer ptr offset))) (fli:dereference ptr :type (convert-foreign-type type))) +;; Lispworks 5.0 on 64-bit platforms doesn't have [u]int64 support in +;; FOREIGN-TYPED-AREF. That was implemented in 5.1. +#+(and lispworks-64bit lispworks5.0) +(defun 64-bit-type-p (type) + (member type '(:long :unsigned-long :long-long :unsigned-long-long))) + ;;; In LispWorks versions where FLI:FOREIGN-TYPED-AREF is fbound, use ;;; it instead of FLI:DEREFERENCE in the optimizer for %MEM-REF. #+#.(cl:if (cl:find-symbol "FOREIGN-TYPED-AREF" "FLI") '(and) '(or)) (define-compiler-macro %mem-ref (&whole form ptr type &optional (off 0)) (if (constantp type) (let ((type (eval type))) - (if (eql type :pointer) + (if (or #+(and lispworks-64bit lispworks5.0) (64-bit-type-p type) + (eql type :pointer)) (let ((fli-type (convert-foreign-type type)) (ptr-form (if (eql off 0) ptr `(inc-pointer ,ptr ,off)))) `(fli:dereference ,ptr-form :type ',fli-type)) @@ -225,7 +229,8 @@ be stack allocated if supported by the implementation." (if (constantp type) (once-only (val) (let ((type (eval type))) - (if (eql type :pointer) + (if (or #+(and lispworks-64bit lispworks5.0) (64-bit-type-p type) + (eql type :pointer)) (let ((fli-type (convert-foreign-type type)) (ptr-form (if (eql off 0) ptr `(inc-pointer ,ptr ,off)))) `(setf (fli:dereference ,ptr-form :type ',fli-type) ,val)) diff --git a/external/cffi.darcs/_darcs/pristine/src/cffi-openmcl.lisp b/external/cffi.darcs/_darcs/pristine/src/cffi-openmcl.lisp index 1671004..081573f 100644 --- a/external/cffi.darcs/_darcs/pristine/src/cffi-openmcl.lisp +++ b/external/cffi.darcs/_darcs/pristine/src/cffi-openmcl.lisp @@ -28,7 +28,7 @@ ;;;# Administrivia (defpackage #:cffi-sys - (:use #:common-lisp #:ccl #:cffi-utils) + (:use #:common-lisp #:ccl #:cffi-utils #:alexandria) (:export #:canonicalize-symbol-name-case #:foreign-pointer @@ -59,20 +59,13 @@ (in-package #:cffi-sys) -;;;# Features +;;;# Mis-features (eval-when (:compile-toplevel :load-toplevel :execute) (mapc (lambda (feature) (pushnew feature *features*)) - '(;; OS/CPU features. - #+darwin-target cffi-features:darwin - #+unix cffi-features:unix - #+ppc32-target cffi-features:ppc32 - #+x8664-target cffi-features:x86-64 - ;; Misfeatures. - cffi-features:flat-namespace - ))) - -;;; Symbol case. + '(cffi-features:flat-namespace))) + +;;;# Symbol Case (defun canonicalize-symbol-name-case (name) (declare (string name)) diff --git a/external/cffi.darcs/_darcs/pristine/src/cffi-sbcl.lisp b/external/cffi.darcs/_darcs/pristine/src/cffi-sbcl.lisp index 7c93200..baf00ef 100644 --- a/external/cffi.darcs/_darcs/pristine/src/cffi-sbcl.lisp +++ b/external/cffi.darcs/_darcs/pristine/src/cffi-sbcl.lisp @@ -28,7 +28,7 @@ ;;;# Administrivia (defpackage #:cffi-sys - (:use #:common-lisp #:sb-alien #:cffi-utils) + (:use #:common-lisp #:sb-alien #:cffi-utils #:alexandria) (:export #:canonicalize-symbol-name-case #:foreign-pointer @@ -59,22 +59,13 @@ (in-package #:cffi-sys) -;;;# Features +;;;# Mis-features (eval-when (:compile-toplevel :load-toplevel :execute) (mapc (lambda (feature) (pushnew feature *features*)) - '(;; OS/CPU features. - #+darwin cffi-features:darwin - #+(and unix (not win32)) cffi-features:unix - #+win32 cffi-features:windows - #+x86 cffi-features:x86 - #+x86-64 cffi-features:x86-64 - #+(and ppc (not ppc64)) cffi-features:ppc32 - ;; Misfeatures - cffi-features:flat-namespace - ))) - -;;; Symbol case. + '(cffi-features:flat-namespace))) + +;;;# Symbol Case (declaim (inline canonicalize-symbol-name-case)) (defun canonicalize-symbol-name-case (name) @@ -350,5 +341,5 @@ WITH-POINTER-TO-VECTOR-DATA." (defun %foreign-symbol-pointer (name library) "Returns a pointer to a foreign symbol NAME." (declare (ignore library)) - (let-when (address (sb-sys:find-foreign-symbol-address name)) + (when-let (address (sb-sys:find-foreign-symbol-address name)) (sb-sys:int-sap address))) diff --git a/external/cffi.darcs/_darcs/pristine/src/cffi-scl.lisp b/external/cffi.darcs/_darcs/pristine/src/cffi-scl.lisp index 327634e..69c1ec6 100644 --- a/external/cffi.darcs/_darcs/pristine/src/cffi-scl.lisp +++ b/external/cffi.darcs/_darcs/pristine/src/cffi-scl.lisp @@ -29,7 +29,7 @@ ;;;# Administrivia (defpackage #:cffi-sys - (:use #:common-lisp #:alien #:c-call #:cffi-utils) + (:use #:common-lisp #:alien #:c-call #:cffi-utils #:alexandria) (:export #:canonicalize-symbol-name-case #:foreign-pointer @@ -60,24 +60,13 @@ (in-package #:cffi-sys) -;;;# Features +;;;# Mis-features (eval-when (:compile-toplevel :load-toplevel :execute) (mapc (lambda (feature) (pushnew feature *features*)) - '(;; OS/CPU features. - #+unix cffi-features:unix - #+x86 cffi-features:x86 - #+amd64 cffi-features:x86-64 - #+(and ppc (not ppc64)) cffi-features:ppc32 - #+sparc cffi-features:sparc - #+sparc64 cffi-features:sparc64 - #+hppa cffi-features:hppa - #+hppa64 cffi-features:hppa64 - ;; Misfeatures - cffi-features:flat-namespace - ))) - -;;; Symbol case. + '(cffi-features:flat-namespace))) + +;;;# Symbol Case (defun canonicalize-symbol-name-case (name) (declare (string name)) diff --git a/external/cffi.darcs/_darcs/pristine/src/features.lisp b/external/cffi.darcs/_darcs/pristine/src/features.lisp index cb62a65..f91ff6d 100644 --- a/external/cffi.darcs/_darcs/pristine/src/features.lisp +++ b/external/cffi.darcs/_darcs/pristine/src/features.lisp @@ -32,6 +32,11 @@ ;;; CFFI-SYS backends take care of pushing the appropriate features to ;;; *features*. See each cffi-*.lisp file. +;;; +;;; Not anymore, I think we should use TRIVIAL-FEATURES for the +;;; platform features instead. Less pain. And maybe the +;;; CFFI-specific features should be in the CFFI-SYS package, +;;; unexported? This is here now for backwards compatibility. (defpackage #:cffi-features (:use #:cl) @@ -64,8 +69,7 @@ #:sparc #:sparc64 #:hppa - #:hppa64 - )) + #:hppa64)) (in-package #:cffi-features) @@ -87,3 +91,16 @@ that belong to the CFFI-FEATURES package." (:and (every #'cffi-feature-p (rest feature-expression))) (:or (some #'cffi-feature-p (rest feature-expression))) (:not (not (cffi-feature-p (cadr feature-expression)))))))))) + +;;; for backwards compatibility +(mapc (lambda (sym) (pushnew sym *features*)) + '(#+darwin darwin + #+unix unix + #+windows windows + #+ppc ppc32 + #+x86 x86 + #+x86-64 x86-64 + #+sparc sparc + #+sparc64 sparc64 + #+hppa hppa + #+hppa64 hppa64)) diff --git a/external/cffi.darcs/_darcs/pristine/src/functions.lisp b/external/cffi.darcs/_darcs/pristine/src/functions.lisp index a8b633e..f590541 100644 --- a/external/cffi.darcs/_darcs/pristine/src/functions.lisp +++ b/external/cffi.darcs/_darcs/pristine/src/functions.lisp @@ -283,9 +283,8 @@ arguments and does type promotion for the variadic arguments." (list :calling-convention cconv))) (defmacro defcallback (name-and-options return-type args &body body) - (multiple-value-bind (body docstring declarations) - (parse-body body) - (declare (ignore docstring)) + (multiple-value-bind (body declarations) + (parse-body body :documentation t) (let ((arg-names (mapcar #'car args)) (arg-types (mapcar #'cadr args)) (name (car (ensure-list name-and-options))) diff --git a/external/cffi.darcs/_darcs/pristine/src/libraries.lisp b/external/cffi.darcs/_darcs/pristine/src/libraries.lisp index e8b0954..d2a2235 100644 --- a/external/cffi.darcs/_darcs/pristine/src/libraries.lisp +++ b/external/cffi.darcs/_darcs/pristine/src/libraries.lisp @@ -193,18 +193,18 @@ ourselves." (handler-case (%load-foreign-library name path) (error (error) - (bif (file (find-file path *foreign-library-directories*)) - (handler-case - (%load-foreign-library name (native-namestring file)) - (simple-error (error) - (report-simple-error name error))) - (report-simple-error name error))))) + (if-let (file (find-file path *foreign-library-directories*)) + (handler-case + (%load-foreign-library name (native-namestring file)) + (simple-error (error) + (report-simple-error name error))) + (report-simple-error name error))))) (defun try-foreign-library-alternatives (name library-list) "Goes through a list of alternatives and only signals an error when none of alternatives were successfully loaded." (dolist (lib library-list) - (let-when (handle (ignore-errors (load-foreign-library-helper name lib))) + (when-let (handle (ignore-errors (load-foreign-library-helper name lib))) (return-from try-foreign-library-alternatives handle))) ;; Perhaps we should show the error messages we got for each ;; alternative if we can figure out a nice way to do that. @@ -213,7 +213,8 @@ none of alternatives were successfully loaded." (defparameter *cffi-feature-suffix-map* '((cffi-features:windows . ".dll") (cffi-features:darwin . ".dylib") - (cffi-features:unix . ".so")) + (cffi-features:unix . ".so") + (t . ".so")) "Mapping of OS feature keywords to shared library suffixes.") (defun default-library-suffix () diff --git a/external/cffi.darcs/_darcs/pristine/src/package.lisp b/external/cffi.darcs/_darcs/pristine/src/package.lisp index 3b48d16..e205d74 100644 --- a/external/cffi.darcs/_darcs/pristine/src/package.lisp +++ b/external/cffi.darcs/_darcs/pristine/src/package.lisp @@ -28,7 +28,7 @@ (in-package #:cl-user) (defpackage #:cffi - (:use #:common-lisp #:cffi-sys #:cffi-utils) + (:use #:common-lisp #:cffi-sys #:cffi-utils #:alexandria #:babel-encodings) (:import-from #:cffi-features #:cffi-feature-p) (:export ;; Types. @@ -54,6 +54,7 @@ #:with-pointer-to-vector-data ;; Foreign string operations. + #:*default-foreign-encoding* #:foreign-string-alloc #:foreign-string-free #:foreign-string-to-lisp @@ -89,6 +90,7 @@ #:defbitfield #:define-foreign-type #:define-parse-method + #:define-c-struct-wrapper #:foreign-enum-keyword #:foreign-enum-keyword-list #:foreign-enum-value diff --git a/external/cffi.darcs/_darcs/pristine/src/strings.lisp b/external/cffi.darcs/_darcs/pristine/src/strings.lisp index 9148a1e..e2a1978 100644 --- a/external/cffi.darcs/_darcs/pristine/src/strings.lisp +++ b/external/cffi.darcs/_darcs/pristine/src/strings.lisp @@ -3,6 +3,7 @@ ;;; strings.lisp --- Operations on foreign strings. ;;; ;;; Copyright (C) 2005-2006, James Bielman +;;; Copyright (C) 2005-2007, Luis Oliveira ;;; ;;; Permission is hereby granted, free of charge, to any person ;;; obtaining a copy of this software and associated documentation @@ -30,109 +31,265 @@ ;;;# Foreign String Conversion ;;; ;;; Functions for converting NULL-terminated C-strings to Lisp strings -;;; and vice versa. Currently this is blithely ignorant of encoding -;;; and assumes characters can fit in 8 bits. - -(defun lisp-string-to-foreign (string ptr size) - "Copy at most SIZE-1 characters from a Lisp STRING to PTR. -The foreign string will be null-terminated." - (decf size) - (etypecase string - (string - (loop with i = 0 for char across string - while (< i size) - do (%mem-set (char-code char) ptr :unsigned-char (post-incf i)) - finally (%mem-set 0 ptr :unsigned-char i))) - ((array (unsigned-byte 8)) - (loop with i = 0 for elt across string - while (< i size) - do (%mem-set elt ptr :unsigned-char (post-incf i)) - finally (%mem-set 0 ptr :unsigned-char i))))) - -(defun foreign-string-to-lisp (ptr &optional (size array-total-size-limit) - (null-terminated-p t)) - "Copy at most SIZE characters from PTR into a Lisp string. -If PTR is a null pointer, returns nil." - (unless (null-pointer-p ptr) - (with-output-to-string (s) - (loop for i fixnum from 0 below size - for code = (mem-ref ptr :unsigned-char i) - until (and null-terminated-p (zerop code)) - do (write-char (code-char code) s))))) +;;; and vice versa. The string functions accept an ENCODING keyword +;;; argument which is used to specify the encoding to use when +;;; converting to/from foreign strings. + +(defvar *default-foreign-encoding* :utf-8 + "Default foreign encoding.") + +;;; TODO: refactor, sigh. Also, this should probably be a function. +(defmacro bget (ptr off &optional (bytes 1) (endianness :ne)) + (let ((big-endian (member endianness + '(:be #+big-endian :ne #+little-endian :re)))) + (once-only (ptr off) + (ecase bytes + (1 `(mem-ref ,ptr :uint8 ,off)) + (2 (if big-endian + #+big-endian + `(mem-ref ,ptr :uint16 ,off) + #-big-endian + `(dpb (mem-ref ,ptr :uint8 ,off) (byte 8 8) + (mem-ref ,ptr :uint8 (1+ ,off))) + #+little-endian + `(mem-ref ,ptr :uint16 ,off) + #-little-endian + `(dpb (mem-ref ,ptr :uint8 (1+ ,off)) (byte 8 8) + (mem-ref ,ptr :uint8 ,off)))) + (4 (if big-endian + #+big-endian + `(mem-ref ,ptr :uint32 ,off) + #-big-endian + `(dpb (mem-ref ,ptr :uint8 ,off) (byte 8 24) + (dpb (mem-ref ,ptr :uint8 (1+ ,off)) (byte 8 16) + (dpb (mem-ref ,ptr :uint8 (+ ,off 2)) (byte 8 8) + (mem-ref ,ptr :uint8 (+ ,off 3))))) + #+little-endian + `(mem-ref ,ptr :uint32 ,off) + #-little-endian + `(dpb (mem-ref ,ptr :uint8 (+ ,off 3)) (byte 8 24) + (dpb (mem-ref ,ptr :uint8 (+ ,off 2)) (byte 8 16) + (dpb (mem-ref ,ptr :uint8 (1+ ,off)) (byte 8 8) + (mem-ref ,ptr :uint8 ,off)))))))))) + +(defmacro bset (val ptr off &optional (bytes 1) (endianness :ne)) + (let ((big-endian (member endianness + '(:be #+big-endian :ne #+little-endian :re)))) + (ecase bytes + (1 `(setf (mem-ref ,ptr :uint8 ,off) ,val)) + (2 (if big-endian + #+big-endian + `(setf (mem-ref ,ptr :uint16 ,off) ,val) + #-big-endian + `(setf (mem-ref ,ptr :uint8 (1+ ,off)) (ldb (byte 8 0) val) + (mem-ref ,ptr :uint8 ,off) (ldb (byte 8 8) val)) + #+little-endian + `(setf (mem-ref ,ptr :uint16 ,off) ,val) + #-little-endian + `(setf (mem-ref ,ptr :uint8 ,off) (ldb (byte 8 0) val) + (mem-ref ,ptr :uint8 (1+ ,off)) (ldb (byte 8 8) val)))) + (4 (if big-endian + #+big-endian + `(setf (mem-ref ,ptr :uint32 ,off) ,val) + #-big-endian + `(setf (mem-ref ,ptr :uint8 (+ 3 ,off)) (ldb (byte 8 0) val) + (mem-ref ,ptr :uint8 (+ 2 ,off)) (ldb (byte 8 8) val) + (mem-ref ,ptr :uint8 (1+ ,off)) (ldb (byte 8 16) val) + (mem-ref ,ptr :uint8 ,off) (ldb (byte 8 24) val)) + #+little-endian + `(setf (mem-ref ,ptr :uint32 ,off) ,val) + #-little-endian + `(setf (mem-ref ,ptr :uint8 ,off) (ldb (byte 8 0) val) + (mem-ref ,ptr :uint8 (1+ ,off)) (ldb (byte 8 8) val) + (mem-ref ,ptr :uint8 (+ ,off 2)) (ldb (byte 8 16) val) + (mem-ref ,ptr :uint8 (+ ,off 3)) (ldb (byte 8 24) val))))))) + +;;; TODO: tackle optimization notes. +(defparameter *foreign-string-mappings* + (instantiate-concrete-mappings + ;; :optimize ((speed 3) (debug 0) (compilation-speed 0) (safety 0)) + :octet-seq-getter bget + :octet-seq-setter bset + :octet-seq-type foreign-pointer + :code-point-seq-getter babel::string-get + :code-point-seq-setter babel::string-set + :code-point-seq-type babel:simple-unicode-string)) + +(defun null-terminator-len (encoding) + (length (enc-nul-encoding (get-character-encoding encoding)))) + +(defun lisp-string-to-foreign (string buffer bufsize &key (start 0) end offset + (encoding *default-foreign-encoding*)) + (check-type string string) + (when offset + (setq buffer (inc-pointer buffer offset))) + (with-checked-simple-vector ((string (coerce string 'babel:unicode-string)) + (start start) (end end)) + (declare (type simple-string string)) + (let ((mapping (lookup-mapping *foreign-string-mappings* encoding)) + (nul-len (null-terminator-len encoding))) + (assert (plusp bufsize)) + (multiple-value-bind (size end) + (funcall (octet-counter mapping) string start end (- bufsize nul-len)) + (funcall (encoder mapping) string start end buffer 0) + (dotimes (i nul-len) + (setf (mem-ref buffer :char (+ size i)) 0)))) + buffer)) + +;;; Expands into a loop that calculates the length of the foreign +;;; string at PTR plus OFFSET, using ACCESSOR and looking for a null +;;; terminator of LENGTH bytes. +(defmacro %foreign-string-length (ptr offset type length) + (once-only (ptr offset) + `(do ((i 0 (+ i ,length))) + ((zerop (mem-ref ,ptr ,type (+ ,offset i))) i) + (declare (fixnum i))))) + +;;; Return the length in octets of the null terminated foreign string +;;; at POINTER plus OFFSET octets, assumed to be encoded in ENCODING, +;;; a CFFI encoding. This should be smart enough to look for 8-bit vs +;;; 16-bit null terminators, as appropriate for the encoding. +(defun foreign-string-length (pointer &key (encoding *default-foreign-encoding*) + (offset 0)) + (ecase (null-terminator-len encoding) + (1 (%foreign-string-length pointer offset :uint8 1)) + (2 (%foreign-string-length pointer offset :uint16 2)) + (4 (%foreign-string-length pointer offset :uint32 4)))) + +(defun foreign-string-to-lisp (pointer &key (offset 0) count + (max-chars (1- array-total-size-limit)) + (encoding *default-foreign-encoding*)) + "Copy at most COUNT bytes from POINTER plus OFFSET encoded in +ENCODING into a Lisp string and return it. If POINTER is a null +pointer, NIL is returned." + (unless (null-pointer-p pointer) + (let ((count (or count + (foreign-string-length + pointer :encoding encoding :offset offset))) + (mapping (lookup-mapping *foreign-string-mappings* encoding))) + (assert (plusp max-chars)) + (multiple-value-bind (size new-end) + (funcall (code-point-counter mapping) + pointer offset (+ offset count) max-chars) + (let ((string (make-string size))) + (funcall (decoder mapping) pointer offset new-end string 0) + (values string (- new-end offset))))))) ;;;# Using Foreign Strings -(defun foreign-string-alloc (string) +(defun foreign-string-alloc (string &key (encoding *default-foreign-encoding*) + (null-terminated-p t) (start 0) end) "Allocate a foreign string containing Lisp string STRING. The string must be freed with FOREIGN-STRING-FREE." - (check-type string (or string (array (unsigned-byte 8)))) - (let* ((length (1+ (length string))) - (ptr (foreign-alloc :char :count length))) - (lisp-string-to-foreign string ptr length) - ptr)) + (check-type string string) + (with-checked-simple-vector ((string (coerce string 'babel:unicode-string)) + (start start) (end end)) + (declare (type simple-string string)) + (let* ((mapping (lookup-mapping *foreign-string-mappings* encoding)) + (count (funcall (octet-counter mapping) string start end 0)) + (length (if null-terminated-p + (+ count (null-terminator-len encoding)) + count)) + (ptr (foreign-alloc :char :count length))) + (funcall (encoder mapping) string start end ptr 0) + (when null-terminated-p + (dotimes (i (null-terminator-len encoding)) + (setf (mem-ref ptr :char (+ count i)) 0))) + (values ptr length)))) (defun foreign-string-free (ptr) "Free a foreign string allocated by FOREIGN-STRING-ALLOC." (foreign-free ptr)) -(defmacro with-foreign-string ((var lisp-string) &body body) - "Bind VAR to a foreign string containing LISP-STRING in BODY." - (with-unique-names (str length) - `(let* ((,str ,lisp-string) - (,length (progn - (check-type ,str (or string (array (unsigned-byte 8)))) - (1+ (length ,str))))) - (with-foreign-pointer (,var ,length) - (lisp-string-to-foreign ,str ,var ,length) - ,@body)))) +(defmacro with-foreign-string ((var-or-vars lisp-string &rest args) &body body) + "VAR-OR-VARS is not evaluated ans should a list of the form +\(VAR &OPTIONAL BYTE-SIZE-VAR) or just a VAR symbol. VAR is +bound to a foreign string containing LISP-STRING in BODY. When +BYTE-SIZE-VAR is specified then bind the C buffer size +\(including the possible null terminator\(s)) to this variable." + (destructuring-bind (var &optional size-var) + (ensure-list var-or-vars) + `(multiple-value-bind (,var ,@(when size-var (list size-var))) + (foreign-string-alloc ,lisp-string ,@args) + (unwind-protect + (progn ,@body) + (foreign-string-free ,var))))) (defmacro with-foreign-strings (bindings &body body) + "See WITH-FOREIGN-STRING's documentation." (if bindings `(with-foreign-string ,(first bindings) (with-foreign-strings ,(rest bindings) ,@body)) `(progn ,@body))) -(defmacro with-foreign-pointer-as-string ((var size &optional size-var) - &body body) - "Like WITH-FOREIGN-POINTER except VAR as a Lisp string is used as -the return value of an implicit PROGN around BODY." - `(with-foreign-pointer (,var ,size ,size-var) - (progn - ,@body - (foreign-string-to-lisp ,var)))) +(defmacro with-foreign-pointer-as-string + ((var-or-vars size &rest args) &body body) + "VAR-OR-VARS is not evaluated and should be a list of the form +\(VAR &OPTIONAL SIZE-VAR) or just a VAR symbol. VAR is bound to +a foreign buffer of size SIZE within BODY. The return value is +constructed by calling FOREIGN-STRING-TO-LISP on the foreign +buffer along with ARGS." ; fix wording, sigh + (destructuring-bind (var &optional size-var) + (ensure-list var-or-vars) + `(with-foreign-pointer (,var ,size ,size-var) + (progn + ,@body + (values (foreign-string-to-lisp ,var ,@args)))))) ;;;# Automatic Conversion of Foreign Strings (define-foreign-type foreign-string-type () - () + (;; CFFI encoding of this string. + (encoding :initform nil :initarg :encoding :reader encoding) + ;; Should we free after translating from foreign? + (free-from-foreign :initarg :free-from-foreign + :reader fst-free-from-foreign-p + :initform nil :type boolean) + ;; Should we free after translating to foreign? + (free-to-foreign :initarg :free-to-foreign + :reader fst-free-to-foreign-p + :initform t :type boolean)) (:actual-type :pointer) (:simple-parser :string)) +;;; describe me +(defun fst-encoding (type) + (or (encoding type) *default-foreign-encoding*)) + +;;; Display the encoding when printing a FOREIGN-STRING-TYPE instance. +(defmethod print-object ((type foreign-string-type) stream) + (print-unreadable-object (type stream :type t) + (format stream "~S" (fst-encoding type)))) + (defmethod translate-to-foreign ((s string) (type foreign-string-type)) - (values (foreign-string-alloc s) t)) + (values (foreign-string-alloc s :encoding (fst-encoding type)) + (fst-free-to-foreign-p type))) (defmethod translate-to-foreign (obj (type foreign-string-type)) (cond ((pointerp obj) (values obj nil)) - ((typep obj '(array (unsigned-byte 8))) - (values (foreign-string-alloc obj) t)) - (t (error "~A is not a Lisp string, (array (unsigned-byte 8)) or pointer." - obj)))) + ;; FIXME: we used to support UB8 vectors but not anymore. + ;; ((typep obj '(array (unsigned-byte 8))) + ;; (values (foreign-string-alloc obj) t)) + (t (error "~A is not a Lisp string or pointer." obj)))) (defmethod translate-from-foreign (ptr (type foreign-string-type)) - (foreign-string-to-lisp ptr)) + (unwind-protect + (values (foreign-string-to-lisp ptr :encoding (fst-encoding type))) + (when (fst-free-from-foreign-p type) + (foreign-free ptr)))) (defmethod free-translated-object (ptr (type foreign-string-type) free-p) (when free-p (foreign-string-free ptr))) -;;; STRING+PTR +;;;# STRING+PTR (define-foreign-type foreign-string+ptr-type (foreign-string-type) () (:simple-parser :string+ptr)) (defmethod translate-from-foreign (value (type foreign-string+ptr-type)) - (list (foreign-string-to-lisp value) value)) + (list (call-next-method) value)) diff --git a/external/cffi.darcs/_darcs/pristine/src/types.lisp b/external/cffi.darcs/_darcs/pristine/src/types.lisp index 3773296..49227ba 100644 --- a/external/cffi.darcs/_darcs/pristine/src/types.lisp +++ b/external/cffi.darcs/_darcs/pristine/src/types.lisp @@ -47,6 +47,52 @@ (define-built-in-foreign-type :long-long) (define-built-in-foreign-type :unsigned-long-long)) +;;; Define emulated LONG-LONG types. Needs checking whether we're +;;; using the right sizes on various platforms. +;;; +;;; A possibly better, certainly faster though more intrusive, +;;; alternative is available here: +;;; +#+cffi-features:no-long-long +(eval-when (:compile-toplevel :load-toplevel :execute) + (defclass emulated-llong-type (foreign-type) ()) + (defmethod foreign-type-size ((tp emulated-llong-type)) 8) + (defmethod foreign-type-alignment ((tp emulated-llong-type)) 8) + (defmethod aggregatep ((tp emulated-llong-type)) nil) + + (define-foreign-type emulated-llong (emulated-llong-type) + () + (:simple-parser :long-long)) + + (define-foreign-type emulated-ullong (emulated-llong-type) + () + (:simple-parser :unsigned-long-long)) + + (defmethod canonicalize ((tp emulated-llong)) :long-long) + (defmethod unparse-type ((tp emulated-llong)) :long-long) + (defmethod canonicalize ((tp emulated-ullong)) :unsigned-long-long) + (defmethod unparse-type ((tp emulated-ullong)) :unsigned-long-long) + + (defun %emulated-mem-ref-64 (ptr type offset) + (let ((value #+big-endian + (+ (ash (mem-ref ptr :unsigned-long offset) 32) + (mem-ref ptr :unsigned-long (+ offset 4))) + #+little-endian + (+ (mem-ref ptr :unsigned-long offset) + (ash (mem-ref ptr :unsigned-long (+ offset 4)) -32)))) + (if (and (eq type :long-long) (logbitp 63 value)) + (lognot (logxor value #xFFFFFFFFFFFFFFFF)) + value))) + + (defun %emulated-mem-set-64 (value ptr type offset) + (when (and (eq type :long-long) (minusp value)) + (setq value (lognot (logxor value #xFFFFFFFFFFFFFFFF)))) + (%mem-set (ldb (byte 32 0) value) ptr :unsigned-long + #+big-endian (+ offset 4) #+little-endian offset) + (%mem-set (ldb (byte 32 32) value) ptr :unsigned-long + #+big-endian offset #+little-endian (+ offset 4)) + value)) + ;;; When some lisp other than SCL supports :long-double we should ;;; use #-cffi-features:no-long-double here instead. #+(and scl long-float) (define-built-in-foreign-type :long-double) @@ -61,25 +107,39 @@ we don't return its 'value' but a pointer to it, which is PTR itself." (let ((ptype (parse-type type))) (if (aggregatep ptype) (inc-pointer ptr offset) - (let ((raw-value (%mem-ref ptr (canonicalize ptype) offset))) - (translate-from-foreign raw-value ptype))))) + (let ((ctype (canonicalize ptype))) + #+cffi-features:no-long-long + (when (or (eq ctype :long-long) (eq ctype :unsigned-long-long)) + (return-from mem-ref + (translate-from-foreign (%emulated-mem-ref-64 ptr ctype offset) + ptype))) + ;; normal branch + (translate-from-foreign (%mem-ref ptr ctype offset) ptype))))) (define-compiler-macro mem-ref (&whole form ptr type &optional (offset 0)) "Compiler macro to open-code MEM-REF when TYPE is constant." (if (constantp type) - (let ((parsed-type (parse-type (eval type)))) + (let* ((parsed-type (parse-type (eval type))) + (ctype (canonicalize parsed-type))) + ;; Bail out when using emulated long long types. + #+cffi-features:no-long-long + (when (member ctype '(:long-long :unsigned-long-long)) + (return-from mem-ref form)) (if (aggregatep parsed-type) `(inc-pointer ,ptr ,offset) - (expand-from-foreign - `(%mem-ref ,ptr ,(canonicalize parsed-type) ,offset) - parsed-type))) + (expand-from-foreign `(%mem-ref ,ptr ,ctype ,offset) parsed-type))) form)) (defun mem-set (value ptr type &optional (offset 0)) "Set the value of TYPE at OFFSET bytes from PTR to VALUE." - (let ((ptype (parse-type type))) - (%mem-set (translate-to-foreign value ptype) - ptr (canonicalize ptype) offset))) + (let* ((ptype (parse-type type)) + (ctype (canonicalize ptype))) + #+cffi-features:no-long-long + (when (or (eq ctype :long-long) (eq ctype :unsigned-long-long)) + (return-from mem-set + (%emulated-mem-set-64 (translate-to-foreign value ptype) + ptr ctype offset))) + (%mem-set (translate-to-foreign value ptype) ptr ctype offset))) (define-setf-expander mem-ref (ptr type &optional (offset 0) &environment env) "SETF expander for MEM-REF that doesn't rebind TYPE. @@ -112,9 +172,13 @@ to open-code (SETF MEM-REF) forms." (&whole form value ptr type &optional (offset 0)) "Compiler macro to open-code (SETF MEM-REF) when type is constant." (if (constantp type) - (let ((parsed-type (parse-type (eval type)))) - `(%mem-set ,(expand-to-foreign value parsed-type) ,ptr - ,(canonicalize parsed-type) ,offset)) + (let* ((parsed-type (parse-type (eval type))) + (ctype (canonicalize parsed-type))) + ;; Bail out when using emulated long long types. + #+cffi-features:no-long-long + (when (member ctype '(:long-long :unsigned-long-long)) + (return-from mem-set form)) + `(%mem-set ,(expand-to-foreign value parsed-type) ,ptr ,ctype ,offset)) form)) ;;;# Dereferencing Foreign Arrays @@ -446,9 +510,9 @@ The foreign array must be freed with foreign-array-free." "Return alignment for TYPE according to ALIGNMENT-TYPE." (declare (ignorable firstp)) (ecase alignment-type - (:normal #-(and cffi-features:darwin cffi-features:ppc32) + (:normal #-(and darwin ppc) (foreign-type-alignment type) - #+(and cffi-features:darwin cffi-features:ppc32) + #+(and darwin ppc) (if firstp (foreign-type-alignment type) (min 4 (foreign-type-alignment type)))))) @@ -497,7 +561,7 @@ The foreign array must be freed with foreign-array-free." (discard-docstring fields) `(eval-when (:compile-toplevel :load-toplevel :execute) ;; n-f-s-d could do with this with mop:ensure-class. - ,(let-when (class (getf (cdr (ensure-list name-and-options)) :class)) + ,(when-let (class (getf (cdr (ensure-list name-and-options)) :class)) `(defclass ,class (foreign-struct-type) ())) (notice-foreign-struct-definition ',name-and-options ',fields))) @@ -580,6 +644,35 @@ foreign slots in PTR of TYPE. Similar to WITH-SLOTS." collect `(,var (foreign-slot-value ,ptr-var ',type ',var))) ,@body)))) +;;; We could add an option to define a struct instead of a class, in +;;; the unlikely event someone needs something like that. +(defmacro define-c-struct-wrapper (class-and-type supers &optional slots) + "Define a new class with CLOS slots matching those of a foreign +struct type. An INITIALIZE-INSTANCE method is defined which +takes a :POINTER initarg that is used to store the slots of a +foreign object. This pointer is only used for initialization and +it is not retained. + +CLASS-AND-TYPE is either a list of the form (class-name +struct-type) or a single symbol naming both. The class will +inherit SUPERS. If a list of SLOTS is specified, only those +slots will be defined and stored." + (destructuring-bind (class-name &optional (struct-type class-name)) + (ensure-list class-and-type) + (let ((slots (or slots (foreign-slot-names struct-type)))) + `(progn + (defclass ,class-name ,supers + ,(loop for slot in slots collect + (list slot :reader (symbolicate class-name "-" slot)))) + ;; This could be done in a parent class by using + ;; FOREIGN-SLOT-NAMES when instantiating but then the compiler + ;; macros wouldn't kick in. + (defmethod initialize-instance :after ((inst ,class-name) &key pointer) + (with-foreign-slots (,slots pointer ,struct-type) + ,@(loop for slot in slots collect + `(setf (slot-value inst ',slot) ,slot)))) + ',class-name)))) + ;;;# Foreign Unions ;;; ;;; A union is a FOREIGN-STRUCT-TYPE in which all slots have an offset @@ -753,11 +846,8 @@ The buffer has dynamic extent and may be stack allocated." (defctype :ushort :unsigned-short) (defctype :uint :unsigned-int) (defctype :ulong :unsigned-long) - -#-cffi-features:no-long-long -(progn - (defctype :llong :long-long) - (defctype :ullong :unsigned-long-long)) +(defctype :llong :long-long) +(defctype :ullong :unsigned-long-long) ;;; We try to define the :[u]int{8,16,32,64} types by looking at ;;; the sizes of the built-in integer types and defining typedefs. @@ -765,14 +855,18 @@ The buffer has dynamic extent and may be stack allocated." (macrolet ((match-types (sized-types mtypes) `(progn - ,@(loop for (type . size) in sized-types - for m = (car (member size mtypes :key #'foreign-type-size)) + ,@(loop for (type . size-or-type) in sized-types + for m = (car (member (if (keywordp size-or-type) + (foreign-type-size size-or-type) + size-or-type) + mtypes :key #'foreign-type-size)) when m collect `(defctype ,type ,m))))) ;; signed - (match-types ((:int8 . 1) (:int16 . 2) (:int32 . 4) (:int64 . 8)) - (:char :short :int :long - #-cffi-features:no-long-long :long-long)) + (match-types ((:int8 . 1) (:int16 . 2) (:int32 . 4) (:int64 . 8) + (:intptr . :pointer)) + (:char :short :int :long :long-long)) ;; unsigned - (match-types ((:uint8 . 1) (:uint16 . 2) (:uint32 . 4) (:uint64 . 8)) + (match-types ((:uint8 . 1) (:uint16 . 2) (:uint32 . 4) (:uint64 . 8) + (:uintptr . :pointer)) (:unsigned-char :unsigned-short :unsigned-int :unsigned-long - #-cffi-features:no-long-long :unsigned-long-long)))) + :unsigned-long-long)))) diff --git a/external/cffi.darcs/_darcs/pristine/src/utils.lisp b/external/cffi.darcs/_darcs/pristine/src/utils.lisp index 0f19576..a20857d 100644 --- a/external/cffi.darcs/_darcs/pristine/src/utils.lisp +++ b/external/cffi.darcs/_darcs/pristine/src/utils.lisp @@ -27,17 +27,12 @@ (in-package #:cl-user) +;;; This package is for CFFI's internal use. No effort is made to +;;; maintain backwards compatibility. Use at your own risk. (defpackage #:cffi-utils - (:use #:common-lisp) + (:use #:common-lisp #:alexandria) (:export #:discard-docstring - #:parse-body - #:with-unique-names - #:once-only - #:ensure-list - #:make-gensym-list #:symbolicate - #:let-when - #:bif #:post-incf #:single-bit-p #:warn-if-kw-or-belongs-to-cl)) @@ -56,42 +51,12 @@ (setq ,(car new) (+ ,(car new) ,delta)) ,setter)))) -(defun ensure-list (x) - "Make into list if atom." - (if (listp x) x (list x))) - (defmacro discard-docstring (body-var &optional force) "Discards the first element of the list in body-var if it's a string and the only element (or if FORCE is T)." `(when (and (stringp (car ,body-var)) (or ,force (cdr ,body-var))) (pop ,body-var))) -;;; Parse a body of code, removing an optional documentation string -;;; and declaration forms. Returns the actual body, docstring, and -;;; declarations as three multiple values. -(defun parse-body (body) - (let ((docstring nil) - (declarations nil)) - (when (and (stringp (car body)) (cdr body)) - (setf docstring (pop body))) - (loop while (and (consp (car body)) (eql (caar body) 'cl:declare)) - do (push (pop body) declarations)) - (values body docstring (nreverse declarations)))) - -;;; LET-IF (renamed to BIF) and LET-WHEN taken from KMRCL -(defmacro let-when ((var test-form) &body body) - `(let ((,var ,test-form)) - (when ,var ,@body))) - -(defmacro bif ((var test-form) if-true &optional if-false) - `(let ((,var ,test-form)) - (if ,var ,if-true ,if-false))) - -;;; ONCE-ONLY macro taken from PAIP -(defun starts-with (list x) - "Is x a list whose first element is x?" - (and (consp list) (eql (first list) x))) - (defun side-effect-free? (exp) "Is exp a constant, variable, or function, or of the form (THE type x) where x is side-effect-free?" @@ -100,49 +65,9 @@ string and the only element (or if FORCE is T)." (and (starts-with exp 'the) (side-effect-free? (third exp))))) -(defmacro once-only (variables &rest body) - "Returns the code built by BODY. If any of VARIABLES - might have side effects, they are evaluated once and stored - in temporary variables that are then passed to BODY." - (assert (every #'symbolp variables)) - (let ((temps nil)) - (dotimes (i (length variables)) (push (gensym "ONCE") temps)) - `(if (every #'side-effect-free? (list .,variables)) - (progn .,body) - (list 'let - ,`(list ,@(mapcar #'(lambda (tmp var) - `(list ',tmp ,var)) - temps variables)) - (let ,(mapcar #'(lambda (var tmp) `(,var ',tmp)) - variables temps) - .,body))))) - ;;;; The following utils were taken from SBCL's ;;;; src/code/*-extensions.lisp -;;; Automate an idiom often found in macros: -;;; (LET ((FOO (GENSYM "FOO")) -;;; (MAX-INDEX (GENSYM "MAX-INDEX-"))) -;;; ...) -;;; -;;; "Good notation eliminates thought." -- Eric Siggia -;;; -;;; Incidentally, this is essentially the same operator which -;;; _On Lisp_ calls WITH-GENSYMS. -(defmacro with-unique-names (symbols &body body) - `(let ,(mapcar (lambda (symbol) - (let* ((symbol-name (symbol-name symbol)) - (stem (if (every #'alpha-char-p symbol-name) - symbol-name - (concatenate 'string symbol-name "-")))) - `(,symbol (gensym ,stem)))) - symbols) - ,@body)) - -(defun make-gensym-list (n) - "Return a list of N gensyms." - (loop repeat n collect (gensym))) - (defun symbolicate (&rest things) "Concatenate together the names of some strings and symbols, producing a symbol in the current package." diff --git a/external/cffi.darcs/_darcs/pristine/tests/defcfun.lisp b/external/cffi.darcs/_darcs/pristine/tests/defcfun.lisp index d698b21..52d5fcb 100644 --- a/external/cffi.darcs/_darcs/pristine/tests/defcfun.lisp +++ b/external/cffi.darcs/_darcs/pristine/tests/defcfun.lisp @@ -156,6 +156,9 @@ (control :string) &rest) +;;; CLISP's compiler discards macro docstrings. +#+clisp (pushnew 'defcfun.varargs.docstrings rt::*expected-failures*) + (deftest defcfun.varargs.docstrings (documentation 'sprintf 'function) "sprintf docstring") @@ -195,7 +198,7 @@ (with-foreign-pointer-as-string (s 100) (setf (mem-ref s :char) 0) (sprintf s "%.2Lf" :long-double pi)) - "3.14") + "3.14" 4) (deftest defcfun.varargs.string (with-foreign-pointer-as-string (s 100) @@ -207,7 +210,8 @@ ;;; (c-function rettype arg-types) ;;; (gen-function-test rettype arg-types)) -#+(:and (:not :ecl) #.(cl:if (cl:>= cl:lambda-parameters-limit 127) '(:and) '(:or))) +#+(and (not ecl) + #.(cl:if (cl:>= cl:lambda-parameters-limit 127) '(:and) '(:or))) (progn (defcfun "sum_127_no_ll" :long (a1 :long) (a2 :unsigned-long) (a3 :short) (a4 :unsigned-short) (a5 :float) diff --git a/external/cffi.darcs/_darcs/pristine/tests/foreign-globals.lisp b/external/cffi.darcs/_darcs/pristine/tests/foreign-globals.lisp index bff6471..ee12d12 100644 --- a/external/cffi.darcs/_darcs/pristine/tests/foreign-globals.lisp +++ b/external/cffi.darcs/_darcs/pristine/tests/foreign-globals.lisp @@ -27,23 +27,20 @@ (in-package #:cffi-tests) -(defcvar ("var_char" *char-var*) :char) -(defcvar "var_unsigned_char" :unsigned-char) -(defcvar "var_short" :short) -(defcvar "var_unsigned_short" :unsigned-short) -(defcvar "var_int" :int) -(defcvar "var_unsigned_int" :unsigned-int) -(defcvar "var_long" :long) -(defcvar "var_unsigned_long" :unsigned-long) -(defcvar "var_float" :float) -(defcvar "var_double" :double) -(defcvar "var_pointer" :pointer) -(defcvar "var_string" :string) - -#-cffi-features:no-long-long -(progn - (defcvar "var_long_long" :long-long) - (defcvar "var_unsigned_long_long" :unsigned-long-long)) +(defcvar ("var_char" *char-var*) :char) +(defcvar "var_unsigned_char" :unsigned-char) +(defcvar "var_short" :short) +(defcvar "var_unsigned_short" :unsigned-short) +(defcvar "var_int" :int) +(defcvar "var_unsigned_int" :unsigned-int) +(defcvar "var_long" :long) +(defcvar "var_unsigned_long" :unsigned-long) +(defcvar "var_float" :float) +(defcvar "var_double" :double) +(defcvar "var_pointer" :pointer) +(defcvar "var_string" :string) +(defcvar "var_long_long" :long-long) +(defcvar "var_unsigned_long_long" :unsigned-long-long) (deftest foreign-globals.ref.char *char-var* @@ -93,17 +90,15 @@ *var-string* "Hello, foreign world!") -#-cffi-features:no-long-long -(progn - #+openmcl (push 'foreign-globals.set.long-long rt::*expected-failures*) +#+openmcl (push 'foreign-globals.set.long-long rt::*expected-failures*) - (deftest foreign-globals.ref.long-long - *var-long-long* - -9223372036854775807) +(deftest foreign-globals.ref.long-long + *var-long-long* + -9223372036854775807) - (deftest foreign-globals.ref.unsigned-long-long - *var-unsigned-long-long* - 18446744073709551615)) +(deftest foreign-globals.ref.unsigned-long-long + *var-unsigned-long-long* + 18446744073709551615) ;; The *.set.* tests restore the old values so that the *.ref.* ;; don't fail when re-run. @@ -129,7 +124,6 @@ (foreign-free (mem-ref (get-var-pointer '*var-string*) :pointer)))) "Ehxosxangxo") -#-cffi-features:no-long-long (deftest foreign-globals.set.long-long (with-old-value-restored (*var-long-long*) (setq *var-long-long* -9223000000000005808) diff --git a/external/cffi.darcs/_darcs/pristine/tests/memory.lisp b/external/cffi.darcs/_darcs/pristine/tests/memory.lisp index 72755d2..dfaff42 100644 --- a/external/cffi.darcs/_darcs/pristine/tests/memory.lisp +++ b/external/cffi.darcs/_darcs/pristine/tests/memory.lisp @@ -75,22 +75,20 @@ (mem-ref p :unsigned-long)) 536870912) -#-cffi-features:no-long-long -(progn - #+(and cffi-features:darwin openmcl) - (pushnew 'deref.long-long rt::*expected-failures*) +#+(and cffi-features:darwin openmcl) +(pushnew 'deref.long-long rt::*expected-failures*) - (deftest deref.long-long - (with-foreign-object (p :long-long) - (setf (mem-ref p :long-long) -9223372036854775807) - (mem-ref p :long-long)) - -9223372036854775807) +(deftest deref.long-long + (with-foreign-object (p :long-long) + (setf (mem-ref p :long-long) -9223372036854775807) + (mem-ref p :long-long)) + -9223372036854775807) - (deftest deref.unsigned-long-long - (with-foreign-object (p :unsigned-long-long) - (setf (mem-ref p :unsigned-long-long) 18446744073709551615) - (mem-ref p :unsigned-long-long)) - 18446744073709551615)) +(deftest deref.unsigned-long-long + (with-foreign-object (p :unsigned-long-long) + (setf (mem-ref p :unsigned-long-long) 18446744073709551615) + (mem-ref p :unsigned-long-long)) + 18446744073709551615) (deftest deref.float.1 (with-foreign-object (p :float) @@ -454,24 +452,22 @@ (mem-ref p type))) 536870912) -#-cffi-features:no-long-long -(progn - #+(and cffi-features:darwin openmcl) - (pushnew 'deref.nonconst.long-long rt::*expected-failures*) - - (deftest deref.nonconst.long-long - (let ((type :long-long)) - (with-foreign-object (p type) - (setf (mem-ref p type) -9223372036854775807) - (mem-ref p type))) - -9223372036854775807) - - (deftest deref.nonconst.unsigned-long-long - (let ((type :unsigned-long-long)) - (with-foreign-object (p type) - (setf (mem-ref p type) 18446744073709551615) - (mem-ref p type))) - 18446744073709551615)) +#+(and cffi-features:darwin openmcl) +(pushnew 'deref.nonconst.long-long rt::*expected-failures*) + +(deftest deref.nonconst.long-long + (let ((type :long-long)) + (with-foreign-object (p type) + (setf (mem-ref p type) -9223372036854775807) + (mem-ref p type))) + -9223372036854775807) + +(deftest deref.nonconst.unsigned-long-long + (let ((type :unsigned-long-long)) + (with-foreign-object (p type) + (setf (mem-ref p type) 18446744073709551615) + (mem-ref p type))) + 18446744073709551615) (deftest deref.nonconst.float.1 (let ((type :float)) diff --git a/external/cffi.darcs/_darcs/pristine/tests/misc-types.lisp b/external/cffi.darcs/_darcs/pristine/tests/misc-types.lisp index b8871ae..b852a6e 100644 --- a/external/cffi.darcs/_darcs/pristine/tests/misc-types.lisp +++ b/external/cffi.darcs/_darcs/pristine/tests/misc-types.lisp @@ -36,6 +36,7 @@ string) "foo") +#-(and) (deftest misc-types.string+ptr.ub8 (destructuring-bind (string pointer) (strdup (make-array 3 :element-type '(unsigned-byte 8) @@ -44,6 +45,7 @@ string) "foo") +#-(and) (deftest misc-types.string.ub8.1 (let ((array (make-array 7 :element-type '(unsigned-byte 8) :initial-contents '(84 117 114 97 110 103 97)))) @@ -51,6 +53,7 @@ (foreign-string-to-lisp foreign-string))) "Turanga") +#-(and) (deftest misc-types.string.ub8.2 (let ((str (foreign-string-alloc (make-array 7 :element-type '(unsigned-byte 8) @@ -126,12 +129,9 @@ "Strdup says: MORE CODE") (deftest misc-types.sized-ints - (mapcar #'foreign-type-size '(:int8 :uint8 :int16 :uint16 :int32 :uint32 - #-cffi-features:no-long-long :int64 - #-cffi-features:no-long-long :uint64)) - (1 1 2 2 4 4 - #-cffi-features:no-long-long 8 - #-cffi-features:no-long-long 8)) + (mapcar #'foreign-type-size + '(:int8 :uint8 :int16 :uint16 :int32 :uint32 :int64 :uint64)) + (1 1 2 2 4 4 8 8)) (define-foreign-type error-error () () diff --git a/external/cffi.darcs/_darcs/pristine/tests/struct.lisp b/external/cffi.darcs/_darcs/pristine/tests/struct.lisp index 1a5a568..e4aedc8 100644 --- a/external/cffi.darcs/_darcs/pristine/tests/struct.lisp +++ b/external/cffi.darcs/_darcs/pristine/tests/struct.lisp @@ -213,30 +213,26 @@ 'another-short another-short))) (a-double 1.0d0 a-short 2 a-char 3 another-short 4)) +(defcstruct s-long-long + (a-long-long :long-long) + (a-short :short)) -#-cffi-features:no-long-long -(progn - (defcstruct s-long-long - (a-long-long :long-long) - (a-short :short)) - - (defcstruct s-s-long-long - (a-char :char) - (a-s-long-long s-long-long) - (another-short :short)) - - (defcvar "the_s_s_long_long" s-s-long-long) +(defcstruct s-s-long-long + (a-char :char) + (a-s-long-long s-long-long) + (another-short :short)) - (deftest struct.alignment.6 - (with-foreign-slots - ((a-char a-s-long-long another-short) *the-s-s-long-long* s-s-long-long) - (with-foreign-slots ((a-long-long a-short) a-s-long-long s-long-long) - (list 'a-long-long a-long-long - 'a-short a-short - 'a-char a-char - 'another-short another-short))) - (a-long-long 1 a-short 2 a-char 3 another-short 4))) +(defcvar "the_s_s_long_long" s-s-long-long) +(deftest struct.alignment.6 + (with-foreign-slots + ((a-char a-s-long-long another-short) *the-s-s-long-long* s-s-long-long) + (with-foreign-slots ((a-long-long a-short) a-s-long-long s-long-long) + (list 'a-long-long a-long-long + 'a-short a-short + 'a-char a-char + 'another-short another-short))) + (a-long-long 1 a-short 2 a-char 3 another-short 4)) (defcstruct s-s-double3 (a-s-double2 s-double2) @@ -298,27 +294,51 @@ ;; regression test, some Lisps were returning 4 instead of 8 for ;; (foreign-type-alignment :unsigned-long-long) on darwin/ppc32 -#-cffi-features:no-long-long -(progn - (defcstruct s-unsigned-long-long - (an-unsigned-long-long :unsigned-long-long) - (a-short :short)) +(defcstruct s-unsigned-long-long + (an-unsigned-long-long :unsigned-long-long) + (a-short :short)) - (defcstruct s-s-unsigned-long-long - (a-char :char) - (a-s-unsigned-long-long s-unsigned-long-long) - (another-short :short)) +(defcstruct s-s-unsigned-long-long + (a-char :char) + (a-s-unsigned-long-long s-unsigned-long-long) + (another-short :short)) - (defcvar "the_s_s_unsigned_long_long" s-s-unsigned-long-long) +(defcvar "the_s_s_unsigned_long_long" s-s-unsigned-long-long) - (deftest struct.alignment.8 - (with-foreign-slots - ((a-char a-s-unsigned-long-long another-short) - *the-s-s-unsigned-long-long* s-s-unsigned-long-long) - (with-foreign-slots ((an-unsigned-long-long a-short) - a-s-unsigned-long-long s-unsigned-long-long) - (list 'an-unsigned-long-long an-unsigned-long-long - 'a-short a-short - 'a-char a-char - 'another-short another-short))) - (an-unsigned-long-long 1 a-short 2 a-char 3 another-short 4))) +(deftest struct.alignment.8 + (with-foreign-slots + ((a-char a-s-unsigned-long-long another-short) + *the-s-s-unsigned-long-long* s-s-unsigned-long-long) + (with-foreign-slots ((an-unsigned-long-long a-short) + a-s-unsigned-long-long s-unsigned-long-long) + (list 'an-unsigned-long-long an-unsigned-long-long + 'a-short a-short + 'a-char a-char + 'another-short another-short))) + (an-unsigned-long-long 1 a-short 2 a-char 3 another-short 4)) + +;;;# C Struct Wrappers + +(define-c-struct-wrapper timeval ()) + +(define-c-struct-wrapper (timeval2 timeval) () + (tv-secs)) + +(defmacro with-example-timeval (var &body body) + `(with-foreign-object (,var 'timeval) + (with-foreign-slots ((tv-secs tv-usecs) ,var timeval) + (setf tv-secs 42 tv-usecs 1984) + ,@body))) + +(deftest struct-wrapper.1 + (with-example-timeval ptr + (let ((obj (make-instance 'timeval :pointer ptr))) + (values (timeval-tv-secs obj) + (timeval-tv-usecs obj)))) + 42 1984) + +(deftest struct-wrapper.2 + (with-example-timeval ptr + (let ((obj (make-instance 'timeval2 :pointer ptr))) + (timeval2-tv-secs obj))) + 42) diff --git a/external/cffi.darcs/_darcs/pristine/uffi-compat/uffi-compat.lisp b/external/cffi.darcs/_darcs/pristine/uffi-compat/uffi-compat.lisp index 5e25f56..3823c8c 100644 --- a/external/cffi.darcs/_darcs/pristine/uffi-compat/uffi-compat.lisp +++ b/external/cffi.darcs/_darcs/pristine/uffi-compat/uffi-compat.lisp @@ -572,12 +572,15 @@ output to *trace-output*. Returns the shell's exit code." ;;; Some undocumented UFFI operators... -(defmacro convert-from-foreign-string (obj &key (length most-positive-fixnum) - (locale :default) +(defmacro convert-from-foreign-string (obj &key length (locale :default) (null-terminated-p t)) - (declare (ignore locale)) + ;; in effect, (eq NULL-TERMINATED-P (null LENGTH)). Hopefully, + ;; that's compatible with the intended semantics, which are + ;; undocumented. If that's not the case, we can implement + ;; NULL-TERMINATED-P in CFFI:FOREIGN-STRING-TO-LISP. + (declare (ignore locale null-terminated-p)) (let ((ret (gensym))) - `(let ((,ret (cffi:foreign-string-to-lisp ,obj ,length ,null-terminated-p))) + `(let ((,ret (cffi:foreign-string-to-lisp ,obj :count ,length))) (if (equal ,ret "") nil ,ret)))) diff --git a/external/cffi.darcs/cffi-tests.asd b/external/cffi.darcs/cffi-tests.asd index be0d0d9..d885e26 100644 --- a/external/cffi.darcs/cffi-tests.asd +++ b/external/cffi.darcs/cffi-tests.asd @@ -67,6 +67,7 @@ (:file "callbacks") (:file "foreign-globals") (:file "memory") + (:file "strings") (:file "struct") (:file "union") (:file "enum") diff --git a/external/cffi.darcs/cffi.asd b/external/cffi.darcs/cffi.asd index 280bd0e..1f00797 100644 --- a/external/cffi.darcs/cffi.asd +++ b/external/cffi.darcs/cffi.asd @@ -37,6 +37,7 @@ :author "James Bielman " :version "0.9.2" :licence "MIT" + :depends-on (alexandria trivial-features babel) :components ((:module src :serial t diff --git a/external/cffi.darcs/doc/cffi-manual.texinfo b/external/cffi.darcs/doc/cffi-manual.texinfo index 9a02d0e..de3199a 100644 --- a/external/cffi.darcs/doc/cffi-manual.texinfo +++ b/external/cffi.darcs/doc/cffi-manual.texinfo @@ -6,14 +6,12 @@ @c @documentencoding utf-8 -@ignore -Style notes: - -* The reference section names and "See Also" list are roman, not - @code. This is to follow the format of CLHS. - -* How it looks in HTML is the priority. -@end ignore +@c Style notes: +@c +@c * The reference section names and "See Also" list are roman, not +@c @code. This is to follow the format of CLHS. +@c +@c * How it looks in HTML is the priority. @c ============================= Macros ============================= @c The following macros are used throughout this manual. @@ -85,6 +83,27 @@ Style notes: @alias lispcmt = asis @end ifclear +@c My copy of makeinfo is not generating any HTML for @result{} for +@c some odd reason. (It certainly used to...) +@ifhtml +@macro result +=> +@end macro +@end ifhtml + +@c Similar macro to @result. Its purpose is to work around the fact +@c that ⇒ does not work properly inside @lisp. +@ifhtml +@macro res +@html +⇒ +@end html +@end macro +@end ifhtml + +@ifnothtml +@alias res = result +@end ifnothtml @c ============================= Macros ============================= @@ -152,6 +171,7 @@ software or the use or other dealings in the software.} * Functions:: * Libraries:: * Callbacks:: +* The Groveller:: * Limitations:: * Platform-specific features:: Details about the underlying system. * Glossary:: List of CFFI-specific terms and meanings. @@ -183,11 +203,12 @@ Foreign Types * foreign-type-alignment:: Returns the alignment of a foreign type. * foreign-type-size:: Returns the size of a foreign type. * free-converted-object:: Outside interface to typed object deallocators. -* free-translated-object:: Free a type translated foreign object. -* translate-from-foreign:: Translate a foreign object to a Lisp object. -* translate-to-foreign:: Translate a Lisp object to a foreign object. +* free-translated-object:: Defines how to free a oreign object. +* translate-from-foreign:: Defines a foreign-to-Lisp object translation. +* translate-to-foreign:: Defines a Lisp-to-foreign object translation. * with-foreign-object:: Allocates a foreign object with dynamic extent. -* with-foreign-slots:: Access the slots of a foreign structure. +@c * with-foreign-objects:: Plural form of @code{with-foreign-object}. +* with-foreign-slots:: Accesses the slots of a foreign structure. Pointers @@ -208,11 +229,13 @@ Pointers Strings +* *default-foreign-encoding*:: Default encoding for the string types. * foreign-string-alloc:: Converts a Lisp string to a foreign string. * foreign-string-free:: Deallocates memory used by a foreign string. * foreign-string-to-lisp:: Converts a foreign string to a Lisp string. * lisp-string-to-foreign:: Copies a Lisp string into a foreign string. * with-foreign-string:: Allocates a foreign string with dynamic extent. +@c * with-foreign-strings:: Plural form of @code{with-foreign-string}. * with-foreign-pointer-as-string:: Similar to CL's with-output-to-string. Variables @@ -306,120 +329,76 @@ for performance, use a compiler-macro instead. @cffi{} supports various free and commercial Lisp implementations: Allegro CL, Corman CL, @sc{clisp}, @acronym{CMUCL}, @acronym{ECL}, -LispWorks, Open@acronym{MCL}, @acronym{SBCL} and the Scieneer CL. - -There are also plans to support Digitool @acronym{MCL}, and @acronym{GCL}. - +LispWorks, Clozure CL, @acronym{SBCL} and the Scieneer CL. -@section Allegro CL +In general, you should work with the latest versions of each +implementation since those will usually be tested against recent +versions of CFFI more often and might include necessary features or +bug fixes. Reasonable patches for compatibility with earlier versions +are welcome nevertheless. -@strong{Tested platforms:} linux/x86, linux/ppc, win32/x86, darwin/ppc. +@section Limitations -Version 7.0 is supported. The 8.0 beta is also known to work. Earlier -versions are untested and unsupported but patches to support them -are welcome. +Some features are not supported in all implementations. +@c TODO: describe these features here. +@c flat-namespace too -@subheading Limitations +@subheading Allegro CL @itemize @item -Does not support the @code{:long-long} type. +Does not support the @code{:long-long} type natively. +@item +Unicode support is limited to the Basic Multilingual Plane (16-bit +code points). @end itemize -@section Corman CL - -@strong{Tested platforms:} win32/x86. +@section CMUCL -Versions prior to 2.51 are untested and unsupported. Also, you will -need to avoid Corman's buggy @code{COMPILE-FILE} and fasl -loader. Please follow @uref{http://www.weitz.de/corman-asdf/, these -instructions} by Edi Weitz to setup ASDF for Corman CL in a way that -works around these issues. +@itemize +@item +No Unicode support. (8-bit code points) +@end itemize -@subheading Limitations +@subheading Corman CL @itemize @item Does not support @code{foreign-funcall}. @end itemize +@subheading @acronym{ECL} -@section @sc{clisp} - -@strong{Tested platforms:} linux/x86, linux/ppc, win32/x86, darwin/ppc. - -Version is 2.34 or newer is required on win32/x86. For other platforms -version 2.35 or newer is required. - - -@section @acronym{CMUCL} - -@strong{Tested platforms:} linux/x86, darwin/ppc. - -Versions prior to 19B are untested. For darwin/ppc, the 2006-02 (19C) -snapshot or later is recommended. - - -@section @acronym{ECL} - -@strong{Tested platforms:} @emph{needs testing...} - -As of November 2005, the CVS version of ECL is required. It is -reported to pass all tests. - -@subheading Limitations @itemize @item -Does not support the @code{:long-long} type. - -@item On platforms where ECL's dynamic FFI is not supported (ie. when @code{:dffi} is not present in @code{*features*}), @code{cffi:load-foreign-library} does not work and you must use ECL's own @code{ffi:load-foreign-library} with a constant string argument. +@item +Does not support the @code{:long-long} type natively. +@item +Unicode support is not enabled by default. @end itemize +@subheading Lispworks -@section Lispworks - -@strong{Tested platforms:} linux/x86, win32/x86, darwin/ppc. - -Versions prior to 4.4 are untested. - -@subheading Limitations @itemize @item -Does not support the @code{:long-long} type. +Does not support the @code{:long-long} type natively, except in 64-bit +platforms. +@item +Unicode support is limited to the Basic Multilingual Plane (16-bit +code points). @end itemize - -@section Open@acronym{MCL} - -@strong{Tested platforms:} darwin/ppc, linux/ppc. - -Open@acronym{MCL} 1.0 or newer is recommended. - - -@section @acronym{SBCL} - -@strong{Tested platforms:} linux/x86, linux/ppc, darwin/ppc. - -Version 0.9.6 or newer is recommended. - -@subheading Limitations +@subheading @acronym{SBCL} @itemize @item Not all platforms support callbacks. -@end itemize - - -@section Scieneer CL -@strong{Tested platforms:} linux/x86, linux/amd64. - -Version 1.2.10 or newer is recommended. Passes all tests. -The x86 and AMD64 ports feature long-double support. +@end itemize @c =================================================================== @@ -667,10 +646,10 @@ Let's pick this apart into appropriate Lisp code: (flags :long)) @end lisp -@impnote{CFFI currently assumes the UNIX viewpoint that there is one C -symbol namespace, containing all symbols in all loaded objects. This -is not so on Windows and Darwin. The interface may be changed to deal -with this.} +@impnote{By default, CFFI assumes the UNIX viewpoint that there is one +C symbol namespace, containing all symbols in all loaded objects. +This is not so on Windows and Darwin, but we emulate UNIX's behaviour +there. @ref{defcfun} for more details.} Note the parallels with the original C declaration. We've defined @code{curl-code} as a wrapping type for @code{:int}; right now, it @@ -1655,9 +1634,8 @@ likely that either code or a good reason for lack of code is already present. @impnote{There are some other things in @cffi{} that might deserve -tutorial sections, such as define-foreign-type, -free-translated-object, or structs. Let us know which ones you care -about.} +tutorial sections, such as free-translated-object, or structs. Let us +know which ones you care about.} @c =================================================================== @@ -1742,7 +1720,6 @@ define new types. * Foreign Type Translators:: * Optimizing Type Translators:: * Foreign Structure Types:: -* Operations on Types:: * Allocating Foreign Objects:: Dictionary @@ -1792,6 +1769,13 @@ Dictionary These types correspond to the native C integer types according to the @acronym{ABI} of the Lisp implementation's host system. +@code{:long-long} and @code{:unsigned-long-long} are not supported +natively on all implementations. However, they are emulated by +@code{mem-ref} and @code{mem-set}. + +When those types are @strong{not} available, the symbol +@code{cffi-features:no-long-long} is pushed into @code{*features*}. + @ForeignType{:uchar} @ForeignType{:ushort} @ForeignType{:uint} @@ -1804,11 +1788,6 @@ For convenience, the above types are provided as shortcuts for @code{unsigned-long}, @code{long-long} and @code{unsigned-long-long}, respectively. -@code{:long-long} and @code{:unsigned-long-long} are not supported on -all implementations. When those types are @strong{not} available, the -symbol @code{cffi-features:no-long-long} is pushed into -@code{*features*}. - @ForeignType{:int8} @ForeignType{:uint8} @ForeignType{:int16} @@ -2229,9 +2208,6 @@ The equivalent @code{defcstruct} form follows: (reason :string)) @end lisp -@cffi{} knows how to align C @code{struct}s, and how to figure in -padding between struct elements. - Please note that this interface is only for those that must know about the values contained in a relevant struct. If the library you are interfacing returns an opaque pointer that needs only be passed to @@ -2239,10 +2215,7 @@ other C library functions, by all means just use @code{:pointer} or a type-safe definition munged together with @code{defctype} and type translation. -@node Operations on Types -@section Operations on Types - -@impnote{Which ``operations'' are worth going over here? --stephen} +@ref{defcstruct} for more details. @node Allocating Foreign Objects @section Allocating Foreign Objects @@ -2259,7 +2232,7 @@ translation. @node convert-from-foreign @unnumberedsec convert-from-foreign @subheading Syntax -@Function{convert-from-foreign foreign-value type @result{} value} +@Function{convert-from-foreign foreign-value type @res{} value} @subheading Arguments and Values @@ -2301,6 +2274,7 @@ CFFI-USER> (convert-from-foreign * :string) @subheading See Also @seealso{convert-to-foreign} @* +@seealso{free-converted-object} @* @seealso{translate-from-foreign} @@ -2310,7 +2284,7 @@ CFFI-USER> (convert-from-foreign * :string) @node convert-to-foreign @unnumberedsec convert-to-foreign @subheading Syntax -@Function{convert-to-foreign value type @result{} foreign-value, alloc-params} +@Function{convert-to-foreign value type @res{} foreign-value, alloc-params} @subheading Arguments and Values @@ -2421,7 +2395,7 @@ which is @code{:int} by default. :rdwr ;@lispcmt{@dots{}} :nonblock :append - (:creat #x0200)) + (:creat #x0200)) ;; @lispcmt{etc@dots{}} CFFI> (foreign-bitfield-symbols 'open-flags #b1101) @@ -2454,7 +2428,7 @@ CFFI> (unix-open "/tmp/foo" '(:wronly :creat) #o644) @node defcstruct @unnumberedsec defcstruct @subheading Syntax -@Macro{defcstruct name-and-options &body doc-and-slots @result{} name} +@Macro{defcstruct name-and-options &body doc-and-slots @res{} name} name-and-options ::= structure-name | (structure-name &key size) @@ -2573,7 +2547,7 @@ CFFI> (foreign-type-size 'foo) @node defcunion @unnumberedsec defcunion @subheading Syntax -@Macro{defcunion name &body doc-and-slots @result{} name} +@Macro{defcunion name &body doc-and-slots @res{} name} doc-and-slots ::= [docstring] @{ (slot-name slot-type &key count) @}* @@ -2638,11 +2612,9 @@ A documentation string, currently ignored. @subheading Description The @code{defctype} macro provides a mechanism similar to C's @code{typedef} to define new types. The new type inherits -@var{base-type}'s translators, if any. - -There is no way to define translations for types for types defined -with @code{defctype}. For that, you should use -@ref{define-foreign-type}. +@var{base-type}'s translators, if any. There is no way to define +translations for types for types defined with @code{defctype}. For +that, you should use @ref{define-foreign-type}. @subheading Examples @lisp @@ -2734,7 +2706,7 @@ CFFI> (foreign-enum-keyword 'numbers 2) @node define-foreign-type @unnumberedsec define-foreign-type @subheading Syntax -@Macro{define-foreign-type class-name supers slots &rest options @result{} class-name} +@Macro{define-foreign-type class-name supers slots &rest options @res{} class-name} options ::= (@code{:actual-type} @var{type}) | @ (@code{:simple-parser} @var{symbol}) | @ @@ -2800,7 +2772,7 @@ CFFI> (canonicalize-foreign-type '(:boolean :float)) @node define-parse-method @unnumberedsec define-parse-method @subheading Syntax -@Macro{define-parse-method name lambda-list &body body @result{} name} +@Macro{define-parse-method name lambda-list &body body @res{} name} @subheading Arguments and Values @@ -2892,7 +2864,7 @@ CFFI> (canonicalize-foreign-type '(:boolean :float)) @node foreign-bitfield-symbols @unnumberedsec foreign-bitfield-symbols @subheading Syntax -@Function{foreign-bitfield-symbols type value @result{} symbols} +@Function{foreign-bitfield-symbols type value @res{} symbols} @subheading Arguments and Values @@ -2934,7 +2906,7 @@ CFFI> (foreign-bitfield-symbols 'boolean #b101) @node foreign-bitfield-value @unnumberedsec foreign-bitfield-value @subheading Syntax -@Function{foreign-bitfield-value type symbols @result{} value} +@Function{foreign-bitfield-value type symbols @res{} value} @subheading Arguments and Values @@ -2975,7 +2947,7 @@ CFFI> (foreign-bitfield-value 'flags '(flag-a flag-c)) @node foreign-enum-keyword @unnumberedsec foreign-enum-keyword @subheading Syntax -@Function{foreign-enum-keyword type value &key errorp @result{} keyword} +@Function{foreign-enum-keyword type value &key errorp @res{} keyword} @subheading Arguments and Values @@ -3023,7 +2995,7 @@ CFFI> (foreign-enum-keyword 'boolean 1) @node foreign-enum-value @unnumberedsec foreign-enum-value @subheading Syntax -@Function{foreign-enum-value type keyword &key errorp @result{} value} +@Function{foreign-enum-value type keyword &key errorp @res{} value} @subheading Arguments and Values @@ -3071,7 +3043,7 @@ CFFI> (foreign-enum-value 'boolean :yes) @node foreign-slot-names @unnumberedsec foreign-slot-names @subheading Syntax -@Function{foreign-slot-names type @result{} names} +@Function{foreign-slot-names type @res{} names} @subheading Arguments and Values @@ -3111,7 +3083,7 @@ CFFI> (foreign-slot-names 'timeval) @node foreign-slot-offset @unnumberedsec foreign-slot-offset @subheading Syntax -@Function{foreign-slot-offset type slot-name @result{} offset} +@Function{foreign-slot-offset type slot-name @res{} offset} @subheading Arguments and Values @@ -3155,7 +3127,7 @@ CFFI> (foreign-slot-offset 'timeval 'tv-usecs) @node foreign-slot-pointer @unnumberedsec foreign-slot-pointer @subheading Syntax -@Function{foreign-slot-pointer ptr type slot-name @result{} pointer} +@Function{foreign-slot-pointer ptr type slot-name @res{} pointer} @subheading Arguments and Values @@ -3208,7 +3180,7 @@ CFFI> (with-foreign-object (ptr 'point) @node foreign-slot-value @unnumberedsec foreign-slot-value @subheading Syntax -@Accessor{foreign-slot-value ptr type slot-name @result{} object} +@Accessor{foreign-slot-value ptr type slot-name @res{} object} @subheading Arguments and Values @@ -3272,7 +3244,7 @@ CFFI> (with-foreign-object (ptr 'point) @unnumberedsec foreign-type-alignment @subheading Syntax @c XXX: This is actually a generic function. -@Function{foreign-type-alignment type @result{} alignment} +@Function{foreign-type-alignment type @res{} alignment} @subheading Arguments and Values @@ -3317,7 +3289,7 @@ CFFI> (foreign-type-alignment 'foo) @unnumberedsec foreign-type-size @subheading Syntax @c XXX: this is actually a generic function. -@Function{foreign-type-size type @result{} size} +@Function{foreign-type-size type @res{} size} @subheading Arguments and Values @@ -3453,7 +3425,7 @@ the @code{defctype} macro. @unnumberedsec translate-from-foreign @subheading Syntax @GenericFunction{translate-from-foreign foreign-value type-name @ - @result{} lisp-value} + @res{} lisp-value} @subheading Arguments and Values @@ -3499,7 +3471,7 @@ defined for built-in types. @unnumberedsec translate-to-foreign @subheading Syntax @GenericFunction{translate-to-foreign lisp-value type-name @ - @result{} foreign-value, alloc-param} + @res{} foreign-value, alloc-param} @subheading Arguments and Values @@ -3719,7 +3691,7 @@ dereference @code{*} in C; use @code{mem-aref} for array indexing and @node foreign-free @unnumberedsec foreign-free @subheading Syntax -@Function{foreign-free ptr @result{} undefined} +@Function{foreign-free ptr @res{} undefined} @subheading Arguments and Values @@ -3754,7 +3726,7 @@ CFFI> (foreign-free *) @unnumberedsec foreign-alloc @subheading Syntax @Function{foreign-alloc type &key initial-element initial-contents (count 1) @ - null-terminated-p @result{} pointer} + null-terminated-p @res{} pointer} @subheading Arguments and Values @@ -3865,7 +3837,7 @@ CFFI> (progn @node foreign-symbol-pointer @unnumberedsec foreign-symbol-pointer @subheading Syntax -@Function{foreign-symbol-pointer foreign-name &key library @result{} pointer} +@Function{foreign-symbol-pointer foreign-name &key library @res{} pointer} @subheading Arguments and Values @@ -3922,7 +3894,7 @@ CFFI> (foreign-symbol-pointer "inexistent symbol") @node inc-pointer @unnumberedsec inc-pointer @subheading Syntax -@Function{inc-pointer pointer offset @result{} new-pointer} +@Function{inc-pointer pointer offset @res{} new-pointer} @subheading Arguments and Values @@ -3964,7 +3936,7 @@ CFFI> (foreign-string-to-lisp *) @node incf-pointer @unnumberedsec inc-pointer @subheading Syntax -@Macro{incf-pointer place &optional (offset 1) @result{} new-pointer} +@Macro{incf-pointer place &optional (offset 1) @res{} new-pointer} @subheading Arguments and Values @@ -4013,7 +3985,7 @@ CFFI> (foreign-string-to-lisp *two-words*) @node make-pointer @unnumberedsec make-pointer @subheading Syntax -@Function{make-pointer address @result{} ptr} +@Function{make-pointer address @res{} ptr} @subheading Arguments and Values @@ -4120,7 +4092,7 @@ CFFI> (with-foreign-object (array :int 10) @node mem-ref @unnumberedsec mem-ref @subheading Syntax -@Accessor{mem-ref ptr type &optional offset @result{} object} +@Accessor{mem-ref ptr type &optional offset @res{} object} @subheading Arguments and Values @@ -4167,7 +4139,7 @@ CFFI> (mem-ref ptr-to-int :int) @node null-pointer @unnumberedsec null-pointer @subheading Syntax -@Function{null-pointer @result{} pointer} +@Function{null-pointer @res{} pointer} @subheading Arguments and Values @@ -4199,7 +4171,7 @@ CFFI> (pointerp *) @node null-pointer-p @unnumberedsec null-pointer-p @subheading Syntax -@Function{null-pointer-p ptr @result{} boolean} +@Function{null-pointer-p ptr @res{} boolean} @subheading Arguments and Values @@ -4244,7 +4216,7 @@ CFFI> (contains-str-p "Popcorns" "salt") @node pointerp @unnumberedsec pointerp @subheading Syntax -@Function{pointerp ptr @result{} boolean} +@Function{pointerp ptr @res{} boolean} @subheading Arguments and Values @@ -4286,7 +4258,7 @@ CFFI> (pointerp "this is not a pointer") @node pointer-address @unnumberedsec pointer-address @subheading Syntax -@Function{pointer-address ptr @result{} address} +@Function{pointer-address ptr @res{} address} @subheading Arguments and Values @@ -4327,7 +4299,7 @@ CFFI> (pointer-address (make-pointer 123)) @node pointer-eq @unnumberedsec pointer-eq @subheading Syntax -@Function{pointer-eq ptr1 ptr2 @result{} boolean} +@Function{pointer-eq ptr1 ptr2 @res{} boolean} @subheading Arguments and Values @@ -4480,6 +4452,7 @@ without referring to any implementation-specific symbols. @menu Dictionary +* *default-foreign-encoding*:: * foreign-string-alloc:: * foreign-string-free:: * foreign-string-to-lisp:: @@ -4490,35 +4463,95 @@ Dictionary @c =================================================================== +@c *DEFAULT-FOREIGN-ENCODING* + +@node *default-foreign-encoding* +@unnumberedsec *default-foreign-encoding* +@subheading Syntax + +@Variable{*default-foreign-encoding*} + +@subheading Value type + +A keyword. + +@subheading Initial value + +@code{:utf-8} + +@subheading Description + +This special variable holds the default foreign encoding. + +@subheading Examples + +@lisp +CFFI> *default-foreign-encoding* +:utf-8 +CFFI> (foreign-funcall "strdup" (:string :encoding :utf-16) "foo" :string) +"f" +CFFI> (let ((*default-foreign-encoding* :utf-16)) + (foreign-funcall "strdup" (:string :encoding :utf-16) "foo" :string)) +"foo" +@end lisp + +@subheading See also + +@seealso{Other Types} (@code{:string} type) @* +@seealso{foreign-string-alloc} @* +@seealso{foreign-string-to-lisp} @* +@seealso{lisp-string-to-foreign} @* +@seealso{with-foreign-string} @* +@seealso{with-foreign-pointer-as-string} + + +@c =================================================================== @c FOREIGN-STRING-ALLOC @node foreign-string-alloc @unnumberedsec foreign-string-alloc @subheading Syntax -@Function{foreign-string-alloc string-or-ub8-array @result{} pointer} +@Function{foreign-string-alloc string &key encoding null-terminated-p @ + start end @res{} pointer} @subheading Arguments and Values @table @var -@item string-or-ub8-array -A Lisp string or a Lisp array with element-type @code{(unsigned-byte 8)}. +@item string +A Lisp string. + +@item encoding +Foreign encoding. Defaults to @code{*default-foreign-encoding*}. + +@item null-terminated-p +Boolean, defaults to true. + +@item start, end +Bounding index designators of @var{string}. 0 and @code{nil}, by +default. @item pointer A pointer to the newly allocated foreign string. @end table @subheading Description -The @code{foreign-string-alloc} function allocates a foreign string -containing a Lisp string or @code{(unsigned-byte 8)} array. +The @code{foreign-string-alloc} function allocates foreign memory +holding a copy of @var{string} converted using the specified +@var{encoding}. @var{Start} specifies an offset into @var{string} and +@var{end} marks the position following the last element of the foreign +string. This string must be freed with @code{foreign-string-free}. +If @var{null-terminated-p} is false, the string will not be +null-terminated. + @subheading Examples @lisp -CFFI> (setq str (foreign-string-alloc "Hello, foreign world!")) +CFFI> (defparameter *str* (foreign-string-alloc "Hello, foreign world!")) @result{} # -CFFI> (foreign-funcall "strlen" :pointer str :int) +CFFI> (foreign-funcall "strlen" :pointer *str* :int) @result{} 21 @end lisp @@ -4559,8 +4592,8 @@ allocated by @code{foreign-string-alloc}. @node foreign-string-to-lisp @unnumberedsec foreign-string-to-lisp @subheading Syntax -@Function{foreign-string-to-lisp ptr &optional size null-terminated-p @ - @result{} string} +@Function{foreign-string-to-lisp ptr &optional offset count max-chars @ + encoding @res{} string} @subheading Arguments and Values @@ -4568,23 +4601,32 @@ allocated by @code{foreign-string-alloc}. @item ptr A pointer. -@item size -The maximum string size. @code{array-total-size-limit}, by default. +@item offset +An integer greater than or equal to 0. Defauls to 0. -@item null-terminated-p -Specifies if the string @var{ptr} points to is null terminated. True, -by default. +@item count +Either @code{nil} (the default), or an integer greater than or equal to 0. + +@item max-chars +An integer greater than or equal to 0. +@code{(1- array-total-size-limit)}, by default. + +@item encoding +Foreign encoding. Defaults to @code{*default-foreign-encoding*}. + +@item string +A Lisp string. @end table @subheading Description -The @code{foreign-string-to-lisp} function copies at most @var{size} -characters from @var{ptr} into a Lisp string. +The @code{foreign-string-to-lisp} function converts at most +@var{count} octets from @var{ptr} into a Lisp string, using the +defined @var{encoding}. -When @var{null-terminated-p} is true (the default), characters are -copied until @var{size} is reached or a @code{NULL} character is -found. +If @var{count} is @code{nil} (the default), characters are copied +until @var{max-chars} is reached or a @code{NULL} character is found. -If @var{ptr} is a null pointer, returns nil. +If @var{ptr} is a null pointer, returns @code{nil}. Note that the @code{:string} type will automatically convert between Lisp strings and foreign strings. @@ -4610,25 +4652,41 @@ CFFI> (foreign-string-to-lisp *) @node lisp-string-to-foreign @unnumberedsec lisp-string-to-foreign @subheading Syntax -@Function{lisp-string-to-foreign string-or-ub8-array ptr size} +@Function{lisp-string-to-foreign string buffer bufsize &key start @ + end offset encoding @res{} buffer} @subheading Arguments and Values @table @var -@item string-or-ub8-array -A Lisp string or a Lisp @code{(unsigned-byte 8)} array. +@item string +A Lisp string. -@item ptr +@item buffer A foreign pointer. -@item size +@item bufsize An integer. + +@item start, end +Bounding index designators of @var{string}. 0 and @code{nil}, by +default. + +@item offset +An integer greater than or equal to 0. Defauls to 0. + +@item encoding +Foreign encoding. Defaults to @code{*default-foreign-encoding*}. @end table @subheading Description -The @code{lisp-string-to-foreign} function copies at most @var{size}-1 -characters from a Lisp string or @code{(unsigned-byte 8)} arrayto -@var{ptr}. The foreign string will be null-terminated. +The @code{lisp-string-to-foreign} function copies at most +@var{bufsize}-1 octets from a Lisp @var{string} using the specified +@var{encoding} into @var{buffer}+@var{offset}. The foreign string will +be null-terminated. + +@var{Start} specifies an offset into @var{string} and +@var{end} marks the position following the last element of the foreign +string. @subheading Examples @@ -4636,13 +4694,6 @@ characters from a Lisp string or @code{(unsigned-byte 8)} arrayto CFFI> (with-foreign-pointer-as-string (str 255) (lisp-string-to-foreign "Hello, foreign world!" str 6)) @result{} "Hello" - -CFFI> (with-foreign-pointer-as-string (str 255) - (lisp-string-to-foreign - (make-array 6 :element-type '(unsigned-byte 8) - :initial-contents '(65 66 67 68 69 60)) - str 4)) -@result{} "ABC" @end lisp @subheading See Also @@ -4657,16 +4708,20 @@ CFFI> (with-foreign-pointer-as-string (str 255) @node with-foreign-string @unnumberedsec with-foreign-string @subheading Syntax -@Macro{with-foreign-string (var lisp-string-or-ub8-array) &body body} +@Macro{with-foreign-string (var-or-vars string &rest args) &body body} +@Macro{with-foreign-strings (bindings) &body body} + +var-or-vars ::= var | (var &optional octet-size-var) +bindings ::= @{(var-or-vars string &rest args)@}* @subheading Arguments and Values @table @var -@item var +@item var, byte-size-var A symbol. -@item lisp-string-or-ub8-array -A Lisp string or a Lisp array with element type @code{(unsigned-byte 8)}. +@item string +A Lisp string. @item body A list of forms to be executed. @@ -4674,7 +4729,11 @@ A list of forms to be executed. @subheading Description The @code{with-foreign-string} macro will bind @var{var} to a newly -allocated foreign string containing @var{lisp-string-or-ub8-array}. +allocated foreign string containing @var{string}. @var{Args} is passed +to the underlying @code{foreign-string-alloc} call. + +If @var{octet-size-var} is provided, it will be bound the length of +foreign string in octets including the null terminator. @subheading Examples @@ -4701,7 +4760,8 @@ CFFI> (let ((array (coerce #(84 117 114 97 110 103 97) @node with-foreign-pointer-as-string @unnumberedsec with-foreign-pointer-as-string @subheading Syntax -@Macro{with-foreign-pointer-as-string (var size &optional size-var) &body body} +@Macro{with-foreign-pointer-as-string (var size &optional size-var @ + &rest args) &body body @res{} string} @subheading Arguments and Values @@ -4709,7 +4769,7 @@ CFFI> (let ((array (coerce #(84 117 114 97 110 103 97) @item var A symbol. -@item lisp-string +@item string A Lisp string. @item body @@ -4718,13 +4778,14 @@ List of forms to be executed. @subheading Description The @code{with-foreign-pointer-as-string} macro is similar to -@code{with-foreign-pointer} except that @var{var}, as a Lisp string, is -used as the returned value of an implicit @code{progn} around @var{body}. +@code{with-foreign-pointer} except that @var{var} is used as the +returned value of an implicit @code{progn} around @var{body}, after +being converted to a Lisp string using the provided @var{args}. @subheading Examples @lisp -CFFI> (with-foreign-pointer-as-string (str 6 str-size) +CFFI> (with-foreign-pointer-as-string (str 6 str-size :encoding :ascii) (lisp-string-to-foreign "Hello, foreign world!" str str-size)) @result{} "Hello" @end lisp @@ -4754,10 +4815,10 @@ Dictionary @node defcvar @unnumberedsec defcvar @subheading Syntax -@Macro{defcvar name-and-options type documentation @result{} lisp-name} +@Macro{defcvar name-and-options type &optional documentation @res{} lisp-name} -name-and-options ::= name | (name &key read-only (library :default)) -name ::= lisp-name [foreign-name] | foreign-name [lisp-name] +@var{name-and-options} ::= name | (name &key read-only (library :default)) @* +@var{name} ::= lisp-name [foreign-name] | foreign-name [lisp-name] @subheading Arguments and Values @@ -4831,7 +4892,7 @@ C standard library.} @node get-var-pointer @unnumberedsec get-var-pointer @subheading Syntax -@Function{get-var-pointer symbol @result{} pointer} +@Function{get-var-pointer symbol @res{} pointer} @subheading Arguments and Values @@ -4872,8 +4933,8 @@ CFFI> (mem-ref * :int) @chapter Functions @menu -* Calling Foreign Functions:: -* Defining Foreign Functions:: +@c * Defining Foreign Functions:: +@c * Calling Foreign Functions:: Dictionary @@ -4882,11 +4943,11 @@ Dictionary * foreign-funcall-pointer:: @end menu -@node Calling Foreign Functions -@section Calling Foreign Functions +@c @node Calling Foreign Functions +@c @section Calling Foreign Functions -@node Defining Foreign Functions -@section Defining Foreign Functions +@c @node Defining Foreign Functions +@c @section Defining Foreign Functions @c =================================================================== @@ -4896,13 +4957,11 @@ Dictionary @unnumberedsec defcfun @subheading Syntax @Macro{defcfun name-and-options return-type &body arguments [&rest] @ - @result{} lisp-name} + @res{} lisp-name} -@table @asis -@item @var{name-and-options} name | (name &key library calling-convention cconv) -@item @var{name} ::= @var{lisp-name} [@var{foreign-name}] | @var{foreign-name} [@var{lisp-name}] -@item @var{arguments} ::= @{ (arg-name arg-type) @}* -@end table +@var{name-and-options} name | (name &key library calling-convention cconv) @* +@var{name} ::= @var{lisp-name} [@var{foreign-name}] | @var{foreign-name} [@var{lisp-name}] @* +@var{arguments} ::= @{ (arg-name arg-type) @}* @* @subheading Arguments and Values @@ -4954,7 +5013,6 @@ care of doing argument promotion. Note that in this case function and will only work for Lisps that support @code{foreign-funcall.} - @subheading Examples @lisp @@ -4996,7 +5054,7 @@ CFFI> (with-foreign-pointer-as-string (s 100) @node foreign-funcall @unnumberedsec foreign-funcall @subheading Syntax -@Macro{foreign-funcall name-and-options &rest arguments @result{} return-value} +@Macro{foreign-funcall name-and-options &rest arguments @res{} return-value} arguments ::= @{ arg-type arg @}* [return-type] name-and-options ::= name | ( name &key library calling-convention cconv) @@ -5094,7 +5152,7 @@ CFFI> (foreign-funcall "printf" :string (format nil "%s: %d.~%") @node foreign-funcall-pointer @unnumberedsec foreign-funcall-pointer @subheading Syntax -@Macro{foreign-funcall pointer options &rest arguments @result{} return-value} +@Macro{foreign-funcall pointer options &rest arguments @res{} return-value} arguments ::= @{ arg-type arg @}* [return-type] options ::= ( &key calling-convention cconv ) @@ -5136,7 +5194,7 @@ Corman Lisp does not support @code{foreign-funcall}. On implementations that @strong{don't} support @code{foreign-funcall} @code{cffi-features:no-foreign-funcall} will be present in @code{*features*}. Note: in these Lisps you can still use the -@code{defcfun} interface. +@code{defcfun} interface. @end itemize @subheading Examples @@ -5244,7 +5302,7 @@ little about. --stephen} @node close-foreign-library @unnumberedsec close-foreign-library @subheading Syntax -@Function{close-foreign-library library @result{} success} +@Function{close-foreign-library library @res{} success} @subheading Arguments and Values @@ -5321,7 +5379,7 @@ CFFI> (load-foreign-library '(:framework "OpenGL")) @subheading Syntax -@Macro{define-foreign-library name-and-options @{ load-clause @}* @result{} name} +@Macro{define-foreign-library name-and-options @{ load-clause @}* @res{} name} name-and-options ::= name | (name &key calling-convention cconv) load-clause ::= (feature library &key calling-convention cconv) @@ -5517,7 +5575,7 @@ The following example would achieve the same effect: @node load-foreign-library @unnumberedsec load-foreign-library @subheading Syntax -@Function{load-foreign-library library @result{} handler} +@Function{load-foreign-library library @res{} handler} @subheading Arguments and Values @@ -5687,7 +5745,7 @@ Dictionary @node callback @unnumberedsec callback @subheading Syntax -@Macro{callback symbol @result{} pointer} +@Macro{callback symbol @res{} pointer} @subheading Arguments and Values @@ -5726,7 +5784,7 @@ CFFI> (callback sum) @node defcallback @unnumberedsec defcallback @subheading Syntax -@Macro{defcallback name-and-options return-type arguments &body body @result{} name} +@Macro{defcallback name-and-options return-type arguments &body body @res{} name} name-and-options ::= name | (name &key calling-convention cconv) arguments ::= (@{ (arg-name arg-type) @}*) @@ -5802,7 +5860,7 @@ CFFI> (with-foreign-object (array :int 10) @node get-callback @unnumberedsec get-callback @subheading Syntax -@Accessor{get-callback symbol @result{} pointer} +@Accessor{get-callback symbol @res{} pointer} @subheading Arguments and Values @@ -5833,6 +5891,260 @@ CFFI> (get-callback 'sum) @seealso{callback} @* @seealso{defcallback} + +@c =================================================================== +@c CHAPTER: The Groveller + +@node The Groveller +@chapter The Groveller + +@c Manual and software copyright @copyright{} 2005, 2006 Matthew Backes +@c and Dan Knapp . + +@cffi{}-Grovel is a tool which makes it easier to write @cffi{} +declarations for libraries that are implemented in C. That is, it +grovels through the system headers, getting information about types +and structures, so you don't have to. This is especially important +for libraries which are implemented in different ways by different +vendors, such as the @sc{unix}/@sc{posix} functions. The @cffi{} +declarations are usually quite different from platform to platform, +but the information you give to @cffi{}-Grovel is the same. Hence, +much less work is required! + +If you use @acronym{ASDF}, @cffi{}-Grovel is integrated, so that it +will run automatically when your system is building. This feature was +inspired by SB-Grovel, a similar @acronym{SBCL}-specific project. +@cffi{}-Grovel can also be used without @acronym{ASDF}. + +@section Building FFIs with CFFI-Grovel + +@cffi{}-Grovel uses a specification file (*.lisp) describing the +features that need groveling. The C compiler is used to retrieve this +data and write a Lisp file (*.cffi.lisp) which contains the necessary +@cffi{} definitions to access the variables, structures, constants, and +enums mentioned in the specification. + +@c This is most similar to the SB-Grovel package, upon which it is +@c based. Unlike SB-Grovel, we do not currently support defining +@c regular foreign functions in the specification file; those are best +@c defined in normal Lisp code. + +@cffi{}-Grovel provides an @acronym{ASDF} component for handling the +necessary calls to the C compiler and resulting file management. + +@c See the included CFFI-Unix package for an example of how to +@c integrate a specification file with ASDF-built packages. + +@menu +* Groveller Syntax:: How grovel files should look like. +* Groveller ASDF Integration:: ASDF components for grovel files. +* Groveller Implementation Notes:: Implementation notes. +@end menu + +@node Groveller Syntax +@section Specification File Syntax + +The specification files are read by the normal Lisp reader, so they +have syntax very similar to normal Lisp code. In particular, +semicolon-comments and reader-macros will work as expected. + +There are several forms recognized by @cffi{}-Grovel: + +@deffn {Grovel Form} progn &rest forms + +Processes a list of forms. Useful for conditionalizing several +forms. For example: +@end deffn + +@lisp +#+cffi-features:freebsd +(progn + (constant (ev-enable "EV_ENABLE")) + (constant (ev-disable "EV_DISABLE"))) +@end lisp + +@deffn {Grovel Form} include &rest files + +Include the specified files (specified as strings) in the generated C +source code. +@end deffn + +@deffn {Grovel Form} in-package symbol + +Set the package to be used for the final Lisp output. +@end deffn + +@deffn {Grovel Form} ctype lisp-name signedness size-designator + +Define a @cffi{} foreign type for the string in @var{size-designator}, +e.g. @code{(ctype :pid :unsigned "pid_t")}. +@end deffn + +@deffn {Grovel Form} constant (lisp-name &rest c-names) &key documentation optional + +Search for the constant named by the first @var{c-name} string found +to be known to the C preprocessor and define it as @var{lisp-name}. +If optional is true, no error will be raised if all the @var{c-names} +are unknown. +@end deffn + +@deffn {Grovel Form} define name &optional value + +Defines an additional C preprocessor symbol, which is useful for +altering the behavior of included system headers. +@end deffn + +@deffn {Grovel Form} flag flag-string + +Adds @var{flag-string} to the flags used for the C compiler +invocation. +@end deffn + +@deffn {Grovel Form} cstruct lisp-name c-name slots + +Define a @cffi{} foreign struct with the slot data specfied. Slots +are of the form @code{(lisp-name c-name &key type count (signed t))}. +@end deffn + +@deffn {Grovel Form} cunion lisp-name c-name slots + +Identical to @code{cstruct}, but defines a @cffi{} foreign union. +@end deffn + +@deffn {Grovel Form} cstruct-and-class c-name slots + +Defines a @cffi{} foreign struct, as with @code{cstruct} and defines a +@acronym{CLOS} class to be used with it. This is useful for mapping +foreign structures to application-layer code that shouldn't need to +worry about memory allocation issues. +@end deffn + +@deffn {Grovel Form} cvar namespec type &key read-only + +Defines a foreign variable of the specified type, even if that +variable is potentially a C preprocessor pseudo-variable. e.g. +@code{(cvar ("errno" errno) errno-values)}, assuming that errno-values +is an enum or equivalent to type @code{:int}. + +The @var{namespec} is similar to the one used in @ref{defcvar}. +@end deffn + +@deffn {Grovel Form} cenum name &rest elements + +Defines a true C enum, with elements specified as @code{((lisp-name +&rest c-names) &key optional documentation)}. +@end deffn + +@deffn {Grovel Form} constantenum name &rest elements + +Defines an enumeration of pre-processor constants, with elements +specified as @code{((lisp-name &rest c-names) &key optional +documentation)}. + +This example defines @code{:af-inet} to represent the value held by +@code{AF_INET} or @code{PF_INET}, whichever the pre-processor finds +first. Similarly for @code{:af-packet}, but no error will be +signalled if the platform supports neither @code{AF_PACKET} nor +@code{PF_PACKET}. +@end deffn + +@lisp +(constantenum address-family + ((:af-inet "AF_INET" "PF_INET") + :documentation "IPv4 Protocol family") + ((:af-local "AF_UNIX" "AF_LOCAL" "PF_UNIX" "PF_LOCAL") + :documentation "File domain sockets") + ((:af-inet6 "AF_INET6" "PF_INET6") + :documentation "IPv6 Protocol family") + ((:af-packet "AF_PACKET" "PF_PACKET") + :documentation "Raw packet access" + :optional t)) +@end lisp + + +@c =================================================================== +@c SECTION: Groveller ASDF Integration + +@node Groveller ASDF Integration +@section ASDF Integration + +An example software project might contain four files; an +@acronym{ASDF} file, a package definition file, an implementation +file, and a @cffi{}-Grovel specification file. + +The @acronym{ASDF} file defines the system and its dependencies. +Notice the use of @code{eval-when} to ensure @cffi{}-Grovel is present +and the use of @code{(cffi-grovel:grovel-file name &key cc-flags)} +instead of @code{(:file name)}. + +@lisp +;;; CFFI-Grovel is needed for processing grovel-file components +(cl:eval-when (:load-toplevel :execute) + (asdf:operate 'asdf:load-op 'cffi-grovel)) + +(asdf:defsystem example-software + :depends-on (cffi) + :serial t + :components + ((:file "package") + (cffi-grovel:grovel-file "example-grovelling") + (:file "example"))) +@end lisp + +The ``package.lisp'' file would contain several @code{defpackage} +forms, to remove circular dependencies and make building the project +easier. Note that you may or may not want to @code{:use} your +internal package. + +@impnote{Mention that it's a not a good idea to :USE when names may +clash with, say, CL symbols.} + +@lisp +(defpackage #:example-internal + (:use) + (:nicknames #:exampleint)) + +(defpackage #:example-software + (:export ...) + (:use #:cl #:cffi #:exampleint)) +@end lisp + +The internal package is created by Lisp code output from the C program +written by @cffi{}-Grovel; if your specification file is +exampleint.lisp, the exampleint.cffi.lisp file will contain the +@cffi{} definitions needed by the rest of your project. +@xref{Groveller Syntax}. + +@node Groveller Implementation Notes +@section Implementation Notes + +@impnote{This info might not be up-to-date.} + +For @code{foo-internal.lisp}, the resulting @code{foo-internal.c}, +@code{foo-internal}, and @code{foo-internal.cffi.lisp} are all +platform-specific, either because of possible reader-macros in +foo-internal.lisp, or because of varying C environments on the host +system. For this reason, it is not helpful to distribute any of those +files; end users building @cffi{}-Grovel based software will need +@code{cffi}-Grovel anyway. + +If you build with multiple architectures in the same directory +(e.g. with NFS/AFS home directories), it is critical to remove these +generated files or the resulting constants will be very incorrect. + +@impnote{Maybe we should tag the generated names with something host +or OS-specific?} + +@impnote{For now, after some experimentation with @sc{clisp} having no +long-long, it seems appropriate to assert that the generated @code{.c} +files are architecture and operating-system dependent, but +lisp-implementation independent. This way the same @code{.c} file +(and so the same @code{.grovel-tmp.lisp} file) will be shareable +between the implementations running on a given system.} + +@c TODO: document the new wrapper stuff. + + @c =================================================================== @c CHAPTER: Limitations @@ -5855,8 +6167,6 @@ details. C @code{struct}s cannot be passed by value. @end itemize -@c more? - @node Platform-specific features @appendix Platform-specific features @@ -5870,7 +6180,7 @@ The exact meanings of the features follow. Though you will usually refer to these symbols as keywords, @cffi{} internally views them in the package @code{cffi-features}. -@table @code +@table @var @item flat-namespace This Lisp has a flat namespace for foreign symbols meaning that you won't be able to load two different libraries with homograph functions diff --git a/external/cffi.darcs/examples/examples.lisp b/external/cffi.darcs/examples/examples.lisp index 231eddf..6093acb 100644 --- a/external/cffi.darcs/examples/examples.lisp +++ b/external/cffi.darcs/examples/examples.lisp @@ -46,7 +46,7 @@ ;; Calling a varargs function. (defun sprintf-test () "Test calling a varargs function." - (with-foreign-pointer-as-string (buf 255 buf-size) + (with-foreign-pointer-as-string ((buf buf-size) 255) (foreign-funcall "snprintf" :pointer buf :int buf-size :string "%d %f #x%x!" :int 666 diff --git a/external/cffi.darcs/examples/gethostname.lisp b/external/cffi.darcs/examples/gethostname.lisp index d079639..f37d275 100644 --- a/external/cffi.darcs/examples/gethostname.lisp +++ b/external/cffi.darcs/examples/gethostname.lisp @@ -47,5 +47,5 @@ ;;; WITH-FOREIGN-POINTER-AS-STRING is used to allocate a temporary ;;; buffer and return it as a Lisp string. (defun gethostname () - (with-foreign-pointer-as-string (buf 255 bufsize) + (with-foreign-pointer-as-string ((buf bufsize) 255) (%gethostname buf bufsize))) diff --git a/external/cffi.darcs/src/cffi-allegro.lisp b/external/cffi.darcs/src/cffi-allegro.lisp index 505da48..bfa4bdd 100644 --- a/external/cffi.darcs/src/cffi-allegro.lisp +++ b/external/cffi.darcs/src/cffi-allegro.lisp @@ -28,7 +28,7 @@ ;;;# Administrivia (defpackage #:cffi-sys - (:use #:common-lisp #:cffi-utils) + (:use #:common-lisp #:cffi-utils #:alexandria) (:export #:canonicalize-symbol-name-case #:foreign-pointer @@ -60,23 +60,14 @@ (in-package #:cffi-sys) -;;;# Features +;;;# Mis-features (eval-when (:compile-toplevel :load-toplevel :execute) (mapc (lambda (feature) (pushnew feature *features*)) - '(;; Backend mis-features. - cffi-features:no-long-long - cffi-features:flat-namespace - ;; OS/CPU features. - #+macosx cffi-features:darwin - #+unix cffi-features:unix - #+mswindows cffi-features:windows - #+powerpc cffi-features:ppc32 - #+x86 cffi-features:x86 - #+x86-64 cffi-features:x86-64 - ))) - -;;; Symbol case. + '(cffi-features:no-long-long + cffi-features:flat-namespace))) + +;;;# Symbol Case (defun canonicalize-symbol-name-case (name) (declare (string name)) diff --git a/external/cffi.darcs/src/cffi-clisp.lisp b/external/cffi.darcs/src/cffi-clisp.lisp index 7eddc18..40f6a09 100644 --- a/external/cffi.darcs/src/cffi-clisp.lisp +++ b/external/cffi.darcs/src/cffi-clisp.lisp @@ -3,7 +3,7 @@ ;;; cffi-clisp.lisp --- CFFI-SYS implementation for CLISP. ;;; ;;; Copyright (C) 2005-2006, James Bielman -;;; (C) 2005-2006, Joerg Hoehle +;;; Copyright (C) 2005-2006, Joerg Hoehle ;;; ;;; Permission is hereby granted, free of charge, to any person ;;; obtaining a copy of this software and associated documentation @@ -29,7 +29,7 @@ ;;;# Administrivia (defpackage #:cffi-sys - (:use #:common-lisp #:cffi-utils) + (:use #:common-lisp #:cffi-utils #:alexandria) (:export #:canonicalize-symbol-name-case #:foreign-pointer @@ -60,26 +60,7 @@ (in-package #:cffi-sys) -;;; FIXME: long-long could be supported anyway on 64-bit machines. --luis - -;;;# Features - -(eval-when (:compile-toplevel :load-toplevel :execute) - (mapc (lambda (feature) (pushnew feature *features*)) - '(;; OS/CPU features. - #+:macos cffi-features:darwin - #+:unix cffi-features:unix - #+:win32 cffi-features:windows - )) - (cond ((string-equal (machine-type) "X86_64") - (pushnew 'cffi-features:x86-64 *features*)) - ((member :pc386 *features*) - (pushnew 'cffi-features:x86 *features*)) - ;; FIXME: probably catches PPC64 as well - ((string-equal (machine-type) "POWER MACINTOSH") - (pushnew 'cffi-features:ppc32 *features*)))) - -;;; Symbol case. +;;;# Symbol Case (defun canonicalize-symbol-name-case (name) (declare (string name)) diff --git a/external/cffi.darcs/src/cffi-cmucl.lisp b/external/cffi.darcs/src/cffi-cmucl.lisp index 64e7d76..789a0e0 100644 --- a/external/cffi.darcs/src/cffi-cmucl.lisp +++ b/external/cffi.darcs/src/cffi-cmucl.lisp @@ -28,7 +28,7 @@ ;;;# Administrivia (defpackage #:cffi-sys - (:use #:common-lisp #:alien #:c-call #:cffi-utils) + (:use #:common-lisp #:alien #:c-call #:cffi-utils #:alexandria) (:export #:canonicalize-symbol-name-case #:foreign-pointer @@ -63,16 +63,9 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (mapc (lambda (feature) (pushnew feature *features*)) - '(;; OS/CPU features. - #+darwin cffi-features:darwin - #+unix cffi-features:unix - #+x86 cffi-features:x86 - #+(and ppc (not ppc64)) cffi-features:ppc32 - ;; Misfeatures - cffi-features:flat-namespace - ))) + '(cffi-features:flat-namespace))) -;;; Symbol case. +;;;# Symbol Case (defun canonicalize-symbol-name-case (name) (declare (string name)) @@ -375,7 +368,10 @@ WITH-POINTER-TO-VECTOR-DATA." (setf (car lib) (sys:int-sap 0)))) (defun native-namestring (pathname) - (ext:unix-namestring pathname)) + ;; UNIX-NAMESTRING seems to be buggy? + ;; (ext:unix-namestring #p"/tmp/foo bar baz/bar") => NIL + #-(and) (ext:unix-namestring pathname) + (namestring pathname)) ;;;# Foreign Globals diff --git a/external/cffi.darcs/src/cffi-corman.lisp b/external/cffi.darcs/src/cffi-corman.lisp index bf31b00..f712648 100644 --- a/external/cffi.darcs/src/cffi-corman.lisp +++ b/external/cffi.darcs/src/cffi-corman.lisp @@ -32,7 +32,7 @@ ;;;# Administrivia (defpackage #:cffi-sys - (:use #:common-lisp #:c-types #:cffi-utils) + (:use #:common-lisp #:c-types #:cffi-utils #:alexandria) (:export #:canonicalize-symbol-name-case #:foreign-pointer @@ -62,19 +62,14 @@ (in-package #:cffi-sys) -;;;# Features +;;;# Mis-features (eval-when (:compile-toplevel :load-toplevel :execute) (mapc (lambda (feature) (pushnew feature *features*)) - '(;; Backend mis-features. - cffi-features:no-long-long - cffi-features:no-foreign-funcall - ;; OS/CPU features. - cffi-features:windows - cffi-features:x86 - ))) - -;;; Symbol case. + '(cffi-features:no-long-long + cffi-features:no-foreign-funcall))) + +;;;$ Symbol Case (defun canonicalize-symbol-name-case (name) (declare (string name)) diff --git a/external/cffi.darcs/src/cffi-ecl.lisp b/external/cffi.darcs/src/cffi-ecl.lisp index 6cdf94d..f538a4f 100644 --- a/external/cffi.darcs/src/cffi-ecl.lisp +++ b/external/cffi.darcs/src/cffi-ecl.lisp @@ -28,7 +28,7 @@ ;;;# Administrivia (defpackage #:cffi-sys - (:use #:common-lisp #:cffi-utils) + (:use #:common-lisp #:cffi-utils #:alexandria) (:export #:canonicalize-symbol-name-case #:foreign-pointer @@ -58,24 +58,14 @@ (in-package #:cffi-sys) -;;;# Features +;;;# Mis-features (eval-when (:compile-toplevel :load-toplevel :execute) (mapc (lambda (feature) (pushnew feature *features*)) - '(;; Backend mis-features. - cffi-features:no-long-long - cffi-features:flat-namespace - ;; OS/CPU features. - #+:darwin cffi-features:darwin - #+:darwin cffi-features:unix - #+:unix cffi-features:unix - #+:win32 cffi-features:windows - ;; XXX: figure out a way to get a X86 feature - ;;#+:athlon cffi-features:x86 - #+:powerpc7450 cffi-features:ppc32 - ))) - -;;; Symbol case. + '(cffi-features:no-long-long + cffi-features:flat-namespace))) + +;;;# Symbol Case (defun canonicalize-symbol-name-case (name) (declare (string name)) diff --git a/external/cffi.darcs/src/cffi-gcl.lisp b/external/cffi.darcs/src/cffi-gcl.lisp index fa13809..4a6bd04 100644 --- a/external/cffi.darcs/src/cffi-gcl.lisp +++ b/external/cffi.darcs/src/cffi-gcl.lisp @@ -42,7 +42,7 @@ ;;;# Administrivia (defpackage #:cffi-sys - (:use #:common-lisp) + (:use #:common-lisp #:alexandria) (:export #:canonicalize-symbol-name-case #:pointerp diff --git a/external/cffi.darcs/src/cffi-lispworks.lisp b/external/cffi.darcs/src/cffi-lispworks.lisp index 0b0102c..9c53faf 100644 --- a/external/cffi.darcs/src/cffi-lispworks.lisp +++ b/external/cffi.darcs/src/cffi-lispworks.lisp @@ -28,7 +28,7 @@ ;;;# Administrivia (defpackage #:cffi-sys - (:use #:cl #:cffi-utils) + (:use #:cl #:cffi-utils #:alexandria) (:export #:canonicalize-symbol-name-case #:foreign-pointer @@ -60,21 +60,13 @@ (in-package #:cffi-sys) -;;;# Features +;;;# Mis-features (eval-when (:compile-toplevel :load-toplevel :execute) (mapc (lambda (feature) (pushnew feature *features*)) - '(;; Backend mis-features. - cffi-features:no-long-long - ;; OS/CPU features. - #+darwin cffi-features:darwin - #+unix cffi-features:unix - #+win32 cffi-features:windows - #+harp::pc386 cffi-features:x86 - #+harp::powerpc cffi-features:ppc32 - ))) - -;;; Symbol case. + '(#-lispworks-64bit cffi-features:no-long-long))) + +;;;# Symbol Case (defun canonicalize-symbol-name-case (name) (declare (string name)) @@ -155,27 +147,32 @@ be stack allocated if supported by the implementation." (defun convert-foreign-type (cffi-type) "Convert a CFFI type keyword to an FLI type." (ecase cffi-type - (:char :byte) - (:unsigned-char '(:unsigned :byte)) - (:short :short) - (:unsigned-short '(:unsigned :short)) - (:int :int) - (:unsigned-int '(:unsigned :int)) - (:long :long) - (:unsigned-long '(:unsigned :long)) - (:float :float) - (:double :double) - (:pointer :pointer) - (:void :void))) + (:char :byte) + (:unsigned-char '(:unsigned :byte)) + (:short :short) + (:unsigned-short '(:unsigned :short)) + (:int :int) + (:unsigned-int '(:unsigned :int)) + (:long :long) + (:unsigned-long '(:unsigned :long)) + #+lispworks-64bit + (:long-long '(:long :long)) + #+lispworks-64bit + (:unsigned-long-long '(:unsigned :long :long)) + (:float :float) + (:double :double) + (:pointer :pointer) + (:void :void))) ;;; Convert a CFFI type keyword to a symbol suitable for passing to ;;; FLI:FOREIGN-TYPED-AREF. #+#.(cl:if (cl:find-symbol "FOREIGN-TYPED-AREF" "FLI") '(and) '(or)) (defun convert-foreign-typed-aref-type (cffi-type) (ecase cffi-type - ((:char :short :int :long) + ((:char :short :int :long #+lispworks-64bit :long-long) `(signed-byte ,(* 8 (%foreign-type-size cffi-type)))) - ((:unsigned-char :unsigned-short :unsigned-int :unsigned-long) + ((:unsigned-char :unsigned-short :unsigned-int :unsigned-long + #+lispworks-64bit :unsigned-long-long) `(unsigned-byte ,(* 8 (%foreign-type-size cffi-type)))) (:float 'single-float) (:double 'double-float))) @@ -186,13 +183,20 @@ be stack allocated if supported by the implementation." (setf ptr (inc-pointer ptr offset))) (fli:dereference ptr :type (convert-foreign-type type))) +;; Lispworks 5.0 on 64-bit platforms doesn't have [u]int64 support in +;; FOREIGN-TYPED-AREF. That was implemented in 5.1. +#+(and lispworks-64bit lispworks5.0) +(defun 64-bit-type-p (type) + (member type '(:long :unsigned-long :long-long :unsigned-long-long))) + ;;; In LispWorks versions where FLI:FOREIGN-TYPED-AREF is fbound, use ;;; it instead of FLI:DEREFERENCE in the optimizer for %MEM-REF. #+#.(cl:if (cl:find-symbol "FOREIGN-TYPED-AREF" "FLI") '(and) '(or)) (define-compiler-macro %mem-ref (&whole form ptr type &optional (off 0)) (if (constantp type) (let ((type (eval type))) - (if (eql type :pointer) + (if (or #+(and lispworks-64bit lispworks5.0) (64-bit-type-p type) + (eql type :pointer)) (let ((fli-type (convert-foreign-type type)) (ptr-form (if (eql off 0) ptr `(inc-pointer ,ptr ,off)))) `(fli:dereference ,ptr-form :type ',fli-type)) @@ -225,7 +229,8 @@ be stack allocated if supported by the implementation." (if (constantp type) (once-only (val) (let ((type (eval type))) - (if (eql type :pointer) + (if (or #+(and lispworks-64bit lispworks5.0) (64-bit-type-p type) + (eql type :pointer)) (let ((fli-type (convert-foreign-type type)) (ptr-form (if (eql off 0) ptr `(inc-pointer ,ptr ,off)))) `(setf (fli:dereference ,ptr-form :type ',fli-type) ,val)) diff --git a/external/cffi.darcs/src/cffi-openmcl.lisp b/external/cffi.darcs/src/cffi-openmcl.lisp index 1671004..081573f 100644 --- a/external/cffi.darcs/src/cffi-openmcl.lisp +++ b/external/cffi.darcs/src/cffi-openmcl.lisp @@ -28,7 +28,7 @@ ;;;# Administrivia (defpackage #:cffi-sys - (:use #:common-lisp #:ccl #:cffi-utils) + (:use #:common-lisp #:ccl #:cffi-utils #:alexandria) (:export #:canonicalize-symbol-name-case #:foreign-pointer @@ -59,20 +59,13 @@ (in-package #:cffi-sys) -;;;# Features +;;;# Mis-features (eval-when (:compile-toplevel :load-toplevel :execute) (mapc (lambda (feature) (pushnew feature *features*)) - '(;; OS/CPU features. - #+darwin-target cffi-features:darwin - #+unix cffi-features:unix - #+ppc32-target cffi-features:ppc32 - #+x8664-target cffi-features:x86-64 - ;; Misfeatures. - cffi-features:flat-namespace - ))) - -;;; Symbol case. + '(cffi-features:flat-namespace))) + +;;;# Symbol Case (defun canonicalize-symbol-name-case (name) (declare (string name)) diff --git a/external/cffi.darcs/src/cffi-sbcl.lisp b/external/cffi.darcs/src/cffi-sbcl.lisp index 7c93200..baf00ef 100644 --- a/external/cffi.darcs/src/cffi-sbcl.lisp +++ b/external/cffi.darcs/src/cffi-sbcl.lisp @@ -28,7 +28,7 @@ ;;;# Administrivia (defpackage #:cffi-sys - (:use #:common-lisp #:sb-alien #:cffi-utils) + (:use #:common-lisp #:sb-alien #:cffi-utils #:alexandria) (:export #:canonicalize-symbol-name-case #:foreign-pointer @@ -59,22 +59,13 @@ (in-package #:cffi-sys) -;;;# Features +;;;# Mis-features (eval-when (:compile-toplevel :load-toplevel :execute) (mapc (lambda (feature) (pushnew feature *features*)) - '(;; OS/CPU features. - #+darwin cffi-features:darwin - #+(and unix (not win32)) cffi-features:unix - #+win32 cffi-features:windows - #+x86 cffi-features:x86 - #+x86-64 cffi-features:x86-64 - #+(and ppc (not ppc64)) cffi-features:ppc32 - ;; Misfeatures - cffi-features:flat-namespace - ))) - -;;; Symbol case. + '(cffi-features:flat-namespace))) + +;;;# Symbol Case (declaim (inline canonicalize-symbol-name-case)) (defun canonicalize-symbol-name-case (name) @@ -350,5 +341,5 @@ WITH-POINTER-TO-VECTOR-DATA." (defun %foreign-symbol-pointer (name library) "Returns a pointer to a foreign symbol NAME." (declare (ignore library)) - (let-when (address (sb-sys:find-foreign-symbol-address name)) + (when-let (address (sb-sys:find-foreign-symbol-address name)) (sb-sys:int-sap address))) diff --git a/external/cffi.darcs/src/cffi-scl.lisp b/external/cffi.darcs/src/cffi-scl.lisp index 327634e..69c1ec6 100644 --- a/external/cffi.darcs/src/cffi-scl.lisp +++ b/external/cffi.darcs/src/cffi-scl.lisp @@ -29,7 +29,7 @@ ;;;# Administrivia (defpackage #:cffi-sys - (:use #:common-lisp #:alien #:c-call #:cffi-utils) + (:use #:common-lisp #:alien #:c-call #:cffi-utils #:alexandria) (:export #:canonicalize-symbol-name-case #:foreign-pointer @@ -60,24 +60,13 @@ (in-package #:cffi-sys) -;;;# Features +;;;# Mis-features (eval-when (:compile-toplevel :load-toplevel :execute) (mapc (lambda (feature) (pushnew feature *features*)) - '(;; OS/CPU features. - #+unix cffi-features:unix - #+x86 cffi-features:x86 - #+amd64 cffi-features:x86-64 - #+(and ppc (not ppc64)) cffi-features:ppc32 - #+sparc cffi-features:sparc - #+sparc64 cffi-features:sparc64 - #+hppa cffi-features:hppa - #+hppa64 cffi-features:hppa64 - ;; Misfeatures - cffi-features:flat-namespace - ))) - -;;; Symbol case. + '(cffi-features:flat-namespace))) + +;;;# Symbol Case (defun canonicalize-symbol-name-case (name) (declare (string name)) diff --git a/external/cffi.darcs/src/features.lisp b/external/cffi.darcs/src/features.lisp index cb62a65..f91ff6d 100644 --- a/external/cffi.darcs/src/features.lisp +++ b/external/cffi.darcs/src/features.lisp @@ -32,6 +32,11 @@ ;;; CFFI-SYS backends take care of pushing the appropriate features to ;;; *features*. See each cffi-*.lisp file. +;;; +;;; Not anymore, I think we should use TRIVIAL-FEATURES for the +;;; platform features instead. Less pain. And maybe the +;;; CFFI-specific features should be in the CFFI-SYS package, +;;; unexported? This is here now for backwards compatibility. (defpackage #:cffi-features (:use #:cl) @@ -64,8 +69,7 @@ #:sparc #:sparc64 #:hppa - #:hppa64 - )) + #:hppa64)) (in-package #:cffi-features) @@ -87,3 +91,16 @@ that belong to the CFFI-FEATURES package." (:and (every #'cffi-feature-p (rest feature-expression))) (:or (some #'cffi-feature-p (rest feature-expression))) (:not (not (cffi-feature-p (cadr feature-expression)))))))))) + +;;; for backwards compatibility +(mapc (lambda (sym) (pushnew sym *features*)) + '(#+darwin darwin + #+unix unix + #+windows windows + #+ppc ppc32 + #+x86 x86 + #+x86-64 x86-64 + #+sparc sparc + #+sparc64 sparc64 + #+hppa hppa + #+hppa64 hppa64)) diff --git a/external/cffi.darcs/src/functions.lisp b/external/cffi.darcs/src/functions.lisp index a8b633e..f590541 100644 --- a/external/cffi.darcs/src/functions.lisp +++ b/external/cffi.darcs/src/functions.lisp @@ -283,9 +283,8 @@ arguments and does type promotion for the variadic arguments." (list :calling-convention cconv))) (defmacro defcallback (name-and-options return-type args &body body) - (multiple-value-bind (body docstring declarations) - (parse-body body) - (declare (ignore docstring)) + (multiple-value-bind (body declarations) + (parse-body body :documentation t) (let ((arg-names (mapcar #'car args)) (arg-types (mapcar #'cadr args)) (name (car (ensure-list name-and-options))) diff --git a/external/cffi.darcs/src/libraries.lisp b/external/cffi.darcs/src/libraries.lisp index e8b0954..d2a2235 100644 --- a/external/cffi.darcs/src/libraries.lisp +++ b/external/cffi.darcs/src/libraries.lisp @@ -193,18 +193,18 @@ ourselves." (handler-case (%load-foreign-library name path) (error (error) - (bif (file (find-file path *foreign-library-directories*)) - (handler-case - (%load-foreign-library name (native-namestring file)) - (simple-error (error) - (report-simple-error name error))) - (report-simple-error name error))))) + (if-let (file (find-file path *foreign-library-directories*)) + (handler-case + (%load-foreign-library name (native-namestring file)) + (simple-error (error) + (report-simple-error name error))) + (report-simple-error name error))))) (defun try-foreign-library-alternatives (name library-list) "Goes through a list of alternatives and only signals an error when none of alternatives were successfully loaded." (dolist (lib library-list) - (let-when (handle (ignore-errors (load-foreign-library-helper name lib))) + (when-let (handle (ignore-errors (load-foreign-library-helper name lib))) (return-from try-foreign-library-alternatives handle))) ;; Perhaps we should show the error messages we got for each ;; alternative if we can figure out a nice way to do that. @@ -213,7 +213,8 @@ none of alternatives were successfully loaded." (defparameter *cffi-feature-suffix-map* '((cffi-features:windows . ".dll") (cffi-features:darwin . ".dylib") - (cffi-features:unix . ".so")) + (cffi-features:unix . ".so") + (t . ".so")) "Mapping of OS feature keywords to shared library suffixes.") (defun default-library-suffix () diff --git a/external/cffi.darcs/src/package.lisp b/external/cffi.darcs/src/package.lisp index 3b48d16..e205d74 100644 --- a/external/cffi.darcs/src/package.lisp +++ b/external/cffi.darcs/src/package.lisp @@ -28,7 +28,7 @@ (in-package #:cl-user) (defpackage #:cffi - (:use #:common-lisp #:cffi-sys #:cffi-utils) + (:use #:common-lisp #:cffi-sys #:cffi-utils #:alexandria #:babel-encodings) (:import-from #:cffi-features #:cffi-feature-p) (:export ;; Types. @@ -54,6 +54,7 @@ #:with-pointer-to-vector-data ;; Foreign string operations. + #:*default-foreign-encoding* #:foreign-string-alloc #:foreign-string-free #:foreign-string-to-lisp @@ -89,6 +90,7 @@ #:defbitfield #:define-foreign-type #:define-parse-method + #:define-c-struct-wrapper #:foreign-enum-keyword #:foreign-enum-keyword-list #:foreign-enum-value diff --git a/external/cffi.darcs/src/strings.lisp b/external/cffi.darcs/src/strings.lisp index 9148a1e..e2a1978 100644 --- a/external/cffi.darcs/src/strings.lisp +++ b/external/cffi.darcs/src/strings.lisp @@ -3,6 +3,7 @@ ;;; strings.lisp --- Operations on foreign strings. ;;; ;;; Copyright (C) 2005-2006, James Bielman +;;; Copyright (C) 2005-2007, Luis Oliveira ;;; ;;; Permission is hereby granted, free of charge, to any person ;;; obtaining a copy of this software and associated documentation @@ -30,109 +31,265 @@ ;;;# Foreign String Conversion ;;; ;;; Functions for converting NULL-terminated C-strings to Lisp strings -;;; and vice versa. Currently this is blithely ignorant of encoding -;;; and assumes characters can fit in 8 bits. - -(defun lisp-string-to-foreign (string ptr size) - "Copy at most SIZE-1 characters from a Lisp STRING to PTR. -The foreign string will be null-terminated." - (decf size) - (etypecase string - (string - (loop with i = 0 for char across string - while (< i size) - do (%mem-set (char-code char) ptr :unsigned-char (post-incf i)) - finally (%mem-set 0 ptr :unsigned-char i))) - ((array (unsigned-byte 8)) - (loop with i = 0 for elt across string - while (< i size) - do (%mem-set elt ptr :unsigned-char (post-incf i)) - finally (%mem-set 0 ptr :unsigned-char i))))) - -(defun foreign-string-to-lisp (ptr &optional (size array-total-size-limit) - (null-terminated-p t)) - "Copy at most SIZE characters from PTR into a Lisp string. -If PTR is a null pointer, returns nil." - (unless (null-pointer-p ptr) - (with-output-to-string (s) - (loop for i fixnum from 0 below size - for code = (mem-ref ptr :unsigned-char i) - until (and null-terminated-p (zerop code)) - do (write-char (code-char code) s))))) +;;; and vice versa. The string functions accept an ENCODING keyword +;;; argument which is used to specify the encoding to use when +;;; converting to/from foreign strings. + +(defvar *default-foreign-encoding* :utf-8 + "Default foreign encoding.") + +;;; TODO: refactor, sigh. Also, this should probably be a function. +(defmacro bget (ptr off &optional (bytes 1) (endianness :ne)) + (let ((big-endian (member endianness + '(:be #+big-endian :ne #+little-endian :re)))) + (once-only (ptr off) + (ecase bytes + (1 `(mem-ref ,ptr :uint8 ,off)) + (2 (if big-endian + #+big-endian + `(mem-ref ,ptr :uint16 ,off) + #-big-endian + `(dpb (mem-ref ,ptr :uint8 ,off) (byte 8 8) + (mem-ref ,ptr :uint8 (1+ ,off))) + #+little-endian + `(mem-ref ,ptr :uint16 ,off) + #-little-endian + `(dpb (mem-ref ,ptr :uint8 (1+ ,off)) (byte 8 8) + (mem-ref ,ptr :uint8 ,off)))) + (4 (if big-endian + #+big-endian + `(mem-ref ,ptr :uint32 ,off) + #-big-endian + `(dpb (mem-ref ,ptr :uint8 ,off) (byte 8 24) + (dpb (mem-ref ,ptr :uint8 (1+ ,off)) (byte 8 16) + (dpb (mem-ref ,ptr :uint8 (+ ,off 2)) (byte 8 8) + (mem-ref ,ptr :uint8 (+ ,off 3))))) + #+little-endian + `(mem-ref ,ptr :uint32 ,off) + #-little-endian + `(dpb (mem-ref ,ptr :uint8 (+ ,off 3)) (byte 8 24) + (dpb (mem-ref ,ptr :uint8 (+ ,off 2)) (byte 8 16) + (dpb (mem-ref ,ptr :uint8 (1+ ,off)) (byte 8 8) + (mem-ref ,ptr :uint8 ,off)))))))))) + +(defmacro bset (val ptr off &optional (bytes 1) (endianness :ne)) + (let ((big-endian (member endianness + '(:be #+big-endian :ne #+little-endian :re)))) + (ecase bytes + (1 `(setf (mem-ref ,ptr :uint8 ,off) ,val)) + (2 (if big-endian + #+big-endian + `(setf (mem-ref ,ptr :uint16 ,off) ,val) + #-big-endian + `(setf (mem-ref ,ptr :uint8 (1+ ,off)) (ldb (byte 8 0) val) + (mem-ref ,ptr :uint8 ,off) (ldb (byte 8 8) val)) + #+little-endian + `(setf (mem-ref ,ptr :uint16 ,off) ,val) + #-little-endian + `(setf (mem-ref ,ptr :uint8 ,off) (ldb (byte 8 0) val) + (mem-ref ,ptr :uint8 (1+ ,off)) (ldb (byte 8 8) val)))) + (4 (if big-endian + #+big-endian + `(setf (mem-ref ,ptr :uint32 ,off) ,val) + #-big-endian + `(setf (mem-ref ,ptr :uint8 (+ 3 ,off)) (ldb (byte 8 0) val) + (mem-ref ,ptr :uint8 (+ 2 ,off)) (ldb (byte 8 8) val) + (mem-ref ,ptr :uint8 (1+ ,off)) (ldb (byte 8 16) val) + (mem-ref ,ptr :uint8 ,off) (ldb (byte 8 24) val)) + #+little-endian + `(setf (mem-ref ,ptr :uint32 ,off) ,val) + #-little-endian + `(setf (mem-ref ,ptr :uint8 ,off) (ldb (byte 8 0) val) + (mem-ref ,ptr :uint8 (1+ ,off)) (ldb (byte 8 8) val) + (mem-ref ,ptr :uint8 (+ ,off 2)) (ldb (byte 8 16) val) + (mem-ref ,ptr :uint8 (+ ,off 3)) (ldb (byte 8 24) val))))))) + +;;; TODO: tackle optimization notes. +(defparameter *foreign-string-mappings* + (instantiate-concrete-mappings + ;; :optimize ((speed 3) (debug 0) (compilation-speed 0) (safety 0)) + :octet-seq-getter bget + :octet-seq-setter bset + :octet-seq-type foreign-pointer + :code-point-seq-getter babel::string-get + :code-point-seq-setter babel::string-set + :code-point-seq-type babel:simple-unicode-string)) + +(defun null-terminator-len (encoding) + (length (enc-nul-encoding (get-character-encoding encoding)))) + +(defun lisp-string-to-foreign (string buffer bufsize &key (start 0) end offset + (encoding *default-foreign-encoding*)) + (check-type string string) + (when offset + (setq buffer (inc-pointer buffer offset))) + (with-checked-simple-vector ((string (coerce string 'babel:unicode-string)) + (start start) (end end)) + (declare (type simple-string string)) + (let ((mapping (lookup-mapping *foreign-string-mappings* encoding)) + (nul-len (null-terminator-len encoding))) + (assert (plusp bufsize)) + (multiple-value-bind (size end) + (funcall (octet-counter mapping) string start end (- bufsize nul-len)) + (funcall (encoder mapping) string start end buffer 0) + (dotimes (i nul-len) + (setf (mem-ref buffer :char (+ size i)) 0)))) + buffer)) + +;;; Expands into a loop that calculates the length of the foreign +;;; string at PTR plus OFFSET, using ACCESSOR and looking for a null +;;; terminator of LENGTH bytes. +(defmacro %foreign-string-length (ptr offset type length) + (once-only (ptr offset) + `(do ((i 0 (+ i ,length))) + ((zerop (mem-ref ,ptr ,type (+ ,offset i))) i) + (declare (fixnum i))))) + +;;; Return the length in octets of the null terminated foreign string +;;; at POINTER plus OFFSET octets, assumed to be encoded in ENCODING, +;;; a CFFI encoding. This should be smart enough to look for 8-bit vs +;;; 16-bit null terminators, as appropriate for the encoding. +(defun foreign-string-length (pointer &key (encoding *default-foreign-encoding*) + (offset 0)) + (ecase (null-terminator-len encoding) + (1 (%foreign-string-length pointer offset :uint8 1)) + (2 (%foreign-string-length pointer offset :uint16 2)) + (4 (%foreign-string-length pointer offset :uint32 4)))) + +(defun foreign-string-to-lisp (pointer &key (offset 0) count + (max-chars (1- array-total-size-limit)) + (encoding *default-foreign-encoding*)) + "Copy at most COUNT bytes from POINTER plus OFFSET encoded in +ENCODING into a Lisp string and return it. If POINTER is a null +pointer, NIL is returned." + (unless (null-pointer-p pointer) + (let ((count (or count + (foreign-string-length + pointer :encoding encoding :offset offset))) + (mapping (lookup-mapping *foreign-string-mappings* encoding))) + (assert (plusp max-chars)) + (multiple-value-bind (size new-end) + (funcall (code-point-counter mapping) + pointer offset (+ offset count) max-chars) + (let ((string (make-string size))) + (funcall (decoder mapping) pointer offset new-end string 0) + (values string (- new-end offset))))))) ;;;# Using Foreign Strings -(defun foreign-string-alloc (string) +(defun foreign-string-alloc (string &key (encoding *default-foreign-encoding*) + (null-terminated-p t) (start 0) end) "Allocate a foreign string containing Lisp string STRING. The string must be freed with FOREIGN-STRING-FREE." - (check-type string (or string (array (unsigned-byte 8)))) - (let* ((length (1+ (length string))) - (ptr (foreign-alloc :char :count length))) - (lisp-string-to-foreign string ptr length) - ptr)) + (check-type string string) + (with-checked-simple-vector ((string (coerce string 'babel:unicode-string)) + (start start) (end end)) + (declare (type simple-string string)) + (let* ((mapping (lookup-mapping *foreign-string-mappings* encoding)) + (count (funcall (octet-counter mapping) string start end 0)) + (length (if null-terminated-p + (+ count (null-terminator-len encoding)) + count)) + (ptr (foreign-alloc :char :count length))) + (funcall (encoder mapping) string start end ptr 0) + (when null-terminated-p + (dotimes (i (null-terminator-len encoding)) + (setf (mem-ref ptr :char (+ count i)) 0))) + (values ptr length)))) (defun foreign-string-free (ptr) "Free a foreign string allocated by FOREIGN-STRING-ALLOC." (foreign-free ptr)) -(defmacro with-foreign-string ((var lisp-string) &body body) - "Bind VAR to a foreign string containing LISP-STRING in BODY." - (with-unique-names (str length) - `(let* ((,str ,lisp-string) - (,length (progn - (check-type ,str (or string (array (unsigned-byte 8)))) - (1+ (length ,str))))) - (with-foreign-pointer (,var ,length) - (lisp-string-to-foreign ,str ,var ,length) - ,@body)))) +(defmacro with-foreign-string ((var-or-vars lisp-string &rest args) &body body) + "VAR-OR-VARS is not evaluated ans should a list of the form +\(VAR &OPTIONAL BYTE-SIZE-VAR) or just a VAR symbol. VAR is +bound to a foreign string containing LISP-STRING in BODY. When +BYTE-SIZE-VAR is specified then bind the C buffer size +\(including the possible null terminator\(s)) to this variable." + (destructuring-bind (var &optional size-var) + (ensure-list var-or-vars) + `(multiple-value-bind (,var ,@(when size-var (list size-var))) + (foreign-string-alloc ,lisp-string ,@args) + (unwind-protect + (progn ,@body) + (foreign-string-free ,var))))) (defmacro with-foreign-strings (bindings &body body) + "See WITH-FOREIGN-STRING's documentation." (if bindings `(with-foreign-string ,(first bindings) (with-foreign-strings ,(rest bindings) ,@body)) `(progn ,@body))) -(defmacro with-foreign-pointer-as-string ((var size &optional size-var) - &body body) - "Like WITH-FOREIGN-POINTER except VAR as a Lisp string is used as -the return value of an implicit PROGN around BODY." - `(with-foreign-pointer (,var ,size ,size-var) - (progn - ,@body - (foreign-string-to-lisp ,var)))) +(defmacro with-foreign-pointer-as-string + ((var-or-vars size &rest args) &body body) + "VAR-OR-VARS is not evaluated and should be a list of the form +\(VAR &OPTIONAL SIZE-VAR) or just a VAR symbol. VAR is bound to +a foreign buffer of size SIZE within BODY. The return value is +constructed by calling FOREIGN-STRING-TO-LISP on the foreign +buffer along with ARGS." ; fix wording, sigh + (destructuring-bind (var &optional size-var) + (ensure-list var-or-vars) + `(with-foreign-pointer (,var ,size ,size-var) + (progn + ,@body + (values (foreign-string-to-lisp ,var ,@args)))))) ;;;# Automatic Conversion of Foreign Strings (define-foreign-type foreign-string-type () - () + (;; CFFI encoding of this string. + (encoding :initform nil :initarg :encoding :reader encoding) + ;; Should we free after translating from foreign? + (free-from-foreign :initarg :free-from-foreign + :reader fst-free-from-foreign-p + :initform nil :type boolean) + ;; Should we free after translating to foreign? + (free-to-foreign :initarg :free-to-foreign + :reader fst-free-to-foreign-p + :initform t :type boolean)) (:actual-type :pointer) (:simple-parser :string)) +;;; describe me +(defun fst-encoding (type) + (or (encoding type) *default-foreign-encoding*)) + +;;; Display the encoding when printing a FOREIGN-STRING-TYPE instance. +(defmethod print-object ((type foreign-string-type) stream) + (print-unreadable-object (type stream :type t) + (format stream "~S" (fst-encoding type)))) + (defmethod translate-to-foreign ((s string) (type foreign-string-type)) - (values (foreign-string-alloc s) t)) + (values (foreign-string-alloc s :encoding (fst-encoding type)) + (fst-free-to-foreign-p type))) (defmethod translate-to-foreign (obj (type foreign-string-type)) (cond ((pointerp obj) (values obj nil)) - ((typep obj '(array (unsigned-byte 8))) - (values (foreign-string-alloc obj) t)) - (t (error "~A is not a Lisp string, (array (unsigned-byte 8)) or pointer." - obj)))) + ;; FIXME: we used to support UB8 vectors but not anymore. + ;; ((typep obj '(array (unsigned-byte 8))) + ;; (values (foreign-string-alloc obj) t)) + (t (error "~A is not a Lisp string or pointer." obj)))) (defmethod translate-from-foreign (ptr (type foreign-string-type)) - (foreign-string-to-lisp ptr)) + (unwind-protect + (values (foreign-string-to-lisp ptr :encoding (fst-encoding type))) + (when (fst-free-from-foreign-p type) + (foreign-free ptr)))) (defmethod free-translated-object (ptr (type foreign-string-type) free-p) (when free-p (foreign-string-free ptr))) -;;; STRING+PTR +;;;# STRING+PTR (define-foreign-type foreign-string+ptr-type (foreign-string-type) () (:simple-parser :string+ptr)) (defmethod translate-from-foreign (value (type foreign-string+ptr-type)) - (list (foreign-string-to-lisp value) value)) + (list (call-next-method) value)) diff --git a/external/cffi.darcs/src/types.lisp b/external/cffi.darcs/src/types.lisp index 3773296..49227ba 100644 --- a/external/cffi.darcs/src/types.lisp +++ b/external/cffi.darcs/src/types.lisp @@ -47,6 +47,52 @@ (define-built-in-foreign-type :long-long) (define-built-in-foreign-type :unsigned-long-long)) +;;; Define emulated LONG-LONG types. Needs checking whether we're +;;; using the right sizes on various platforms. +;;; +;;; A possibly better, certainly faster though more intrusive, +;;; alternative is available here: +;;; +#+cffi-features:no-long-long +(eval-when (:compile-toplevel :load-toplevel :execute) + (defclass emulated-llong-type (foreign-type) ()) + (defmethod foreign-type-size ((tp emulated-llong-type)) 8) + (defmethod foreign-type-alignment ((tp emulated-llong-type)) 8) + (defmethod aggregatep ((tp emulated-llong-type)) nil) + + (define-foreign-type emulated-llong (emulated-llong-type) + () + (:simple-parser :long-long)) + + (define-foreign-type emulated-ullong (emulated-llong-type) + () + (:simple-parser :unsigned-long-long)) + + (defmethod canonicalize ((tp emulated-llong)) :long-long) + (defmethod unparse-type ((tp emulated-llong)) :long-long) + (defmethod canonicalize ((tp emulated-ullong)) :unsigned-long-long) + (defmethod unparse-type ((tp emulated-ullong)) :unsigned-long-long) + + (defun %emulated-mem-ref-64 (ptr type offset) + (let ((value #+big-endian + (+ (ash (mem-ref ptr :unsigned-long offset) 32) + (mem-ref ptr :unsigned-long (+ offset 4))) + #+little-endian + (+ (mem-ref ptr :unsigned-long offset) + (ash (mem-ref ptr :unsigned-long (+ offset 4)) -32)))) + (if (and (eq type :long-long) (logbitp 63 value)) + (lognot (logxor value #xFFFFFFFFFFFFFFFF)) + value))) + + (defun %emulated-mem-set-64 (value ptr type offset) + (when (and (eq type :long-long) (minusp value)) + (setq value (lognot (logxor value #xFFFFFFFFFFFFFFFF)))) + (%mem-set (ldb (byte 32 0) value) ptr :unsigned-long + #+big-endian (+ offset 4) #+little-endian offset) + (%mem-set (ldb (byte 32 32) value) ptr :unsigned-long + #+big-endian offset #+little-endian (+ offset 4)) + value)) + ;;; When some lisp other than SCL supports :long-double we should ;;; use #-cffi-features:no-long-double here instead. #+(and scl long-float) (define-built-in-foreign-type :long-double) @@ -61,25 +107,39 @@ we don't return its 'value' but a pointer to it, which is PTR itself." (let ((ptype (parse-type type))) (if (aggregatep ptype) (inc-pointer ptr offset) - (let ((raw-value (%mem-ref ptr (canonicalize ptype) offset))) - (translate-from-foreign raw-value ptype))))) + (let ((ctype (canonicalize ptype))) + #+cffi-features:no-long-long + (when (or (eq ctype :long-long) (eq ctype :unsigned-long-long)) + (return-from mem-ref + (translate-from-foreign (%emulated-mem-ref-64 ptr ctype offset) + ptype))) + ;; normal branch + (translate-from-foreign (%mem-ref ptr ctype offset) ptype))))) (define-compiler-macro mem-ref (&whole form ptr type &optional (offset 0)) "Compiler macro to open-code MEM-REF when TYPE is constant." (if (constantp type) - (let ((parsed-type (parse-type (eval type)))) + (let* ((parsed-type (parse-type (eval type))) + (ctype (canonicalize parsed-type))) + ;; Bail out when using emulated long long types. + #+cffi-features:no-long-long + (when (member ctype '(:long-long :unsigned-long-long)) + (return-from mem-ref form)) (if (aggregatep parsed-type) `(inc-pointer ,ptr ,offset) - (expand-from-foreign - `(%mem-ref ,ptr ,(canonicalize parsed-type) ,offset) - parsed-type))) + (expand-from-foreign `(%mem-ref ,ptr ,ctype ,offset) parsed-type))) form)) (defun mem-set (value ptr type &optional (offset 0)) "Set the value of TYPE at OFFSET bytes from PTR to VALUE." - (let ((ptype (parse-type type))) - (%mem-set (translate-to-foreign value ptype) - ptr (canonicalize ptype) offset))) + (let* ((ptype (parse-type type)) + (ctype (canonicalize ptype))) + #+cffi-features:no-long-long + (when (or (eq ctype :long-long) (eq ctype :unsigned-long-long)) + (return-from mem-set + (%emulated-mem-set-64 (translate-to-foreign value ptype) + ptr ctype offset))) + (%mem-set (translate-to-foreign value ptype) ptr ctype offset))) (define-setf-expander mem-ref (ptr type &optional (offset 0) &environment env) "SETF expander for MEM-REF that doesn't rebind TYPE. @@ -112,9 +172,13 @@ to open-code (SETF MEM-REF) forms." (&whole form value ptr type &optional (offset 0)) "Compiler macro to open-code (SETF MEM-REF) when type is constant." (if (constantp type) - (let ((parsed-type (parse-type (eval type)))) - `(%mem-set ,(expand-to-foreign value parsed-type) ,ptr - ,(canonicalize parsed-type) ,offset)) + (let* ((parsed-type (parse-type (eval type))) + (ctype (canonicalize parsed-type))) + ;; Bail out when using emulated long long types. + #+cffi-features:no-long-long + (when (member ctype '(:long-long :unsigned-long-long)) + (return-from mem-set form)) + `(%mem-set ,(expand-to-foreign value parsed-type) ,ptr ,ctype ,offset)) form)) ;;;# Dereferencing Foreign Arrays @@ -446,9 +510,9 @@ The foreign array must be freed with foreign-array-free." "Return alignment for TYPE according to ALIGNMENT-TYPE." (declare (ignorable firstp)) (ecase alignment-type - (:normal #-(and cffi-features:darwin cffi-features:ppc32) + (:normal #-(and darwin ppc) (foreign-type-alignment type) - #+(and cffi-features:darwin cffi-features:ppc32) + #+(and darwin ppc) (if firstp (foreign-type-alignment type) (min 4 (foreign-type-alignment type)))))) @@ -497,7 +561,7 @@ The foreign array must be freed with foreign-array-free." (discard-docstring fields) `(eval-when (:compile-toplevel :load-toplevel :execute) ;; n-f-s-d could do with this with mop:ensure-class. - ,(let-when (class (getf (cdr (ensure-list name-and-options)) :class)) + ,(when-let (class (getf (cdr (ensure-list name-and-options)) :class)) `(defclass ,class (foreign-struct-type) ())) (notice-foreign-struct-definition ',name-and-options ',fields))) @@ -580,6 +644,35 @@ foreign slots in PTR of TYPE. Similar to WITH-SLOTS." collect `(,var (foreign-slot-value ,ptr-var ',type ',var))) ,@body)))) +;;; We could add an option to define a struct instead of a class, in +;;; the unlikely event someone needs something like that. +(defmacro define-c-struct-wrapper (class-and-type supers &optional slots) + "Define a new class with CLOS slots matching those of a foreign +struct type. An INITIALIZE-INSTANCE method is defined which +takes a :POINTER initarg that is used to store the slots of a +foreign object. This pointer is only used for initialization and +it is not retained. + +CLASS-AND-TYPE is either a list of the form (class-name +struct-type) or a single symbol naming both. The class will +inherit SUPERS. If a list of SLOTS is specified, only those +slots will be defined and stored." + (destructuring-bind (class-name &optional (struct-type class-name)) + (ensure-list class-and-type) + (let ((slots (or slots (foreign-slot-names struct-type)))) + `(progn + (defclass ,class-name ,supers + ,(loop for slot in slots collect + (list slot :reader (symbolicate class-name "-" slot)))) + ;; This could be done in a parent class by using + ;; FOREIGN-SLOT-NAMES when instantiating but then the compiler + ;; macros wouldn't kick in. + (defmethod initialize-instance :after ((inst ,class-name) &key pointer) + (with-foreign-slots (,slots pointer ,struct-type) + ,@(loop for slot in slots collect + `(setf (slot-value inst ',slot) ,slot)))) + ',class-name)))) + ;;;# Foreign Unions ;;; ;;; A union is a FOREIGN-STRUCT-TYPE in which all slots have an offset @@ -753,11 +846,8 @@ The buffer has dynamic extent and may be stack allocated." (defctype :ushort :unsigned-short) (defctype :uint :unsigned-int) (defctype :ulong :unsigned-long) - -#-cffi-features:no-long-long -(progn - (defctype :llong :long-long) - (defctype :ullong :unsigned-long-long)) +(defctype :llong :long-long) +(defctype :ullong :unsigned-long-long) ;;; We try to define the :[u]int{8,16,32,64} types by looking at ;;; the sizes of the built-in integer types and defining typedefs. @@ -765,14 +855,18 @@ The buffer has dynamic extent and may be stack allocated." (macrolet ((match-types (sized-types mtypes) `(progn - ,@(loop for (type . size) in sized-types - for m = (car (member size mtypes :key #'foreign-type-size)) + ,@(loop for (type . size-or-type) in sized-types + for m = (car (member (if (keywordp size-or-type) + (foreign-type-size size-or-type) + size-or-type) + mtypes :key #'foreign-type-size)) when m collect `(defctype ,type ,m))))) ;; signed - (match-types ((:int8 . 1) (:int16 . 2) (:int32 . 4) (:int64 . 8)) - (:char :short :int :long - #-cffi-features:no-long-long :long-long)) + (match-types ((:int8 . 1) (:int16 . 2) (:int32 . 4) (:int64 . 8) + (:intptr . :pointer)) + (:char :short :int :long :long-long)) ;; unsigned - (match-types ((:uint8 . 1) (:uint16 . 2) (:uint32 . 4) (:uint64 . 8)) + (match-types ((:uint8 . 1) (:uint16 . 2) (:uint32 . 4) (:uint64 . 8) + (:uintptr . :pointer)) (:unsigned-char :unsigned-short :unsigned-int :unsigned-long - #-cffi-features:no-long-long :unsigned-long-long)))) + :unsigned-long-long)))) diff --git a/external/cffi.darcs/src/utils.lisp b/external/cffi.darcs/src/utils.lisp index 0f19576..a20857d 100644 --- a/external/cffi.darcs/src/utils.lisp +++ b/external/cffi.darcs/src/utils.lisp @@ -27,17 +27,12 @@ (in-package #:cl-user) +;;; This package is for CFFI's internal use. No effort is made to +;;; maintain backwards compatibility. Use at your own risk. (defpackage #:cffi-utils - (:use #:common-lisp) + (:use #:common-lisp #:alexandria) (:export #:discard-docstring - #:parse-body - #:with-unique-names - #:once-only - #:ensure-list - #:make-gensym-list #:symbolicate - #:let-when - #:bif #:post-incf #:single-bit-p #:warn-if-kw-or-belongs-to-cl)) @@ -56,42 +51,12 @@ (setq ,(car new) (+ ,(car new) ,delta)) ,setter)))) -(defun ensure-list (x) - "Make into list if atom." - (if (listp x) x (list x))) - (defmacro discard-docstring (body-var &optional force) "Discards the first element of the list in body-var if it's a string and the only element (or if FORCE is T)." `(when (and (stringp (car ,body-var)) (or ,force (cdr ,body-var))) (pop ,body-var))) -;;; Parse a body of code, removing an optional documentation string -;;; and declaration forms. Returns the actual body, docstring, and -;;; declarations as three multiple values. -(defun parse-body (body) - (let ((docstring nil) - (declarations nil)) - (when (and (stringp (car body)) (cdr body)) - (setf docstring (pop body))) - (loop while (and (consp (car body)) (eql (caar body) 'cl:declare)) - do (push (pop body) declarations)) - (values body docstring (nreverse declarations)))) - -;;; LET-IF (renamed to BIF) and LET-WHEN taken from KMRCL -(defmacro let-when ((var test-form) &body body) - `(let ((,var ,test-form)) - (when ,var ,@body))) - -(defmacro bif ((var test-form) if-true &optional if-false) - `(let ((,var ,test-form)) - (if ,var ,if-true ,if-false))) - -;;; ONCE-ONLY macro taken from PAIP -(defun starts-with (list x) - "Is x a list whose first element is x?" - (and (consp list) (eql (first list) x))) - (defun side-effect-free? (exp) "Is exp a constant, variable, or function, or of the form (THE type x) where x is side-effect-free?" @@ -100,49 +65,9 @@ string and the only element (or if FORCE is T)." (and (starts-with exp 'the) (side-effect-free? (third exp))))) -(defmacro once-only (variables &rest body) - "Returns the code built by BODY. If any of VARIABLES - might have side effects, they are evaluated once and stored - in temporary variables that are then passed to BODY." - (assert (every #'symbolp variables)) - (let ((temps nil)) - (dotimes (i (length variables)) (push (gensym "ONCE") temps)) - `(if (every #'side-effect-free? (list .,variables)) - (progn .,body) - (list 'let - ,`(list ,@(mapcar #'(lambda (tmp var) - `(list ',tmp ,var)) - temps variables)) - (let ,(mapcar #'(lambda (var tmp) `(,var ',tmp)) - variables temps) - .,body))))) - ;;;; The following utils were taken from SBCL's ;;;; src/code/*-extensions.lisp -;;; Automate an idiom often found in macros: -;;; (LET ((FOO (GENSYM "FOO")) -;;; (MAX-INDEX (GENSYM "MAX-INDEX-"))) -;;; ...) -;;; -;;; "Good notation eliminates thought." -- Eric Siggia -;;; -;;; Incidentally, this is essentially the same operator which -;;; _On Lisp_ calls WITH-GENSYMS. -(defmacro with-unique-names (symbols &body body) - `(let ,(mapcar (lambda (symbol) - (let* ((symbol-name (symbol-name symbol)) - (stem (if (every #'alpha-char-p symbol-name) - symbol-name - (concatenate 'string symbol-name "-")))) - `(,symbol (gensym ,stem)))) - symbols) - ,@body)) - -(defun make-gensym-list (n) - "Return a list of N gensyms." - (loop repeat n collect (gensym))) - (defun symbolicate (&rest things) "Concatenate together the names of some strings and symbols, producing a symbol in the current package." diff --git a/external/cffi.darcs/tests/defcfun.lisp b/external/cffi.darcs/tests/defcfun.lisp index d698b21..52d5fcb 100644 --- a/external/cffi.darcs/tests/defcfun.lisp +++ b/external/cffi.darcs/tests/defcfun.lisp @@ -156,6 +156,9 @@ (control :string) &rest) +;;; CLISP's compiler discards macro docstrings. +#+clisp (pushnew 'defcfun.varargs.docstrings rt::*expected-failures*) + (deftest defcfun.varargs.docstrings (documentation 'sprintf 'function) "sprintf docstring") @@ -195,7 +198,7 @@ (with-foreign-pointer-as-string (s 100) (setf (mem-ref s :char) 0) (sprintf s "%.2Lf" :long-double pi)) - "3.14") + "3.14" 4) (deftest defcfun.varargs.string (with-foreign-pointer-as-string (s 100) @@ -207,7 +210,8 @@ ;;; (c-function rettype arg-types) ;;; (gen-function-test rettype arg-types)) -#+(:and (:not :ecl) #.(cl:if (cl:>= cl:lambda-parameters-limit 127) '(:and) '(:or))) +#+(and (not ecl) + #.(cl:if (cl:>= cl:lambda-parameters-limit 127) '(:and) '(:or))) (progn (defcfun "sum_127_no_ll" :long (a1 :long) (a2 :unsigned-long) (a3 :short) (a4 :unsigned-short) (a5 :float) diff --git a/external/cffi.darcs/tests/foreign-globals.lisp b/external/cffi.darcs/tests/foreign-globals.lisp index bff6471..ee12d12 100644 --- a/external/cffi.darcs/tests/foreign-globals.lisp +++ b/external/cffi.darcs/tests/foreign-globals.lisp @@ -27,23 +27,20 @@ (in-package #:cffi-tests) -(defcvar ("var_char" *char-var*) :char) -(defcvar "var_unsigned_char" :unsigned-char) -(defcvar "var_short" :short) -(defcvar "var_unsigned_short" :unsigned-short) -(defcvar "var_int" :int) -(defcvar "var_unsigned_int" :unsigned-int) -(defcvar "var_long" :long) -(defcvar "var_unsigned_long" :unsigned-long) -(defcvar "var_float" :float) -(defcvar "var_double" :double) -(defcvar "var_pointer" :pointer) -(defcvar "var_string" :string) - -#-cffi-features:no-long-long -(progn - (defcvar "var_long_long" :long-long) - (defcvar "var_unsigned_long_long" :unsigned-long-long)) +(defcvar ("var_char" *char-var*) :char) +(defcvar "var_unsigned_char" :unsigned-char) +(defcvar "var_short" :short) +(defcvar "var_unsigned_short" :unsigned-short) +(defcvar "var_int" :int) +(defcvar "var_unsigned_int" :unsigned-int) +(defcvar "var_long" :long) +(defcvar "var_unsigned_long" :unsigned-long) +(defcvar "var_float" :float) +(defcvar "var_double" :double) +(defcvar "var_pointer" :pointer) +(defcvar "var_string" :string) +(defcvar "var_long_long" :long-long) +(defcvar "var_unsigned_long_long" :unsigned-long-long) (deftest foreign-globals.ref.char *char-var* @@ -93,17 +90,15 @@ *var-string* "Hello, foreign world!") -#-cffi-features:no-long-long -(progn - #+openmcl (push 'foreign-globals.set.long-long rt::*expected-failures*) +#+openmcl (push 'foreign-globals.set.long-long rt::*expected-failures*) - (deftest foreign-globals.ref.long-long - *var-long-long* - -9223372036854775807) +(deftest foreign-globals.ref.long-long + *var-long-long* + -9223372036854775807) - (deftest foreign-globals.ref.unsigned-long-long - *var-unsigned-long-long* - 18446744073709551615)) +(deftest foreign-globals.ref.unsigned-long-long + *var-unsigned-long-long* + 18446744073709551615) ;; The *.set.* tests restore the old values so that the *.ref.* ;; don't fail when re-run. @@ -129,7 +124,6 @@ (foreign-free (mem-ref (get-var-pointer '*var-string*) :pointer)))) "Ehxosxangxo") -#-cffi-features:no-long-long (deftest foreign-globals.set.long-long (with-old-value-restored (*var-long-long*) (setq *var-long-long* -9223000000000005808) diff --git a/external/cffi.darcs/tests/memory.lisp b/external/cffi.darcs/tests/memory.lisp index 72755d2..dfaff42 100644 --- a/external/cffi.darcs/tests/memory.lisp +++ b/external/cffi.darcs/tests/memory.lisp @@ -75,22 +75,20 @@ (mem-ref p :unsigned-long)) 536870912) -#-cffi-features:no-long-long -(progn - #+(and cffi-features:darwin openmcl) - (pushnew 'deref.long-long rt::*expected-failures*) +#+(and cffi-features:darwin openmcl) +(pushnew 'deref.long-long rt::*expected-failures*) - (deftest deref.long-long - (with-foreign-object (p :long-long) - (setf (mem-ref p :long-long) -9223372036854775807) - (mem-ref p :long-long)) - -9223372036854775807) +(deftest deref.long-long + (with-foreign-object (p :long-long) + (setf (mem-ref p :long-long) -9223372036854775807) + (mem-ref p :long-long)) + -9223372036854775807) - (deftest deref.unsigned-long-long - (with-foreign-object (p :unsigned-long-long) - (setf (mem-ref p :unsigned-long-long) 18446744073709551615) - (mem-ref p :unsigned-long-long)) - 18446744073709551615)) +(deftest deref.unsigned-long-long + (with-foreign-object (p :unsigned-long-long) + (setf (mem-ref p :unsigned-long-long) 18446744073709551615) + (mem-ref p :unsigned-long-long)) + 18446744073709551615) (deftest deref.float.1 (with-foreign-object (p :float) @@ -454,24 +452,22 @@ (mem-ref p type))) 536870912) -#-cffi-features:no-long-long -(progn - #+(and cffi-features:darwin openmcl) - (pushnew 'deref.nonconst.long-long rt::*expected-failures*) - - (deftest deref.nonconst.long-long - (let ((type :long-long)) - (with-foreign-object (p type) - (setf (mem-ref p type) -9223372036854775807) - (mem-ref p type))) - -9223372036854775807) - - (deftest deref.nonconst.unsigned-long-long - (let ((type :unsigned-long-long)) - (with-foreign-object (p type) - (setf (mem-ref p type) 18446744073709551615) - (mem-ref p type))) - 18446744073709551615)) +#+(and cffi-features:darwin openmcl) +(pushnew 'deref.nonconst.long-long rt::*expected-failures*) + +(deftest deref.nonconst.long-long + (let ((type :long-long)) + (with-foreign-object (p type) + (setf (mem-ref p type) -9223372036854775807) + (mem-ref p type))) + -9223372036854775807) + +(deftest deref.nonconst.unsigned-long-long + (let ((type :unsigned-long-long)) + (with-foreign-object (p type) + (setf (mem-ref p type) 18446744073709551615) + (mem-ref p type))) + 18446744073709551615) (deftest deref.nonconst.float.1 (let ((type :float)) diff --git a/external/cffi.darcs/tests/misc-types.lisp b/external/cffi.darcs/tests/misc-types.lisp index b8871ae..b852a6e 100644 --- a/external/cffi.darcs/tests/misc-types.lisp +++ b/external/cffi.darcs/tests/misc-types.lisp @@ -36,6 +36,7 @@ string) "foo") +#-(and) (deftest misc-types.string+ptr.ub8 (destructuring-bind (string pointer) (strdup (make-array 3 :element-type '(unsigned-byte 8) @@ -44,6 +45,7 @@ string) "foo") +#-(and) (deftest misc-types.string.ub8.1 (let ((array (make-array 7 :element-type '(unsigned-byte 8) :initial-contents '(84 117 114 97 110 103 97)))) @@ -51,6 +53,7 @@ (foreign-string-to-lisp foreign-string))) "Turanga") +#-(and) (deftest misc-types.string.ub8.2 (let ((str (foreign-string-alloc (make-array 7 :element-type '(unsigned-byte 8) @@ -126,12 +129,9 @@ "Strdup says: MORE CODE") (deftest misc-types.sized-ints - (mapcar #'foreign-type-size '(:int8 :uint8 :int16 :uint16 :int32 :uint32 - #-cffi-features:no-long-long :int64 - #-cffi-features:no-long-long :uint64)) - (1 1 2 2 4 4 - #-cffi-features:no-long-long 8 - #-cffi-features:no-long-long 8)) + (mapcar #'foreign-type-size + '(:int8 :uint8 :int16 :uint16 :int32 :uint32 :int64 :uint64)) + (1 1 2 2 4 4 8 8)) (define-foreign-type error-error () () diff --git a/external/cffi.darcs/tests/struct.lisp b/external/cffi.darcs/tests/struct.lisp index 1a5a568..e4aedc8 100644 --- a/external/cffi.darcs/tests/struct.lisp +++ b/external/cffi.darcs/tests/struct.lisp @@ -213,30 +213,26 @@ 'another-short another-short))) (a-double 1.0d0 a-short 2 a-char 3 another-short 4)) +(defcstruct s-long-long + (a-long-long :long-long) + (a-short :short)) -#-cffi-features:no-long-long -(progn - (defcstruct s-long-long - (a-long-long :long-long) - (a-short :short)) - - (defcstruct s-s-long-long - (a-char :char) - (a-s-long-long s-long-long) - (another-short :short)) - - (defcvar "the_s_s_long_long" s-s-long-long) +(defcstruct s-s-long-long + (a-char :char) + (a-s-long-long s-long-long) + (another-short :short)) - (deftest struct.alignment.6 - (with-foreign-slots - ((a-char a-s-long-long another-short) *the-s-s-long-long* s-s-long-long) - (with-foreign-slots ((a-long-long a-short) a-s-long-long s-long-long) - (list 'a-long-long a-long-long - 'a-short a-short - 'a-char a-char - 'another-short another-short))) - (a-long-long 1 a-short 2 a-char 3 another-short 4))) +(defcvar "the_s_s_long_long" s-s-long-long) +(deftest struct.alignment.6 + (with-foreign-slots + ((a-char a-s-long-long another-short) *the-s-s-long-long* s-s-long-long) + (with-foreign-slots ((a-long-long a-short) a-s-long-long s-long-long) + (list 'a-long-long a-long-long + 'a-short a-short + 'a-char a-char + 'another-short another-short))) + (a-long-long 1 a-short 2 a-char 3 another-short 4)) (defcstruct s-s-double3 (a-s-double2 s-double2) @@ -298,27 +294,51 @@ ;; regression test, some Lisps were returning 4 instead of 8 for ;; (foreign-type-alignment :unsigned-long-long) on darwin/ppc32 -#-cffi-features:no-long-long -(progn - (defcstruct s-unsigned-long-long - (an-unsigned-long-long :unsigned-long-long) - (a-short :short)) +(defcstruct s-unsigned-long-long + (an-unsigned-long-long :unsigned-long-long) + (a-short :short)) - (defcstruct s-s-unsigned-long-long - (a-char :char) - (a-s-unsigned-long-long s-unsigned-long-long) - (another-short :short)) +(defcstruct s-s-unsigned-long-long + (a-char :char) + (a-s-unsigned-long-long s-unsigned-long-long) + (another-short :short)) - (defcvar "the_s_s_unsigned_long_long" s-s-unsigned-long-long) +(defcvar "the_s_s_unsigned_long_long" s-s-unsigned-long-long) - (deftest struct.alignment.8 - (with-foreign-slots - ((a-char a-s-unsigned-long-long another-short) - *the-s-s-unsigned-long-long* s-s-unsigned-long-long) - (with-foreign-slots ((an-unsigned-long-long a-short) - a-s-unsigned-long-long s-unsigned-long-long) - (list 'an-unsigned-long-long an-unsigned-long-long - 'a-short a-short - 'a-char a-char - 'another-short another-short))) - (an-unsigned-long-long 1 a-short 2 a-char 3 another-short 4))) +(deftest struct.alignment.8 + (with-foreign-slots + ((a-char a-s-unsigned-long-long another-short) + *the-s-s-unsigned-long-long* s-s-unsigned-long-long) + (with-foreign-slots ((an-unsigned-long-long a-short) + a-s-unsigned-long-long s-unsigned-long-long) + (list 'an-unsigned-long-long an-unsigned-long-long + 'a-short a-short + 'a-char a-char + 'another-short another-short))) + (an-unsigned-long-long 1 a-short 2 a-char 3 another-short 4)) + +;;;# C Struct Wrappers + +(define-c-struct-wrapper timeval ()) + +(define-c-struct-wrapper (timeval2 timeval) () + (tv-secs)) + +(defmacro with-example-timeval (var &body body) + `(with-foreign-object (,var 'timeval) + (with-foreign-slots ((tv-secs tv-usecs) ,var timeval) + (setf tv-secs 42 tv-usecs 1984) + ,@body))) + +(deftest struct-wrapper.1 + (with-example-timeval ptr + (let ((obj (make-instance 'timeval :pointer ptr))) + (values (timeval-tv-secs obj) + (timeval-tv-usecs obj)))) + 42 1984) + +(deftest struct-wrapper.2 + (with-example-timeval ptr + (let ((obj (make-instance 'timeval2 :pointer ptr))) + (timeval2-tv-secs obj))) + 42) diff --git a/external/cffi.darcs/uffi-compat/uffi-compat.lisp b/external/cffi.darcs/uffi-compat/uffi-compat.lisp index 5e25f56..3823c8c 100644 --- a/external/cffi.darcs/uffi-compat/uffi-compat.lisp +++ b/external/cffi.darcs/uffi-compat/uffi-compat.lisp @@ -572,12 +572,15 @@ output to *trace-output*. Returns the shell's exit code." ;;; Some undocumented UFFI operators... -(defmacro convert-from-foreign-string (obj &key (length most-positive-fixnum) - (locale :default) +(defmacro convert-from-foreign-string (obj &key length (locale :default) (null-terminated-p t)) - (declare (ignore locale)) + ;; in effect, (eq NULL-TERMINATED-P (null LENGTH)). Hopefully, + ;; that's compatible with the intended semantics, which are + ;; undocumented. If that's not the case, we can implement + ;; NULL-TERMINATED-P in CFFI:FOREIGN-STRING-TO-LISP. + (declare (ignore locale null-terminated-p)) (let ((ret (gensym))) - `(let ((,ret (cffi:foreign-string-to-lisp ,obj ,length ,null-terminated-p))) + `(let ((,ret (cffi:foreign-string-to-lisp ,obj :count ,length))) (if (equal ,ret "") nil ,ret)))) -- 2.11.4.GIT