Macro: with-foreign-ptr (var size &optional size-var) &body body
+Macro: with-foreign-ptr (var size + &optional size-var) &body body
hunk ./doc/cffi-sys-specification.html 191 - Bind var to a pointer to size bytes of foreign-accessible - memory during body. Both ptr and the memory block it - points to have dynamic extent and may be stack allocated if supported - by the implementation. If size-var is supplied, it will be bound - to size during body. + Bind var to a pointer to size bytes of + foreign-accessible memory during body. Both ptr + and the memory block it points to have dynamic extent and may be + stack allocated if supported by the implementation. + If size-var is supplied, it will be bound to size + during body. hunk ./doc/cffi-sys-specification.html 204 - Dereference a pointer offset bytes from ptr to an object - for reading (or writing when used with setf) of built-in type - type. + Dereference a pointer offset bytes from ptr to an + object for reading (or writing when used with setf) of + built-in type type. hunk ./doc/cffi-sys-specification.html 211 -+hunk ./doc/cffi-sys-specification.html 221 -Macro: %foreign-funcall name {arg-type arg}* &optional result-type => object
+Macro: %foreign-funcall name + {arg-type arg}* &optional result-type + => object
hunk ./doc/cffi-sys-specification.html 226 - Invoke a foreign function called name, which may be mangled - depending on the ABI of the system (eg. adding leading underscore for - Darwin). + Invoke a foreign function called name, which may be + mangled depending on the ABI of the system (eg. adding leading + underscore for Darwin). hunk ./doc/cffi-sys-specification.html 232 - The remaining arguments are pairs of foreign types and their values, - followed by the return type of the function, assumed to be :void - if not supplied. + The remaining arguments are pairs of foreign types and their + values, followed by the return type of the function, assumed to + be :void if not supplied. hunk ./doc/cffi-sys-specification.html 238 - - This wording is pretty awkward, rewrite this description. - + + This wording is pretty awkward, rewrite this description. + hunk ./doc/cffi-sys-specification.html 245 -+hunk ./doc/cffi-sys-specification.html 262 - Loads the foreign shared library name. + Loads the foreign shared library name. hunk ./doc/cffi-sys-specification.html 266 - - There is a lot of behavior to decide here. Currently I lean toward - not requiring NAME to be a full path to the library so we can search - the system library directories (maybe even get LD_LIBRARY_PATH from - the environment) as necessary. - + + There is a lot of behavior to decide here. Currently I lean + toward not requiring NAME to be a full path to the library so + we can search the system library directories (maybe even get + LD_LIBRARY_PATH from the environment) as necessary. + hunk ./doc/cffi-sys-specification.html 275 - - 6 June 2005 / James Bielman / jamesjb at jamesjb dot com - + + 6 June 2005 / James Bielman / jamesjb at jamesjb dot com + hunk ./doc/cffi-sys-specification.html 282 - hunk ./doc/manual.html 3 -CFFI User Manual +CFFI User Manual + hunk ./doc/manual.html 14 - + hunk ./doc/manual.html 24 -
Example:
+ ++(defcstruct timeval + (tv-sec :long) + (tv-usec :long)) ++ hunk ./doc/manual.html 150 - Accessor: foreign-slot-value ptr type - &rest slot-names => object + Accessor: foreign-slot-value ptr type + &rest slot-names => object hunk ./doc/manual.html 153 - + hunk ./doc/manual.html 155 - For simple slots, foreign-slot-value returns the value of - the object, such as a Lisp integer or pointer. In C, this would be - expressed as ptr->slot. + For simple slots, foreign-slot-value returns the value + of the object, such as a Lisp integer or pointer. In C, this + would be expressed as ptr->slot. hunk ./doc/manual.html 161 - For aggregate slots, a pointer inside the structure to the beginning - of the slot's data is returned. In C, this would be expressed as - &ptr->slot. This pointer and the memory it points to - have the same extent as ptr. + For aggregate slots, a pointer inside the structure to the + beginning of the slot's data is returned. In C, this would be + expressed as + &ptr->slot. This pointer and the memory it points to + have the same extent as ptr. hunk ./doc/manual.html 167 - + hunk ./doc/manual.html 169 - There are compiler macros for foreign-slot-value and its - setf expansion that open code the memory access when - type and slot-names are constant at compile-time. + There are compiler macros for foreign-slot-value and its + setf expansion that open code the memory access when + type and slot-names are constant at compile-time. hunk ./doc/manual.html 175 - Macro: explain-foreign-slot-value ptr type - &rest slot-names + Macro: explain-foreign-slot-value ptr type + &rest slot-names hunk ./doc/manual.html 178 - + hunk ./doc/manual.html 180 - This macro translates the slot access that would occur by calling - FOREIGN-SLOT-VALUE with the same arguments into an equivalent - expression in C and prints it to *STANDARD-OUTPUT*. + This macro translates the slot access that would occur by calling + FOREIGN-SLOT-VALUE with the same arguments into an + equivalent expression in C and prints it + to *STANDARD-OUTPUT*. hunk ./doc/manual.html 188 -
+hunk ./doc/manual.html 198 - &rest slot-names => ptr + &rest slot-names => ptr hunk ./doc/manual.html 215 --(defcstruct timeval - (tv-sec :long) - (tv-usec :long)) - +hunk ./doc/manual.html 232 + hunk ./doc/manual.html 285 - &optional (count 0) => ptr + &optional (count 1) => ptr hunk ./doc/manual.html 288 ++(let ((ptr (foreign-object-alloc <type> <count>))) + ...) + +==> + +{ + void *ptr = malloc (sizeof (<type>) * <count>); + + if (ptr == NULL) + raise_storage_condition (); + + ... +} ++ hunk ./doc/manual.html 309 ++(foreign-object-free ptr) + +==> + +free (ptr); ++ hunk ./doc/manual.html 318 - Macro: with-foreign-object (var type - &optional (count 1)) &body body + Macro: with-foreign-object (var type + &optional (count 1)) &body body hunk ./doc/manual.html 322 -Foreign Pointers
++(with-foreign-object (ptr <type> <count>) + ...) hunk ./doc/manual.html 326 +==> + +{ + void *ptr = alloca (sizeof (<type>) * <count>); + ... +} ++ +Foreign Pointers
+ hunk ./doc/manual.html 337 - Describe the theory of how foreign variables work---they are always - pointers, even when accessing integer types or embedded structures. - You cannot represent a structure by value. + Describe the theory of how foreign variables work---they are always + pointers, even when accessing integer types or embedded structures. + You cannot represent a structure by value. hunk ./doc/manual.html 362 -+hunk ./examples/examples.lisp 88 - string "%d #x%x!" :int 666 :unsigned-int #xcafebabe + string "%d %f #x%x!" :int 666 + :double (coerce pi 'double-float) + :unsigned-int #xcafebabe hunk ./examples/examples.lisp 103 -;; Proposed syntax for nested structures: -#+nil +;; Nested structure example: hunk ./examples/examples.lisp 105 - (name :pointer) - (timeval :struct timeval)) + (name :char 100) + (timeval timeval)) hunk ./src/cffi-clisp.lisp 43 + #:inc-ptr hunk ./src/cffi-clisp.lisp 105 +(defun inc-ptr (ptr offset) + "Return a pointer pointing OFFSET bytes past PTR." + (ffi:unsigned-foreign-address + (+ offset (ffi:foreign-address-unsigned ptr)))) + hunk ./src/cffi-clisp.lisp 139 - -(defun %inc-ptr (ptr offset) - "Return a new pointer OFFSET bytes past PTR." - (ffi:unsigned-foreign-address - (+ offset (ffi:foreign-address-unsigned ptr)))) hunk ./src/cffi-cmucl.lisp 36 + #:inc-ptr hunk ./src/cffi-cmucl.lisp 44 - #:%mem-ref)) + #:%mem-ref + #:make-shareable-byte-vector + #:with-pointer-to-vector-data)) hunk ./src/cffi-cmucl.lisp 67 +(declaim (inline inc-ptr)) +(defun inc-ptr (ptr offset) + "Return a pointer pointing OFFSET bytes past PTR." + (sys:sap+ ptr offset)) + hunk ./src/cffi-cmucl.lisp 118 + +;;;# Shareable Vectors +;;; +;;; This interface is very experimental. WITH-POINTER-TO-VECTOR-DATA +;;; should be defined to perform a copy-in/copy-out if the Lisp +;;; implementation can't do this. + +(defun make-shareable-byte-vector (size) + "Create a Lisp vector of SIZE bytes that can passed to +WITH-POINTER-TO-VECTOR-DATA." + (make-array size :element-type '(unsigned-byte 8))) + +(defmacro with-pointer-to-vector-data ((ptr-var vector) &body body) + "Bind PTR-VAR to a foreign pointer to the data in VECTOR." + `(sys:without-gcing + (let ((,ptr-var (sys:vector-sap ,vector))) + ,@body))) hunk ./src/cffi-openmcl.lisp 38 + #:inc-ptr hunk ./src/cffi-openmcl.lisp 43 - #:%load-foreign-library)) + #:%load-foreign-library + #:make-shareable-byte-vector + #:with-pointer-to-vector-data)) hunk ./src/cffi-openmcl.lisp 85 + +(defun inc-ptr (ptr offset) + "Return a pointer OFFSET bytes past PTR." + (ccl:%inc-ptr ptr offset)) + +;;;# Shareable Vectors +;;; +;;; This interface is very experimental. WITH-POINTER-TO-VECTOR-DATA +;;; should be defined to perform a copy-in/copy-out if the Lisp +;;; implementation can't do this. + +(defun make-shareable-byte-vector (size) + "Create a Lisp vector of SIZE bytes that can passed to +WITH-POINTER-TO-VECTOR-DATA." + (make-array size :element-type '(unsigned-byte 8))) + +(defmacro with-pointer-to-vector-data ((ptr-var vector) &body body) + "Bind PTR-VAR to a foreign pointer to the data in VECTOR." + `(ccl:with-pointer-to-ivector (,ptr-var ,vector) + ,@body)) hunk ./src/cffi-sbcl.lisp 36 + #:inc-ptr hunk ./src/cffi-sbcl.lisp 44 - #:%mem-ref)) + #:%mem-ref + #:make-shareable-byte-vector + #:with-pointer-to-vector-data)) hunk ./src/cffi-sbcl.lisp 64 +(defun inc-ptr (ptr offset) + "Return a pointer pointing OFFSET bytes past PTR." + (sb-sys:sap+ ptr offset)) hunk ./src/cffi-sbcl.lisp 104 + +;;;# Shareable Vectors +;;; +;;; This interface is very experimental. WITH-POINTER-TO-VECTOR-DATA +;;; should be defined to perform a copy-in/copy-out if the Lisp +;;; implementation can't do this. + +(defun make-shareable-byte-vector (size) + "Create a Lisp vector of SIZE bytes can passed to +WITH-POINTER-TO-VECTOR-DATA." + (make-array size :element-type '(unsigned-byte 8))) + +(defmacro with-pointer-to-vector-data ((ptr-var vector) &body body) + "Bind PTR-VAR to a foreign pointer to the data in VECTOR." + `(sb-sys:without-gcing + (let ((,ptr-var (sb-sys:vector-sap ,vector))) + ,@body))) hunk ./src/early-types.lisp 59 - (gethash name *foreign-types*)) + (or (gethash name *foreign-types*) + (error "Undefined foreign type: ~S" name))) hunk ./src/package.lisp 36 + #:pointerp hunk ./src/package.lisp 39 + #:inc-ptr hunk ./src/package.lisp 42 + ;; Shareable vectors. + #:make-shareable-vector + #:with-pointer-to-vector-data + hunk ./src/package.lisp 64 + #:foreign-enum-keyword + #:foreign-enum-value hunk ./src/types.lisp 30 -;;;# Foreign Type Deferencing +;;;# Dereferencing Foreign Pointers hunk ./src/types.lisp 39 - (progn - #-(and) (format t "~&;; Open-coding MEM-REF form: ~S~%" form) - `(%mem-ref ,ptr ,(canonicalize-foreign-type (eval type)) ,offset)) + `(%mem-ref ,ptr ,(canonicalize-foreign-type (eval type)) ,offset) hunk ./src/types.lisp 67 - (progn - #-(and) (format t "~&;; Open-coding (SETF MEM-REF) form: ~S~%" form) - `(setf (%mem-ref ,ptr ,(canonicalize-foreign-type (eval type)) - ,offset) ,value)) + `(setf (%mem-ref ,ptr ,(canonicalize-foreign-type (eval type)) + ,offset) ,value) hunk ./src/types.lisp 71 +;;;# Dereferencing Foreign Arrays + +;;; TODO: FOREIGN-AREF needs its own SETF expander and a compiler +;;; macro to optimize array references when TYPE is constant. hunk ./src/types.lisp 85 +;;;## Foreign Structure Slots + +(defgeneric foreign-struct-slot-address (ptr slot) + (:documentation "Get the address of SLOT relative to PTR.")) + +(defgeneric foreign-struct-slot-value (ptr slot) + (:documentation "Return the value of SLOT in structure PTR.")) + +(defclass foreign-struct-slot () + ((offset :initarg :offset :accessor slot-offset) + (type :initarg :type :accessor slot-type)) + (:documentation "Base class for simple and aggregate slots.")) + +(defmethod foreign-struct-slot-address (ptr (slot foreign-struct-slot)) + "Return the address of SLOT relative to PTR." + (inc-ptr ptr (slot-offset slot))) + +;;;### Simple Slots + +(defclass simple-struct-slot (foreign-struct-slot) + () + (:documentation "Non-aggregate structure slots.")) + +(defmethod foreign-struct-slot-value (ptr (slot simple-struct-slot)) + "Return the value of a simple SLOT from a struct at PTR." + (mem-ref ptr (slot-type slot) (slot-offset slot))) + +;;;### Aggregate Slots + +(defclass aggregate-struct-slot (foreign-struct-slot) + ((count :initarg count :accessor slot-count)) + (:documentation "Aggregate structure slots.")) + +(defmethod foreign-struct-slot-value (ptr (slot aggregate-struct-slot)) + "Return a pointer to SLOT relative to PTR." + (foreign-struct-slot-address ptr slot)) + +;;;## Defining Foreign Structures + +(defun new-notice-foreign-struct-definition (name slots) + "Parse and install a foreign structure definition." + (let ((struct (make-instance 'foreign-struct-type :name name)) + (offset 0)) + (declare (ignore struct)) + (dolist (slotdef slots) + (destructuring-bind (slotname type &optional (count 1)) slotdef + (declare (ignore slotname)) + (setf offset (adjust-for-alignment type offset)) + ;; If TYPE is an aggregate type or COUNT is non-nil, create an + ;; AGGREGATE-STRUCT-SLOT, otherwise create a SIMPLE-STRUCT + ;; slot. Add the slot to STRUCT's hash of slot objects. + (incf offset (* count (foreign-type-size type))))))) + hunk ./src/types.lisp 140 + (new-notice-foreign-struct-definition name slots) hunk ./src/types.lisp 143 - (loop for (slot type) in slots + (loop for (slot type . nil) in slots hunk ./src/types.lisp 151 +(defmacro defcstruct (name &body fields) + "Define the layout of a foreign structure." + `(eval-when (:compile-toplevel :load-toplevel :execute) + (notice-foreign-struct-definition ',name ',fields))) + +;;;## Accessing Foreign Structure Slots + hunk ./src/types.lisp 180 - (progn - #-(and) (format t "~&;; Open-coding FOREIGN-SLOT-VALUE form: ~S~%" form) - (destructuring-bind (&key offset type) - (get-slot-info (eval type) (eval slot-name)) - `(mem-ref ,ptr ,type ,offset))) + (destructuring-bind (&key offset type) + (get-slot-info (eval type) (eval slot-name)) + `(mem-ref ,ptr ',type ,offset)) hunk ./src/types.lisp 210 - "Optimizer for FOREIGN-SLOT-VALUE when TYPE is constant." + "Optimizer when TYPE and SLOT-NAME are constant." hunk ./src/types.lisp 212 - (progn - #-(and) (format t "~&;; Open-coding (SETF FOREIGN-SLOT-VALUE) form: ~S~%" form) - (destructuring-bind (&key offset type) - (get-slot-info (eval type) (eval slot-name)) - `(setf (mem-ref ,ptr ,type ,offset) ,value))) + (destructuring-bind (&key offset type) + (get-slot-info (eval type) (eval slot-name)) + `(setf (mem-ref ,ptr ,type ,offset) ,value)) hunk ./src/types.lisp 226 - -(defmacro defcstruct (name &body fields) - "Define the layout of a foreign structure." - `(eval-when (:compile-toplevel :load-toplevel :execute) - (notice-foreign-struct-definition ',name ',fields))) hunk ./tests/funcall.lisp 61 - (setf (mem-ref s :char) 0) hunk ./tests/funcall.lisp 71 - (setf (mem-ref s :char) 0) hunk ./tests/funcall.lisp 76 - (setf (mem-ref s :char) 0) hunk ./tests/funcall.lisp 81 - (setf (mem-ref s :char) 0) hunk ./tests/funcall.lisp 89 - (setf (mem-ref s :char) 0) hunk ./tests/funcall.lisp 95 - (setf (mem-ref s :char) 0) hunk ./tests/memory.lisp 32 - (setf (mem-ref p :char) -127) + (setf (mem-ref p :char) 127) hunk ./tests/memory.lisp 34 - -127) - -(deftest deref.unsigned-char - (with-foreign-object (p :unsigned-char) - (setf (mem-ref p :unsigned-char) 255) - (mem-ref p :unsigned-char)) - 255) + 127) hunk ./tests/memory.lisp 38 - (setf (mem-ref p :short) -32767) + (setf (mem-ref p :short) 32767) hunk ./tests/memory.lisp 40 - -32767) - -(deftest deref.unsigned-short - (with-foreign-object (p :unsigned-short) - (setf (mem-ref p :unsigned-short) 65535) - (mem-ref p :unsigned-short)) - 65535) + 32767) hunk ./tests/memory.lisp 44 - (setf (mem-ref p :int) -131072) + (setf (mem-ref p :int) 131072) hunk ./tests/memory.lisp 46 - -131072) - -(deftest deref.unsigned-int - (with-foreign-object (p :unsigned-int) - (setf (mem-ref p :unsigned-int) 262144) - (mem-ref p :unsigned-int)) - 262144) + 131072) hunk ./tests/memory.lisp 50 - (setf (mem-ref p :long) -536870911) + (setf (mem-ref p :long) 536870912) hunk ./tests/memory.lisp 52 - -536870911) - -(deftest deref.unsigned-long - (with-foreign-object (p :unsigned-long) - (setf (mem-ref p :unsigned-long) 536870912) - (mem-ref p :unsigned-long)) hunk ./tests/memory.lisp 53 - -(deftest deref.float.1 - (with-foreign-object (p :float) - (setf (mem-ref p :float) 0.0) - (mem-ref p :float)) - 0.0) - -(deftest deref.float.2 - (with-foreign-object (p :float) - (setf (mem-ref p :float) most-positive-single-float) - (mem-ref p :float)) - #.most-positive-single-float) - -(deftest deref.float.3 - (with-foreign-object (p :float) - (setf (mem-ref p :float) least-positive-single-float) - (mem-ref p :float)) - #.least-positive-single-float) - -(deftest deref.double.1 - (with-foreign-object (p :double) - (setf (mem-ref p :double) 0.0d0) - (mem-ref p :double)) - 0.0d0) - -(deftest deref.double.2 - (with-foreign-object (p :double) - (setf (mem-ref p :double) most-positive-double-float) - (mem-ref p :double)) - #.most-positive-double-float) - -(deftest deref.double.3 - (with-foreign-object (p :double) - (setf (mem-ref p :double) least-positive-double-float) - (mem-ref p :double)) - #.least-positive-double-float) - hunk ./tests/package.lisp 29 - (:use #:cl #:cffi #+lispworks #:regression-test #-lispworks #:rt) + (:use #:cl #:cffi #:rt) hunk ./tests/run-tests.lisp 28 -(format t "~&-------- Running tests in ~A --------~%" - (lisp-implementation-type)) - hunk ./tests/run-tests.lisp 33 +#+clisp +(load "~/Downloads/asdf") +#+clisp +(push "~/.asdf-install-dir/systems/" asdf:*central-registry*) hunk ./tests/struct-tests.lisp 28 -;; TODO: Make a separate CFFI-TESTS package for this later. -(in-package #:cffi) +(asdf:operate 'asdf:load-op 'cffi :verbose nil) + +(defpackage #:cffi-tests + (:use #:cl #:cffi)) +(in-package #:cffi-tests) hunk ./tests/struct-tests.lisp 51 - (with-foreign-struct (a align-test) + (with-foreign-object (a align-test) hunk ./tests/struct-tests.lisp 58 + }