1 ;;; ffi.el --- FFI lisp layer.
3 ;; Copyright (C) 2005-2010 by Zajcev Evgeny
5 ;; Author: Zajcev Evgeny <zevlg@yandex.ru>
6 ;; Created: Fri Feb 18 18:56:43 MSK 2005
9 ;; This file is part of SXEmacs.
11 ;; SXEmacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; SXEmacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
24 ;;; Synched up with: Not in FSF
30 ;; BASIC -> byte unsigned-byte .. c-string
32 ;; ARRAY -> (array TYPE SIZE)
34 ;; STRUCT -> (struct name (slot1 TYPE) (slot2 TYPE) .. (slotn TYPE))
36 ;; UNION -> (union name (slot1 TYPE) (slot2 TYPE) .. (slotn TYPE))
38 ;; FUNCTION -> (function RET-TYPE IN-TYPE .. IN-TYPE)
40 ;; C: int a[10] = {1, 2, .. 10}; LISP: [1 2 .. 10]
42 ;; C: struct { LISP: ((i 1) (c ?c))
49 (globally-declare-boundp
50 '(ffi-type-checker ffi-named-types ffi-loaded-libraries))
51 (globally-declare-fboundp
52 '(ffi-size-of-type make-ffi-object ffi-canonicalise-type
53 ffi-basic-type-p ffi-load-library ffi-dlerror
54 ffi-object-type ffi-fetch ffi-slot-offset
55 ffi-store ffi-aref ffi-make-pointer
56 ffi-object-address ffi-call-function
62 (setq ffi-type-checker #'ffi-type-p)
64 (defun ffi-create-fo (type val)
65 "Create a foreign object of TYPE and set its value to VAL.
66 Return created FFI object."
67 (let* ((ctype (ffi-canonicalise-type type))
68 (size (cond ((or (eq ctype 'c-string) (eq ctype 'c-data))
70 ((and (consp ctype) (eq (car ctype) 'c-data)
74 (ffi-size-of-type ctype))))
75 (fo (make-ffi-object type size)))
79 (defun ffi-find-named-type (type-name)
80 "Search for TYPE-NAME in named FFI types."
81 (cdr (assq type-name ffi-named-types)))
83 (defmacro declare-ffi-type (name)
84 `(put (quote ,name) 'declared-ffi-type t))
86 (defmacro ffi-declared-type-p (name)
87 `(and (symbolp ,name) (get ,name 'declared-ffi-type)))
88 (defsetf ffi-declared-type-p (name) (val)
89 `(and (symbolp ,name) (put ,name 'declared-ffi-type ,val)))
92 (defun ffi-null-pointer ()
93 "Return null-pointer."
96 (defun ffi-null-p (ptr)
97 "Return non-nil if PTR is null pointer."
98 (zerop (ffi-pointer-address ptr)))
101 (defvar ffi-type-to-translators nil)
102 (defvar ffi-type-from-translators nil)
104 (defmacro define-ffi-translator (translators type body)
105 `(pushnew (cons ,type '(progn ,@body)) ,translators :key #'car))
107 (defmacro define-ffi-translator-to-foreign (type &rest body)
108 "Define translator to foreign type for TYPE.
109 BODY should use `value' to reference typed value."
110 `(define-ffi-translator ffi-type-to-translators ',type ,body))
112 (defmacro define-ffi-translator-from-foreign (type &rest body)
113 "Define translator from foreign type for TYPE.
114 BODY should use `value' to reference typed value."
115 `(define-ffi-translator ffi-type-from-translators ',type ,body))
117 (defmacro ffi-translate-foreign (value type translators)
118 `(let ((translator (assq ,type ,translators)))
120 (eval (cdr translator))
123 (defun ffi-translate-to-foreign (value type)
124 (ffi-translate-foreign value type ffi-type-to-translators))
126 (defun ffi-translate-from-foreign (value type)
127 (ffi-translate-foreign value type ffi-type-from-translators))
130 (defun ffi-define-type-internal (name type)
131 (when (and name (ffi-find-named-type name))
132 (warn "Already defined NAME" name))
134 (unless (and name (ffi-find-named-type name))
135 (when (ffi-declared-type-p name)
136 (setf (ffi-declared-type-p name) nil))
138 ;; Try to get name from union or struct
139 (when (and (null name)
141 (memq (car type) '(struct union)))
142 (setq name (cadr type)))
144 (setq ffi-named-types
145 (put-alist name type ffi-named-types))
147 ;; Copy translators, if any
148 (let ((fft (assq type ffi-type-to-translators))
149 (tft (assq type ffi-type-from-translators)))
151 (pushnew (cons name (cdr fft)) ffi-type-to-translators :key #'car))
153 (pushnew (cons name (cdr tft)) ffi-type-from-translators :key #'car)))
157 (defmacro define-ffi-type (name type)
158 "Associate NAME with FFI TYPE.
159 When defining global structures or unions, NAME may be
160 nil, in that case NAME is derived from the name of
162 `(ffi-define-type-internal ',name ',type))
164 (defmacro define-ffi-struct (name &rest slots)
165 "Define a new structure of NAME and SLOTS.
166 SLOTS are in form (NAME TYPE &key :offset)."
168 (define-ffi-type ,name (struct ,name ,@slots)))))
169 (loop for sn in slots
170 do (setq sn (car sn))
171 do (let ((sym (intern (format "%S->%S" name sn))))
172 (setq forms (append forms
174 (ffi-fetch obj (ffi-slot-offset ',name ',sn)
175 (ffi-slot-type ',name ',sn))))))
178 `((defsetf ,sym (obj) (nv)
180 (list 'ffi-slot-offset '',name '',sn)
181 (list 'ffi-slot-type '',name '',sn)
186 (defun ffi-type-p (type &optional signal-p)
187 "Return non-nil if TYPE is a valid FFI type.
188 If optional argument SIGNAL-P is non-nil and TYPE is not an
189 FFI type, additionally signal an error.
191 NOTE: returned non-nil value is actuall canonicalised type."
192 (setq type (ffi-canonicalise-type type))
193 (if (cond ((ffi-basic-type-p type) type)
196 ((or (eq type 'pointer)
198 (eq (car type) 'pointer)
199 (ffi-type-p (cadr type)))) type)
201 ;; Maybe TYPE is declared
202 ((ffi-declared-type-p type) type)
206 (memq (car type) '(struct union)))
209 ; (mapcar #'(lambda (slot-type)
210 ; (ffi-type-p (cadr slot-type)))
214 ((and (consp type) (eq (car type) 'c-data)
215 (or (numberp (cdr type)) (null (cdr type))))
219 ((and (listp type) (eq 'array (car type))
220 (ffi-type-p (cadr type))
221 (integerp (caddr type))
226 ((and (listp type) (eq 'function (car type))
227 (ffi-type-p (cadr type)))
228 (not (memq nil (mapcar 'ffi-type-p (cddr type))))))
229 type ; TYPE is valid FFI type
232 (signal-error 'invalid-argument type))))
235 (defun ffi-load (libname)
236 "Load library LIBNAME.
237 Return a foreign object handle if successful, or indicate an error if
238 the library cannot be loaded.
240 The argument LIBNAME should be the file-name string of a shared
241 object library (usual extension is `.so').
243 The library should reside in one of the directories specified by the
244 $LD_LIBRARY_PATH environment variable or the more global ld.so.cache."
245 (let ((fo (ffi-load-library libname)))
247 (error "Can't load library `%s': %s" libname (ffi-dlerror)))
249 (setq ffi-loaded-libraries
250 (put-alist libname fo ffi-loaded-libraries))
253 (defun* ffi-get (fo &key (type (ffi-object-type fo)) (off 0)
256 Optional key :TYPE may be used to cast FO to the specified
257 type, it defaults to the object's assigned type.
258 Optional key :OFF may be used to specify an offset, it
260 FROM-CALL is magic, do not use it!"
261 (let ((ctype (ffi-canonicalise-type type)))
262 (cond ((ffi-basic-type-p ctype)
263 (ffi-fetch fo off type))
266 (eq (car ctype) 'array))
268 (loop for idx from 0 below (third ctype)
270 fo :type (second ctype)
271 :off (+ off (* idx (ffi-size-of-type
272 (second ctype))))))))
276 (eq (car ctype) 'struct))
277 (loop for sslot in (cddr ctype)
278 collect (list (first sslot)
280 fo :type (second sslot)
281 :off (+ off (ffi-slot-offset
282 ctype (first sslot)))))))
284 ;; Extremely special case for safe-string!
285 ((eq type 'safe-string)
286 (unless (ffi-null-p fo)
287 (ffi-fetch fo off 'c-string)))
289 ((and (not from-call)
290 (or (eq ctype 'pointer)
292 (eq (car ctype) 'pointer)
293 (ffi-type-p (cadr ctype)))))
296 (ffi-fetch fo off type)))
299 ;; Can't get value in proper form,
300 ;; just return FO unmodified
303 (defun ffi-slot-type (type slot)
304 "Return TYPE's SLOT type.
305 TYPE must be of structure or union type."
306 (let ((ctype (ffi-canonicalise-type type)))
307 (unless (memq (car ctype) '(struct union))
308 (error "Not struct or union: %S" type))
309 (or (cadr (find slot (cddr ctype) :key #'car :test #'eq))
310 (error "No such slot: %S" slot))))
312 (defun ffi-slot (fo slot)
313 "Setf-able slot accessor.
314 Return FO's SLOT value. Can be used in conjunction with `setf' to set
316 ;; Note: `ffi-slot-offset' checks for struct or union type.
317 (let ((soff (ffi-slot-offset (ffi-object-type fo) slot)))
318 (ffi-fetch fo soff (ffi-slot-type (ffi-object-type fo) slot))))
320 (defsetf ffi-slot (fo slot) (val)
321 `(let ((soff (ffi-slot-offset (ffi-object-type ,fo) ,slot)))
322 (ffi-store ,fo soff (ffi-slot-type (ffi-object-type ,fo) ,slot) ,val)))
324 (defun ffi-set (fo val)
325 "Set FO's foreign value to VAL."
326 (let* ((type (ffi-object-type fo))
327 (ctype (ffi-canonicalise-type type)))
328 (if (or (ffi-basic-type-p ctype)
330 (ffi-store fo 0 type val)
332 ;; Pointer type, same as for basic
333 (when (or (eq ctype 'pointer)
334 (and (listp ctype) (eq (car ctype) 'pointer)))
335 (ffi-store fo 0 type val))
337 ;; TODO: Compound type
340 ;; Dereferencing a pointer is done with aref (lg told me), however I
341 ;; find it misleading, so ...
342 (defun ffi-deref (fo-pointer)
343 "Return the data FO-POINTER points to.
344 This is the equivalent of the `*' operator in C.
345 Error will be signaled if FO-POINTER is not of pointer type."
346 (ffi-aref fo-pointer 0))
348 (defmacro define-ffi-function (fsym args doc-string ftype ename)
349 "Define ffi function visible from Emacs lisp as FSYM."
350 `(defun ,fsym ,args ,doc-string
351 (ffi-get (ffi-call-function (load-time-value (ffi-defun ,ftype ,ename))
352 ,@(mapcar* #'(lambda (type arg)
353 `(if (ffi-object-p ,arg)
355 (ffi-create-fo ',type ,arg)))
356 (cddadr ftype) args))
359 (put 'define-ffi-function 'lisp-indent-function 'defun)
364 (defmacro ffi-enum (name &optional docstring &rest specs)
365 "Define an enumeration NAME.
366 Optional argument DOCSTRING is a documentation string.
368 SPECS can be an arbitrary number of symbols which will be enumerated in
369 the respective order.
371 Additionally the cells of SPECS may look like
375 to adhere a symbol `foo' to the enumeration with the value of the
376 symbol `bar' \(i.e. `foo' is an alias of `bar'\).
378 Moreover, it is possible to set the counter explicitly:
382 would assign a value of 5 to the symbol `baz' and \(by side-effect\)
383 set the counter to 6 for the next symbol.
385 The defined enumeration will result in a \(defconst'd\) variable `NAME',
386 the value is an alist of the form \(\(symbol . value\) ...\), where
387 `value' is the C-value of `symbol'.
389 Furthermore, two functions \(named `NAME' and `NAME'-value\) will be
390 defined. The first one is a simple lookup function returning the
391 C-value of a passed symbol. The second does basically the same
392 but returns the representing \(elisp\) integer of a symbol.
393 Both functions return nil if the symbol is not in the enumeration."
395 ;; first check if we were passed a docstring
396 (unless (stringp docstring)
397 ;; docstring is missing, the value of docstring already
398 ;; contains the first symbol, hence we pump that one to specs
399 (unless (null docstring)
400 (setq specs (cons docstring specs)))
401 (setq docstring (format "Enumeration `%s'" name)))
403 ;; now build that pig of code
405 ;; define the constant `name'
406 (list 'defconst name nil
408 ;; fill in the values
411 (let ((tmpspecs specs)
415 (while (car tmpspecs)
416 (if (eq (cadr tmpspecs) '=)
417 ;; this is the alias case
418 ;; we append a cons (left-of-= . right-of-=)
419 ;; to the dllist `delayed'
420 ;; if `right-of-=' (i.e. the caddr) is an integer
421 ;; we set the counter `i' to that value on go on
423 (let ((leftof (car tmpspecs))
424 (rightof (caddr tmpspecs)))
427 (setq tmpspecs (nthcdr 3 tmpspecs))
429 (cond ((intp rightof)
432 ;; prepend leftof again
434 (cons leftof tmpspecs)))
436 ;; push the stuff to the delayed list
438 delayed (cons leftof rightof)))))
441 (dllist-append result (cons (car tmpspecs) i))
443 (setq tmpspecs (cdr tmpspecs))))
445 ;; convert `result' to alist
446 ;; this is necessary here, since we need the alist
447 ;; property right now to look up the delayed symbols
448 (setq result (dllist-to-list result))
450 ;; process those delayed thingies
451 ;; these are basically conses (alias . resolved-symbol)
452 ;; we lookup `resolved-symbol' in the alist `result'
453 ;; first and assign (alias . value-of-resolved-symbol)
454 ;; if that fails, we look at the cars of the delayed
455 ;; list if we can find `resolved-symbol' there
456 ;; if so, we re-append the whole cell to the delayed list
457 ;; if not, we try to find a huge horsewhip to treat
458 ;; the user to a little surprise :)
459 (while (dllist-car delayed)
460 (let ((alias (dllist-pop-car delayed)))
461 (let ((val (cdr-safe (assoc (cdr alias) result))))
463 ;; prevent infinite loops when the user
464 ;; is too stupid to give us a valid alias
465 (when (let ((presentp))
468 (and (eq (cdr alias) (car item))
472 (dllist-append delayed alias))
474 (cons (cons (car alias) val)
481 (list 'quote (car rescell))
488 (list 'put 'ffival ''value (cdr rescell))
492 ;; define the lookup function
493 (list 'defun name '(symbol)
494 (format "Lookup the value of SYMBOL in the enumeration `%s'."
500 ;; define the lookup function for the elisp value
501 (list 'defun (intern (format "%s-value" name)) '(symbol)
502 (format (concat "Lookup the elisp value (an integer) of SYMBOL "
503 "in the enumeration `%s'.")
505 (list 'get (list name 'symbol) ''value))))
506 (put 'ffi-enum 'lisp-indent-function 'defun)
508 ;; (ffi-enum example-enum
509 ;; ;;"Enum of control commands."
510 ;; test_thing = symbol_1
513 ;; foobbbbar = test_thing
514 ;; snaabar = foobbbbar
517 ;; (example-enum-value 'guesswhat)
519 (defmacro define-ffi-enum (type-name &rest spec)
520 "Create enumarate type which you can pass to C functions.
522 \(define-ffi-enum MyEnum
527 (define-ffi-type ,type-name int)
529 (fev (mapcar #'(lambda (sv)
535 (cons (car sv) (cadr sv))
540 (put ',type-name 'ffi-enum-values fev))
542 (define-ffi-translator-to-foreign ,type-name
543 (or (cdr (assq value (get ',type-name 'ffi-enum-values)))
545 (define-ffi-translator-from-foreign ,type-name
546 (or (car (find-if #'(lambda (v)
548 (get ',type-name 'ffi-enum-values)))
549 'undefined-enum-value))))
551 (defun ffi-enum-values (enum-type)
552 "Return alist for ENUM-TYPE.
553 Where car is symbol and cdr is the numeric value for it."
554 (get enum-type 'ffi-enum-values))
557 (defmacro define-ffi-callback (sym retype args &rest body)
558 "Create new callback to be called from C.
559 Return foreign object that you can pass as callback to some C
564 \(define-ffi-callback my-nice-cb int
565 \(\(proname c-string\) \(event pointer\)\)
566 \"Print nice message in the minibuffer and return 10000.\"
567 \(message \"nice message\"\)
570 To get foreign object for this callback function use `ffi-callback-fo'
571 and pass the name of the callback."
572 (let ((argnames (mapcar #'first args))
573 (argtypes (mapcar #'second args)))
575 (defun ,sym ,argnames
577 (let ((cfo (ffi-make-callback ',sym ',retype ',argtypes 0)))
578 (put ',sym 'ffi-callback-fo cfo)
581 (put 'define-ffi-callback 'lisp-indent-function 'defun)
583 (defmacro ffi-callback-fo (sym)
584 "Return SYM callback's foreign object."
585 `(get ,sym 'ffi-callback-fo))
589 (define-ffi-type boolean int)
590 (define-ffi-translator-to-foreign boolean
592 (define-ffi-translator-from-foreign boolean
595 (define-ffi-type lisp-object pointer)
596 (define-ffi-translator-to-foreign lisp-object
597 (ffi-lisp-object-to-pointer value))
598 (define-ffi-translator-from-foreign lisp-object
599 (ffi-pointer-to-lisp-object value))
601 ;; NOTE: use only for return values
602 (define-ffi-type safe-string pointer)
604 (define-ffi-type callback pointer)
605 (define-ffi-translator-to-foreign callback
606 (ffi-callback-fo value))
610 (define-ffi-type :byte byte)
611 (define-ffi-type :unsigned-byte unsigned-byte)
612 (define-ffi-type :char char)
613 (define-ffi-type :unsigned-char unsigned-char)
614 (define-ffi-type :uchar unsigned-char)
615 (define-ffi-type :short short)
616 (define-ffi-type :unsigned-short unsigned-short)
617 (define-ffi-type :ushort unsigned-short)
618 (define-ffi-type :int int)
619 (define-ffi-type :unsigned-int unsigned-int)
620 (define-ffi-type :uint unsigned-int)
621 (define-ffi-type :long long)
622 (define-ffi-type :unsigned-long unsigned-long)
623 (define-ffi-type :ulong unsigned-long)
624 (define-ffi-type :float float)
625 (define-ffi-type :double double)
626 (define-ffi-type :void void)
627 (define-ffi-type :pointer pointer)
628 (define-ffi-type :boolean boolean)
629 (define-ffi-type :string c-string)
631 ;;;# Accessing Foreign Globals
633 (defun cffi:lisp-var-name (name &optional fun-p)
634 "Return the Lisp symbol for foreign var NAME."
637 (string (intern (format "%s%s%s" (if fun-p "" "*")
638 (downcase (substitute ?- ?_ name)) (if fun-p "" "*"))))
641 (defun cffi:foreign-var-name (name)
642 "Return the foreign var name of NAME."
646 (symbol (let ((dname (downcase (symbol-name name))))
647 (replace-in-string (substitute ?_ ?- dname) "\\*" "")))))
649 (defun cffi:get-var-pointer (symbol)
650 "Return a pointer to the foreign global variable relative to SYMBOL."
651 (cffi:foreign-symbol-pointer (get symbol 'foreign-var-name)))
653 (defmacro cffi:defcstruct (name &rest args)
654 `(define-ffi-struct ,name ,@args))
656 (defmacro cffi:defcvar (name type)
657 (let ((ns (cffi:lisp-var-name name)))
658 `(defvar ,ns (ffi-bind ,type (cffi:foreign-var-name ',name)))))
660 (defmacro cffi:defcfun (name ret-type &optional docstring &rest in-args)
661 ;; First check if we were passed a docstring
662 (unless (stringp docstring)
663 ;; docstring is missing, the value of docstring already contains
664 ;; the first argument, hence we pump that one to in-args
665 (unless (null docstring)
666 (setq in-args (cons docstring in-args)))
668 (format "Lisp variant for `%s' foreign function."
669 (cffi:foreign-var-name name))))
671 (let* ((nsl (cffi:lisp-var-name name t))
672 (nsf (cffi:foreign-var-name name))
673 (with-rest (when (eq (car (last in-args)) '&rest)
674 (setq in-args (butlast in-args))
676 (as (mapcar 'first in-args))
677 (at (mapcar 'second in-args))
678 (flet-form) (defun-form nil))
680 (append (list `(mapcar* #'setarg ',at (list ,@as)))
682 (list '(while rest-args
683 (if (ffi-object-p (car rest-args))
685 (setarg (ffi-object-type (car rest-args))
687 (setq rest-args (cdr rest-args)))
688 (setarg (car rest-args) (cadr rest-args))
689 (setq rest-args (cddr rest-args))))))
690 (list '(setq ffiargs (nreverse ffiargs)))
691 (list `(setq ret (apply #'ffi-call-function
692 (get ',nsl 'ffi-fun) ffiargs)))
693 (list `(ffi-get ret :from-call t))))
695 (append `(defun ,nsl)
697 (append as '(&rest rest-args))
703 '(flet ((setarg (type arg)
706 (if (ffi-object-p arg)
708 (ffi-create-fo type arg))
712 (append '(progn) (list defun-form)
713 (list `(put ',nsl 'ffi-fun
714 (ffi-defun '(function ,ret-type ,@at) ,nsf))))))
716 (put 'cffi:defcfun 'lisp-indent-function 'defun)
718 (defun ffi:canonicalize-symbol-name-case (name)
723 (defun cffi:foreign-alloc (type)
726 (ffi-defun '(function pointer unsigned-int) "malloc")
727 (ffi-create-fo 'unsigned-int (ffi-size-of-type type))))
729 (defun cffi:foreign-free (ptr)
730 "Frees a PTR previously allocated with `cffi:foreign-alloc'."
732 (ffi-defun '(function void pointer) "free")
735 (defmacro cffi:with-foreign-pointer (spec &rest body)
736 "Bind VAR to SIZE bytes of foreign memory during BODY. The
737 pointer in VAR is invalid beyond the dynamic extent of BODY, and
738 may be stack-allocated if supported by the implementation. If
739 SIZE-VAR is supplied, it will be bound to SIZE during BODY."
740 (let ((var (car spec))
742 (size-var (caddr spec)))
744 (setf size-var (gensym "SIZE")))
745 `(let* ((,size-var ,size)
746 (,var (cffi:foreign-alloc ,size-var)))
749 (cffi:foreign-free ,var)))))
751 ;;;# Misc. Pointer Operations
753 (defun ffi-pointer-p (fo)
754 "Return non-nil if ffi objct FO has pointer type."
755 (let ((ctype (ffi-canonicalise-type (ffi-object-type fo))))
756 (or (eq ctype 'pointer)
758 (eq (car ctype) 'pointer)
759 (ffi-type-p (cadr ctype))))))
761 (defalias 'cffi:make-pointer 'ffi-make-pointer)
762 (defalias 'ffi-pointer-address 'ffi-object-address)
763 (defalias 'cffi:pointer-address 'ffi-pointer-address)
764 (defalias 'cffi:pointerp 'ffi-pointer-p)
765 (defalias 'cffi:null-pointer 'ffi-null-pointer)
766 (defalias 'cffi:null-pointer-p 'ffi-null-p)
768 (defun cffi:inc-pointer (ptr offset)
769 "Return a pointer OFFSET bytes past PTR."
770 (ffi-make-pointer (+ (ffi-object-address ptr) offset)))
772 (defun cffi:pointer-eq (ptr1 ptr2)
773 "Return true if PTR1 and PTR2 point to the same address."
774 (= (ffi-object-address ptr1) (ffi-object-address ptr2)))
778 (defun* cffi:mem-ref (ptr type &optional (offset 0))
779 "Dereference an object of TYPE at OFFSET bytes from PTR."
780 (ffi-fetch ptr offset type))
782 ; (defun cffi:%mem-set (value ptr type &optional (offset 0))
783 ; "Set an object of TYPE at OFFSET bytes from PTR."
784 ; (let* ((type (convert-foreign-type type))
785 ; (type-size (ffi:size-of-foreign-type type)))
786 ; (si:foreign-data-set-elt
787 ; (si:foreign-data-recast ptr (+ offset type-size) :void)
788 ; offset type value)))
792 (defalias 'cffi:foreign-type-size 'ffi-size-of-type)
793 (defalias 'cffi:foreign-type-alignment 'ffi-type-alignment)
795 (defalias 'cffi:load-foreign-library 'ffi-load)
798 (defmacro cffi:%defcallback (name rettype arg-names arg-types &rest body)
799 `(define-ffi-callback ,name ,rettype ,(mapcar* #'list arg-names arg-types)
802 (put 'cffi:%defcallback 'lisp-indent-function 'defun)
804 (defmacro cffi:%callback (name)
805 `(ffi-callback-fo ,name))
809 (defun cffi:foreign-symbol-pointer (name)
810 "Returns a pointer to a foreign symbol NAME."
811 (ffi-bind 'pointer name))
815 (defun cffi:finalize (object function)
816 (error "SXEmacs FFI does not support finalizers."))
818 (defun cffi:cancel-finalization (object)
819 (error "SXEmacs FFI does not support finalizers."))