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."
351 (declare (special ,fsym))
352 (setq ,fsym (ffi-defun ,ftype ,ename))
357 (mapcar* #'(lambda (type arg)
359 (if (ffi-object-p arg)
361 (ffi-create-fo type arg))
363 (cddr ,ftype) (list ,@args))
364 (setq ffiargs (nreverse ffiargs))
365 (setq ret (apply #'ffi-call-function ,fsym ffiargs))
366 (ffi-get ret :from-call t)))))
368 (put 'define-ffi-function 'lisp-indent-function 'defun)
373 (defmacro ffi-enum (name &optional docstring &rest specs)
374 "Define an enumeration NAME.
375 Optional argument DOCSTRING is a documentation string.
377 SPECS can be an arbitrary number of symbols which will be enumerated in
378 the respective order.
380 Additionally the cells of SPECS may look like
384 to adhere a symbol `foo' to the enumeration with the value of the
385 symbol `bar' \(i.e. `foo' is an alias of `bar'\).
387 Moreover, it is possible to set the counter explicitly:
391 would assign a value of 5 to the symbol `baz' and \(by side-effect\)
392 set the counter to 6 for the next symbol.
394 The defined enumeration will result in a \(defconst'd\) variable `NAME',
395 the value is an alist of the form \(\(symbol . value\) ...\), where
396 `value' is the C-value of `symbol'.
398 Furthermore, two functions \(named `NAME' and `NAME'-value\) will be
399 defined. The first one is a simple lookup function returning the
400 C-value of a passed symbol. The second does basically the same
401 but returns the representing \(elisp\) integer of a symbol.
402 Both functions return nil if the symbol is not in the enumeration."
404 ;; first check if we were passed a docstring
405 (unless (stringp docstring)
406 ;; docstring is missing, the value of docstring already
407 ;; contains the first symbol, hence we pump that one to specs
408 (unless (null docstring)
409 (setq specs (cons docstring specs)))
410 (setq docstring (format "Enumeration `%s'" name)))
412 ;; now build that pig of code
414 ;; define the constant `name'
415 (list 'defconst name nil
417 ;; fill in the values
420 (let ((tmpspecs specs)
424 (while (car tmpspecs)
425 (if (eq (cadr tmpspecs) '=)
426 ;; this is the alias case
427 ;; we append a cons (left-of-= . right-of-=)
428 ;; to the dllist `delayed'
429 ;; if `right-of-=' (i.e. the caddr) is an integer
430 ;; we set the counter `i' to that value on go on
432 (let ((leftof (car tmpspecs))
433 (rightof (caddr tmpspecs)))
436 (setq tmpspecs (nthcdr 3 tmpspecs))
438 (cond ((intp rightof)
441 ;; prepend leftof again
443 (cons leftof tmpspecs)))
445 ;; push the stuff to the delayed list
447 delayed (cons leftof rightof)))))
450 (dllist-append result (cons (car tmpspecs) i))
452 (setq tmpspecs (cdr tmpspecs))))
454 ;; convert `result' to alist
455 ;; this is necessary here, since we need the alist
456 ;; property right now to look up the delayed symbols
457 (setq result (dllist-to-list result))
459 ;; process those delayed thingies
460 ;; these are basically conses (alias . resolved-symbol)
461 ;; we lookup `resolved-symbol' in the alist `result'
462 ;; first and assign (alias . value-of-resolved-symbol)
463 ;; if that fails, we look at the cars of the delayed
464 ;; list if we can find `resolved-symbol' there
465 ;; if so, we re-append the whole cell to the delayed list
466 ;; if not, we try to find a huge horsewhip to treat
467 ;; the user to a little surprise :)
468 (while (dllist-car delayed)
469 (let ((alias (dllist-pop-car delayed)))
470 (let ((val (cdr-safe (assoc (cdr alias) result))))
472 ;; prevent infinite loops when the user
473 ;; is too stupid to give us a valid alias
474 (when (let ((presentp))
477 (and (eq (cdr alias) (car item))
481 (dllist-append delayed alias))
483 (cons (cons (car alias) val)
490 (list 'quote (car rescell))
497 (list 'put 'ffival ''value (cdr rescell))
501 ;; define the lookup function
502 (list 'defun name '(symbol)
503 (format "Lookup the value of SYMBOL in the enumeration `%s'."
509 ;; define the lookup function for the elisp value
510 (list 'defun (intern (format "%s-value" name)) '(symbol)
511 (format (concat "Lookup the elisp value (an integer) of SYMBOL "
512 "in the enumeration `%s'.")
514 (list 'get (list name 'symbol) ''value))))
515 (put 'ffi-enum 'lisp-indent-function 'defun)
517 ;; (ffi-enum example-enum
518 ;; ;;"Enum of control commands."
519 ;; test_thing = symbol_1
522 ;; foobbbbar = test_thing
523 ;; snaabar = foobbbbar
526 ;; (example-enum-value 'guesswhat)
528 (defmacro define-ffi-enum (type-name &rest spec)
529 "Create enumarate type which you can pass to C functions.
531 \(define-ffi-enum MyEnum
536 (define-ffi-type ,type-name int)
538 (fev (mapcar #'(lambda (sv)
544 (cons (car sv) (cadr sv))
549 (put ',type-name 'ffi-enum-values fev))
551 (define-ffi-translator-to-foreign ,type-name
552 (or (cdr (assq value (get ',type-name 'ffi-enum-values)))
554 (define-ffi-translator-from-foreign ,type-name
555 (or (car (find-if #'(lambda (v)
557 (get ',type-name 'ffi-enum-values)))
558 'undefined-enum-value))))
560 (defun ffi-enum-values (enum-type)
561 "Return alist for ENUM-TYPE.
562 Where car is symbol and cdr is the numeric value for it."
563 (get enum-type 'ffi-enum-values))
566 (defmacro define-ffi-callback (sym retype args &rest body)
567 "Create new callback to be called from C.
568 Return foreign object that you can pass as callback to some C
573 \(define-ffi-callback my-nice-cb int
574 \(\(proname c-string\) \(event pointer\)\)
575 \"Print nice message in the minibuffer and return 10000.\"
576 \(message \"nice message\"\)
579 To get foreign object for this callback function use `ffi-callback-fo'
580 and pass the name of the callback."
581 (let ((argnames (mapcar #'first args))
582 (argtypes (mapcar #'second args)))
584 (defun ,sym ,argnames
586 (let ((cfo (ffi-make-callback ',sym ',retype ',argtypes 0)))
587 (put ',sym 'ffi-callback-fo cfo)
590 (put 'define-ffi-callback 'lisp-indent-function 'defun)
592 (defmacro ffi-callback-fo (sym)
593 "Return SYM callback's foreign object."
594 `(get ,sym 'ffi-callback-fo))
598 (define-ffi-type boolean int)
599 (define-ffi-translator-to-foreign boolean
601 (define-ffi-translator-from-foreign boolean
604 (define-ffi-type lisp-object pointer)
605 (define-ffi-translator-to-foreign lisp-object
606 (ffi-lisp-object-to-pointer value))
607 (define-ffi-translator-from-foreign lisp-object
608 (ffi-pointer-to-lisp-object value))
610 ;; NOTE: use only for return values
611 (define-ffi-type safe-string pointer)
613 (define-ffi-type callback pointer)
614 (define-ffi-translator-to-foreign callback
615 (ffi-callback-fo value))
619 (define-ffi-type :byte byte)
620 (define-ffi-type :unsigned-byte unsigned-byte)
621 (define-ffi-type :char char)
622 (define-ffi-type :unsigned-char unsigned-char)
623 (define-ffi-type :uchar unsigned-char)
624 (define-ffi-type :short short)
625 (define-ffi-type :unsigned-short unsigned-short)
626 (define-ffi-type :ushort unsigned-short)
627 (define-ffi-type :int int)
628 (define-ffi-type :unsigned-int unsigned-int)
629 (define-ffi-type :uint unsigned-int)
630 (define-ffi-type :long long)
631 (define-ffi-type :unsigned-long unsigned-long)
632 (define-ffi-type :ulong unsigned-long)
633 (define-ffi-type :float float)
634 (define-ffi-type :double double)
635 (define-ffi-type :void void)
636 (define-ffi-type :pointer pointer)
637 (define-ffi-type :boolean boolean)
638 (define-ffi-type :string c-string)
640 ;;;# Accessing Foreign Globals
642 (defun cffi:lisp-var-name (name &optional fun-p)
643 "Return the Lisp symbol for foreign var NAME."
646 (string (intern (format "%s%s%s" (if fun-p "" "*")
647 (downcase (substitute ?- ?_ name)) (if fun-p "" "*"))))
650 (defun cffi:foreign-var-name (name)
651 "Return the foreign var name of NAME."
655 (symbol (let ((dname (downcase (symbol-name name))))
656 (replace-in-string (substitute ?_ ?- dname) "\\*" "")))))
658 (defun cffi:get-var-pointer (symbol)
659 "Return a pointer to the foreign global variable relative to SYMBOL."
660 (cffi:foreign-symbol-pointer (get symbol 'foreign-var-name)))
662 (defmacro cffi:defcstruct (name &rest args)
663 `(define-ffi-struct ,name ,@args))
665 (defmacro cffi:defcvar (name type)
666 (let ((ns (cffi:lisp-var-name name)))
667 `(defvar ,ns (ffi-bind ,type (cffi:foreign-var-name ',name)))))
669 (defmacro cffi:defcfun (name ret-type &optional docstring &rest in-args)
670 ;; First check if we were passed a docstring
671 (unless (stringp docstring)
672 ;; docstring is missing, the value of docstring already contains
673 ;; the first argument, hence we pump that one to in-args
674 (unless (null docstring)
675 (setq in-args (cons docstring in-args)))
677 (format "Lisp variant for `%s' foreign function."
678 (cffi:foreign-var-name name))))
680 (let* ((nsl (cffi:lisp-var-name name t))
681 (nsf (cffi:foreign-var-name name))
682 (with-rest (when (eq (car (last in-args)) '&rest)
683 (setq in-args (butlast in-args))
685 (as (mapcar 'first in-args))
686 (at (mapcar 'second in-args))
687 (flet-form) (defun-form nil))
689 (append (list `(mapcar* #'setarg ',at (list ,@as)))
691 (list '(while rest-args
692 (if (ffi-object-p (car rest-args))
694 (setarg (ffi-object-type (car rest-args))
696 (setq rest-args (cdr rest-args)))
697 (setarg (car rest-args) (cadr rest-args))
698 (setq rest-args (cddr rest-args))))))
699 (list '(setq ffiargs (nreverse ffiargs)))
700 (list `(setq ret (apply #'ffi-call-function
701 (get ',nsl 'ffi-fun) ffiargs)))
702 (list `(ffi-get ret :from-call t))))
704 (append `(defun ,nsl)
706 (append as '(&rest rest-args))
712 '(flet ((setarg (type arg)
715 (if (ffi-object-p arg)
717 (ffi-create-fo type arg))
721 (append '(progn) (list defun-form)
722 (list `(put ',nsl 'ffi-fun
723 (ffi-defun '(function ,ret-type ,@at) ,nsf))))))
725 (put 'cffi:defcfun 'lisp-indent-function 'defun)
727 (defun ffi:canonicalize-symbol-name-case (name)
732 (defun cffi:foreign-alloc (type)
735 (ffi-defun '(function pointer unsigned-int) "malloc")
736 (ffi-create-fo 'unsigned-int (ffi-size-of-type type))))
738 (defun cffi:foreign-free (ptr)
739 "Frees a PTR previously allocated with `cffi:foreign-alloc'."
741 (ffi-defun '(function void pointer) "free")
744 (defmacro cffi:with-foreign-pointer (spec &rest body)
745 "Bind VAR to SIZE bytes of foreign memory during BODY. The
746 pointer in VAR is invalid beyond the dynamic extent of BODY, and
747 may be stack-allocated if supported by the implementation. If
748 SIZE-VAR is supplied, it will be bound to SIZE during BODY."
749 (let ((var (car spec))
751 (size-var (caddr spec)))
753 (setf size-var (gensym "SIZE")))
754 `(let* ((,size-var ,size)
755 (,var (cffi:foreign-alloc ,size-var)))
758 (cffi:foreign-free ,var)))))
760 ;;;# Misc. Pointer Operations
762 (defun ffi-pointer-p (fo)
763 "Return non-nil if ffi objct FO has pointer type."
764 (let ((ctype (ffi-canonicalise-type (ffi-object-type fo))))
765 (or (eq ctype 'pointer)
767 (eq (car ctype) 'pointer)
768 (ffi-type-p (cadr ctype))))))
770 (defalias 'cffi:make-pointer 'ffi-make-pointer)
771 (defalias 'ffi-pointer-address 'ffi-object-address)
772 (defalias 'cffi:pointer-address 'ffi-pointer-address)
773 (defalias 'cffi:pointerp 'ffi-pointer-p)
774 (defalias 'cffi:null-pointer 'ffi-null-pointer)
775 (defalias 'cffi:null-pointer-p 'ffi-null-p)
777 (defun cffi:inc-pointer (ptr offset)
778 "Return a pointer OFFSET bytes past PTR."
779 (ffi-make-pointer (+ (ffi-object-address ptr) offset)))
781 (defun cffi:pointer-eq (ptr1 ptr2)
782 "Return true if PTR1 and PTR2 point to the same address."
783 (= (ffi-object-address ptr1) (ffi-object-address ptr2)))
787 (defun* cffi:mem-ref (ptr type &optional (offset 0))
788 "Dereference an object of TYPE at OFFSET bytes from PTR."
789 (ffi-fetch ptr offset type))
791 ; (defun cffi:%mem-set (value ptr type &optional (offset 0))
792 ; "Set an object of TYPE at OFFSET bytes from PTR."
793 ; (let* ((type (convert-foreign-type type))
794 ; (type-size (ffi:size-of-foreign-type type)))
795 ; (si:foreign-data-set-elt
796 ; (si:foreign-data-recast ptr (+ offset type-size) :void)
797 ; offset type value)))
801 (defalias 'cffi:foreign-type-size 'ffi-size-of-type)
802 (defalias 'cffi:foreign-type-alignment 'ffi-type-alignment)
804 (defalias 'cffi:load-foreign-library 'ffi-load)
807 (defmacro cffi:%defcallback (name rettype arg-names arg-types &rest body)
808 `(define-ffi-callback ,name ,rettype ,(mapcar* #'list arg-names arg-types)
811 (put 'cffi:%defcallback 'lisp-indent-function 'defun)
813 (defmacro cffi:%callback (name)
814 `(ffi-callback-fo ,name))
818 (defun cffi:foreign-symbol-pointer (name)
819 "Returns a pointer to a foreign symbol NAME."
820 (ffi-bind 'pointer name))
824 (defun cffi:finalize (object function)
825 (error "SXEmacs FFI does not support finalizers."))
827 (defun cffi:cancel-finalization (object)
828 (error "SXEmacs FFI does not support finalizers."))