1 ;; Common Lisp bindings for GTK+ v2.0
2 ;; Copyright (C) 1999-2001 Espen S. Johnsen <esj@stud.cs.uit.no>
4 ;; This library is free software; you can redistribute it and/or
5 ;; modify it under the terms of the GNU Lesser General Public
6 ;; License as published by the Free Software Foundation; either
7 ;; version 2 of the License, or (at your option) any later version.
9 ;; This library is distributed in the hope that it will be useful,
10 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 ;; Lesser General Public License for more details.
14 ;; You should have received a copy of the GNU Lesser General Public
15 ;; License along with this library; if not, write to the Free Software
16 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
18 ;; $Id: ffi.lisp,v 1.12 2005/01/03 16:35:05 espen Exp $
23 ;;;; Foreign function call interface
25 (defvar *package-prefix* nil)
27 (defun set-package-prefix (prefix &optional (package *package*))
28 (let ((package (find-package package)))
29 (delete-if #'(lambda (assoc) (eq (car assoc) package)) *package-prefix*)
30 (push (cons package prefix) *package-prefix*))
33 (defun package-prefix (&optional (package *package*))
34 (let ((package (find-package package)))
36 (cdr (assoc package *package-prefix*))
37 (substitute #\_ #\- (string-downcase (package-name package))))))
39 (defun find-prefix-package (prefix)
41 (car (rassoc (string-downcase prefix) *package-prefix* :test #'string=))
42 (find-package (string-upcase prefix))))
44 (defmacro use-prefix (prefix &optional (package *package*))
45 `(eval-when (:compile-toplevel :load-toplevel :execute)
46 (set-package-prefix ,prefix ,package)))
49 (defun default-alien-fname (lisp-name)
50 (let* ((name (substitute #\_ #\- (string-downcase lisp-name)))
54 (char= (char name 0) #\%)
55 (string= "_p" name :start2 (- (length name) 2)))
56 (subseq name 1 (- (length name) 2)))
57 ((char= (char name 0) #\%)
59 ((string= "_p" name :start2 (- (length name) 2))
60 (subseq name 0 (- (length name) 2)))
62 (prefix (package-prefix *package*)))
63 (if (or (not prefix) (string= prefix ""))
65 (format nil "~A_~A" prefix stripped-name))))
67 (defun default-alien-type-name (type-name)
68 (let ((prefix (package-prefix *package*)))
74 (cons prefix (split-string (symbol-name type-name) #\-))))))
76 (defun default-type-name (alien-name)
80 (split-string-if alien-name #'upper-case-p))))
83 (rest parts) #\-) (find-prefix-package (first parts)))))
86 (defmacro defbinding (name lambda-list return-type &rest docs/args)
87 (multiple-value-bind (lisp-name c-name)
89 (values name (default-alien-fname name))
92 (let ((supplied-lambda-list lambda-list)
95 (dolist (doc/arg docs/args)
99 (destructuring-bind (expr type &optional (style :in)) doc/arg
100 (unless (member style '(:in :out :in-out :return))
101 (error "Bogus argument style ~S in ~S." style doc/arg))
103 (not supplied-lambda-list)
104 (namep expr) (member style '(:in :in-out :return)))
105 (push expr lambda-list))
107 ((and (namep expr) (eq style :out)) expr)
108 ((namep expr) (make-symbol (string expr)))
110 expr (mklist type) style) args)))))
113 c-name lisp-name (or supplied-lambda-list (nreverse lambda-list))
114 return-type (reverse docs) (reverse args)))))
117 (defun %defbinding (foreign-name lisp-name lambda-list return-type docs args)
118 (ext:collect ((alien-types) (alien-bindings) (alien-parameters)
119 (return-values) (cleanup-forms))
121 (destructuring-bind (var expr type style) arg
122 (let ((declaration (alien-type type))
123 (cleanup (cleanup-form var type)))
126 ((member style '(:out :in-out))
127 (alien-types `(* ,declaration))
128 (alien-parameters `(addr ,var))
131 ,@(when (eq style :in-out)
132 (list (to-alien-form expr type)))))
133 (return-values (from-alien-form var type)))
135 (alien-types declaration)
137 `(,var ,declaration ,(to-alien-form expr type)))
138 (alien-parameters var)
139 (return-values (from-alien-form var type)))
141 (alien-types declaration)
143 `(,var ,declaration ,(to-alien-form expr type)))
144 (alien-parameters var)
145 (cleanup-forms cleanup))
147 (alien-types declaration)
148 (alien-parameters (to-alien-form expr type)))))))
150 (let* ((alien-name (make-symbol (string lisp-name)))
151 (alien-funcall `(alien-funcall ,alien-name ,@(alien-parameters))))
152 `(defun ,lisp-name ,lambda-list
154 (declare (optimize (ext:inhibit-warnings 3)))
155 (with-alien ((,alien-name
157 ,(alien-type return-type)
159 :extern ,foreign-name)
164 ,(from-alien-form alien-funcall return-type)
171 (values ,@(return-values)))))))))
174 ;;; Creates bindings at runtime
175 (defun mkbinding (name return-type &rest arg-types)
176 (declare (optimize (ext:inhibit-warnings 3)))
178 `(function ,@(mapcar #'alien-type (cons return-type arg-types))))
181 (alien::make-heap-alien-info
182 :type (alien::parse-alien-type ftype)
183 :sap-form (system:foreign-symbol-address name :flavor :code))))
184 (translate-arguments (mapcar #'to-alien-function arg-types))
185 (translate-return-value (from-alien-function return-type))
186 (cleanup-arguments (mapcar #'cleanup-function arg-types)))
188 #'(lambda (&rest args)
189 (map-into args #'funcall translate-arguments args)
191 (funcall translate-return-value
192 (apply #'alien:alien-funcall alien args))
193 (mapc #'funcall cleanup-arguments args)))))
196 (defmacro defcallback (name (return-type &rest args) &body body)
198 (,(alien-type return-type)
199 ,@(mapcar #'(lambda (arg)
200 (destructuring-bind (name type) arg
201 `(,name ,(alien-type type))))
204 `(let (,@(mapcar #'(lambda (arg)
205 (destructuring-bind (name type) arg
206 `(,name ,(from-alien-form name type))))
213 ;;;; Definitons and translations of fundamental types
215 (defmacro def-type-method (name args &optional documentation)
217 (defgeneric ,name (,@args type &rest args)
218 ,@(when documentation `((:documentation ,documentation))))
219 (defmethod ,name (,@args (type symbol) &rest args)
220 (let ((class (find-class type nil)))
222 (apply #',name ,@args class args)
223 (multiple-value-bind (super-type expanded-p)
224 (type-expand-1 (cons type args))
226 (,name ,@args super-type)
227 (call-next-method))))))
228 (defmethod ,name (,@args (type cons) &rest args)
229 (declare (ignore args))
230 (apply #',name ,@args (first type) (rest type)))))
233 (def-type-method alien-type ())
234 (def-type-method size-of ())
235 (def-type-method to-alien-form (form))
236 (def-type-method from-alien-form (form))
237 (def-type-method cleanup-form (form)
238 "Creates a form to clean up after the alien call has finished.")
240 (def-type-method to-alien-function ())
241 (def-type-method from-alien-function ())
242 (def-type-method cleanup-function ())
244 (def-type-method copy-to-alien-form (form))
245 (def-type-method copy-to-alien-function ())
246 (def-type-method copy-from-alien-form (form))
247 (def-type-method copy-from-alien-function ())
249 (def-type-method writer-function ())
250 (def-type-method reader-function ())
251 (def-type-method destroy-function ())
253 (def-type-method unbound-value ()
254 "First return value is true if the type has an unbound value, second return value is the actual unbound value")
257 ;; Sizes of fundamental C types in bytes (8 bits)
258 (defconstant +size-of-short+ 2)
259 (defconstant +size-of-int+ 4)
260 (defconstant +size-of-long+ 4)
261 (defconstant +size-of-pointer+ 4)
262 (defconstant +size-of-float+ 4)
263 (defconstant +size-of-double+ 8)
265 ;; Sizes of fundamental C types in bits
266 (defconstant +bits-of-byte+ 8)
267 (defconstant +bits-of-short+ 16)
268 (defconstant +bits-of-int+ 32)
269 (defconstant +bits-of-long+ 32)
272 (deftype int () '(signed-byte #.+bits-of-int+))
273 (deftype unsigned-int () '(unsigned-byte #.+bits-of-int+))
274 (deftype long () '(signed-byte #.+bits-of-long+))
275 (deftype unsigned-long () '(unsigned-byte #.+bits-of-long+))
276 (deftype short () '(signed-byte #.+bits-of-short+))
277 (deftype unsigned-short () '(unsigned-byte #.+bits-of-short+))
278 (deftype signed (&optional (size '*)) `(signed-byte ,size))
279 (deftype unsigned (&optional (size '*)) `(unsigned-byte ,size))
280 (deftype char () 'base-char)
281 (deftype pointer () 'system-area-pointer)
282 (deftype boolean (&optional (size '*)) (declare (ignore size)) `(member t nil))
283 ;(deftype invalid () nil)
286 (defmethod to-alien-form (form (type t) &rest args)
287 (declare (ignore type args))
290 (defmethod to-alien-function ((type t) &rest args)
291 (declare (ignore type args))
294 (defmethod from-alien-form (form (type t) &rest args)
295 (declare (ignore type args))
298 (defmethod from-alien-function ((type t) &rest args)
299 (declare (ignore type args))
302 (defmethod cleanup-form (form (type t) &rest args)
303 (declare (ignore form type args))
306 (defmethod cleanup-function ((type t) &rest args)
307 (declare (ignore type args))
310 (defmethod destroy-function ((type t) &rest args)
311 (declare (ignore type args))
312 #'(lambda (location &optional offset)
313 (declare (ignore location offset))))
315 (defmethod copy-to-alien-form (form (type t) &rest args)
316 (apply #'to-alien-form form type args))
318 (defmethod copy-to-alien-function ((type t) &rest args)
319 (apply #'to-alien-function type args))
321 (defmethod copy-from-alien-form (form (type t) &rest args)
322 (apply #'from-alien-form form type args))
324 (defmethod copy-from-alien-function ((type t) &rest args)
325 (apply #'from-alien-function type args))
328 (defmethod alien-type ((type (eql 'signed-byte)) &rest args)
329 (declare (ignore type))
330 (destructuring-bind (&optional (size '*)) args
332 (#.+bits-of-byte+ '(signed-byte 8))
333 (#.+bits-of-short+ 'c-call:short)
334 ((* #.+bits-of-int+) 'c-call:int)
335 (#.+bits-of-long+ 'c-call:long))))
337 (defmethod size-of ((type (eql 'signed-byte)) &rest args)
338 (declare (ignore type))
339 (destructuring-bind (&optional (size '*)) args
342 (#.+bits-of-short+ +size-of-short+)
343 ((* #.+bits-of-int+) +size-of-int+)
344 (#.+bits-of-long+ +size-of-long+))))
346 (defmethod unbound-value ((type t) &rest args)
347 (declare (ignore type args))
350 (defmethod writer-function ((type (eql 'signed-byte)) &rest args)
351 (declare (ignore type))
352 (destructuring-bind (&optional (size '*)) args
353 (let ((size (if (eq size '*) +bits-of-int+ size)))
355 (8 #'(lambda (value location &optional (offset 0))
356 (setf (signed-sap-ref-8 location offset) value)))
357 (16 #'(lambda (value location &optional (offset 0))
358 (setf (signed-sap-ref-16 location offset) value)))
359 (32 #'(lambda (value location &optional (offset 0))
360 (setf (signed-sap-ref-32 location offset) value)))
361 (64 #'(lambda (value location &optional (offset 0))
362 (setf (signed-sap-ref-64 location offset) value)))))))
364 (defmethod reader-function ((type (eql 'signed-byte)) &rest args)
365 (declare (ignore type))
366 (destructuring-bind (&optional (size '*)) args
367 (let ((size (if (eq size '*) +bits-of-int+ size)))
369 (8 #'(lambda (sap &optional (offset 0))
370 (signed-sap-ref-8 sap offset)))
371 (16 #'(lambda (sap &optional (offset 0))
372 (signed-sap-ref-16 sap offset)))
373 (32 #'(lambda (sap &optional (offset 0))
374 (signed-sap-ref-32 sap offset)))
375 (64 #'(lambda (sap &optional (offset 0))
376 (signed-sap-ref-64 sap offset)))))))
378 (defmethod alien-type ((type (eql 'unsigned-byte)) &rest args)
379 (destructuring-bind (&optional (size '*)) args
381 (#.+bits-of-byte+ '(unsigned #|-byte|# 8))
382 (#.+bits-of-short+ 'c-call:unsigned-short)
383 ((* #.+bits-of-int+) 'c-call:unsigned-int)
384 (#.+bits-of-long+ 'c-call:unsigned-long))))
386 (defmethod size-of ((type (eql 'unsigned-byte)) &rest args)
387 (apply #'size-of 'signed args))
389 (defmethod writer-function ((type (eql 'unsigned-byte)) &rest args)
390 (declare (ignore type))
391 (destructuring-bind (&optional (size '*)) args
392 (let ((size (if (eq size '*) +bits-of-int+ size)))
394 (8 #'(lambda (value location &optional (offset 0))
395 (setf (sap-ref-8 location offset) value)))
396 (16 #'(lambda (value location &optional (offset 0))
397 (setf (sap-ref-16 location offset) value)))
398 (32 #'(lambda (value location &optional (offset 0))
399 (setf (sap-ref-32 location offset) value)))
400 (64 #'(lambda (value location &optional (offset 0))
401 (setf (sap-ref-64 location offset) value)))))))
403 (defmethod reader-function ((type (eql 'unsigned-byte)) &rest args)
404 (declare (ignore type))
405 (destructuring-bind (&optional (size '*)) args
406 (let ((size (if (eq size '*) +bits-of-int+ size)))
408 (8 #'(lambda (sap &optional (offset 0))
409 (sap-ref-8 sap offset)))
410 (16 #'(lambda (sap &optional (offset 0))
411 (sap-ref-16 sap offset)))
412 (32 #'(lambda (sap &optional (offset 0))
413 (sap-ref-32 sap offset)))
414 (64 #'(lambda (sap &optional (offset 0))
415 (sap-ref-64 sap offset)))))))
418 (defmethod alien-type ((type (eql 'integer)) &rest args)
419 (declare (ignore type args))
420 (alien-type 'signed-byte))
422 (defmethod size-of ((type (eql 'integer)) &rest args)
423 (declare (ignore type args))
424 (size-of 'signed-byte))
426 (defmethod writer-function ((type (eql 'integer)) &rest args)
427 (declare (ignore type args))
428 (writer-function 'signed-byte))
430 (defmethod reader-function ((type (eql 'integer)) &rest args)
431 (declare (ignore type args))
432 (reader-function 'signed-byte))
435 (defmethod alien-type ((type (eql 'fixnum)) &rest args)
436 (declare (ignore type args))
437 (alien-type 'signed-byte))
439 (defmethod size-of ((type (eql 'fixnum)) &rest args)
440 (declare (ignore type args))
441 (size-of 'signed-byte))
444 (defmethod alien-type ((type (eql 'single-float)) &rest args)
445 (declare (ignore type args))
448 (defmethod size-of ((type (eql 'single-float)) &rest args)
449 (declare (ignore type args))
452 (defmethod writer-function ((type (eql 'single-float)) &rest args)
453 (declare (ignore type args))
454 #'(lambda (value location &optional (offset 0))
455 (setf (sap-ref-single location offset) (coerce value 'single-float))))
457 (defmethod reader-function ((type (eql 'single-float)) &rest args)
458 (declare (ignore type args))
459 #'(lambda (sap &optional (offset 0))
460 (sap-ref-single sap offset)))
463 (defmethod alien-type ((type (eql 'double-float)) &rest args)
464 (declare (ignore type args))
467 (defmethod size-of ((type (eql 'double-float)) &rest args)
468 (declare (ignore type args))
471 (defmethod writer-function ((type (eql 'double-float)) &rest args)
472 (declare (ignore type args))
473 #'(lambda (value location &optional (offset 0))
474 (setf (sap-ref-double location offset) (coerce value 'double-float))))
476 (defmethod reader-function ((type (eql 'double-float)) &rest args)
477 (declare (ignore type args))
478 #'(lambda (sap &optional (offset 0))
479 (sap-ref-double sap offset)))
482 (defmethod alien-type ((type (eql 'base-char)) &rest args)
483 (declare (ignore type args))
486 (defmethod size-of ((type (eql 'base-char)) &rest args)
487 (declare (ignore type args))
490 (defmethod writer-function ((type (eql 'base-char)) &rest args)
491 (declare (ignore type args))
492 #'(lambda (char location &optional (offset 0))
493 (setf (sap-ref-8 location offset) (char-code char))))
495 (defmethod reader-function ((type (eql 'base-char)) &rest args)
496 (declare (ignore type args))
497 #'(lambda (location &optional (offset 0))
498 (code-char (sap-ref-8 location offset))))
501 (defmethod alien-type ((type (eql 'string)) &rest args)
502 (declare (ignore type args))
503 (alien-type 'pointer))
505 (defmethod size-of ((type (eql 'string)) &rest args)
506 (declare (ignore type args))
509 (defmethod to-alien-form (string (type (eql 'string)) &rest args)
510 (declare (ignore type args))
511 `(let ((string ,string))
512 ;; Always copy strings to prevent seg fault due to GC
514 (make-pointer (1+ (kernel:get-lisp-obj-address string)))
515 (1+ (length string)))))
517 (defmethod to-alien-function ((type (eql 'string)) &rest args)
518 (declare (ignore type args))
521 (make-pointer (1+ (kernel:get-lisp-obj-address string)))
522 (1+ (length string)))))
524 (defmethod from-alien-form (string (type (eql 'string)) &rest args)
525 (declare (ignore type args))
526 `(let ((string ,string))
527 (unless (null-pointer-p string)
529 (c-call::%naturalize-c-string string)
530 (deallocate-memory string)))))
532 (defmethod from-alien-function ((type (eql 'string)) &rest args)
533 (declare (ignore type args))
535 (unless (null-pointer-p string)
537 (c-call::%naturalize-c-string string)
538 (deallocate-memory string)))))
540 (defmethod cleanup-form (string (type (eql 'string)) &rest args)
541 (declare (ignore type args))
542 `(let ((string ,string))
543 (unless (null-pointer-p string)
544 (deallocate-memory string))))
546 (defmethod cleanup-function ((type (eql 'string)) &rest args)
547 (declare (ignore args))
549 (unless (null-pointer-p string)
550 (deallocate-memory string))))
552 (defmethod copy-from-alien-form (string (type (eql 'string)) &rest args)
553 (declare (ignore type args))
554 `(let ((string ,string))
555 (unless (null-pointer-p string)
556 (c-call::%naturalize-c-string string))))
558 (defmethod copy-from-alien-function ((type (eql 'string)) &rest args)
559 (declare (ignore type args))
561 (unless (null-pointer-p string)
562 (c-call::%naturalize-c-string string))))
564 (defmethod writer-function ((type (eql 'string)) &rest args)
565 (declare (ignore type args))
566 #'(lambda (string location &optional (offset 0))
567 (assert (null-pointer-p (sap-ref-sap location offset)))
568 (setf (sap-ref-sap location offset)
570 (make-pointer (1+ (kernel:get-lisp-obj-address string)))
571 (1+ (length string))))))
573 (defmethod reader-function ((type (eql 'string)) &rest args)
574 (declare (ignore type args))
575 #'(lambda (location &optional (offset 0))
576 (unless (null-pointer-p (sap-ref-sap location offset))
577 (c-call::%naturalize-c-string (sap-ref-sap location offset)))))
579 (defmethod destroy-function ((type (eql 'string)) &rest args)
580 (declare (ignore type args))
581 #'(lambda (location &optional (offset 0))
582 (unless (null-pointer-p (sap-ref-sap location offset))
583 (deallocate-memory (sap-ref-sap location offset))
584 (setf (sap-ref-sap location offset) (make-pointer 0)))))
586 (defmethod unbound-value ((type (eql 'string)) &rest args)
587 (declare (ignore type args))
590 (defmethod alien-type ((type (eql 'pathname)) &rest args)
591 (declare (ignore type args))
592 (alien-type 'string))
594 (defmethod size-of ((type (eql 'pathname)) &rest args)
595 (declare (ignore type args))
598 (defmethod to-alien-form (path (type (eql 'pathname)) &rest args)
599 (declare (ignore type args))
600 (to-alien-form `(namestring (translate-logical-pathname ,path)) 'string))
602 (defmethod to-alien-function ((type (eql 'pathname)) &rest args)
603 (declare (ignore type args))
604 (let ((string-function (to-alien-function 'string)))
606 (funcall string-function (namestring path)))))
608 (defmethod from-alien-form (string (type (eql 'pathname)) &rest args)
609 (declare (ignore type args))
610 `(parse-namestring ,(from-alien-form string 'string)))
612 (defmethod from-alien-function ((type (eql 'pathname)) &rest args)
613 (declare (ignore type args))
614 (let ((string-function (from-alien-function 'string)))
616 (parse-namestring (funcall string-function string)))))
618 (defmethod cleanup-form (string (type (eql 'pathnanme)) &rest args)
619 (declare (ignore type args))
620 (cleanup-form string 'string))
622 (defmethod cleanup-function ((type (eql 'pathnanme)) &rest args)
623 (declare (ignore type args))
624 (cleanup-function 'string))
626 (defmethod writer-function ((type (eql 'pathname)) &rest args)
627 (declare (ignore type args))
628 (let ((string-writer (writer-function 'string)))
629 #'(lambda (path location &optional (offset 0))
630 (funcall string-writer (namestring path) location offset))))
632 (defmethod reader-function ((type (eql 'pathname)) &rest args)
633 (declare (ignore type args))
634 (let ((string-reader (reader-function 'string)))
635 #'(lambda (location &optional (offset 0))
636 (let ((string (funcall string-reader location offset)))
638 (parse-namestring string))))))
640 (defmethod destroy-function ((type (eql 'pathname)) &rest args)
641 (declare (ignore type args))
642 (destroy-function 'string))
644 (defmethod unbound-value ((type (eql 'pathname)) &rest args)
645 (declare (ignore type args))
646 (unbound-value 'string))
649 (defmethod alien-type ((type (eql 'boolean)) &rest args)
650 (apply #'alien-type 'signed-byte args))
652 (defmethod size-of ((type (eql 'boolean)) &rest args)
653 (apply #'size-of 'signed-byte args))
655 (defmethod to-alien-form (boolean (type (eql 'boolean)) &rest args)
656 (declare (ignore type args))
659 (defmethod to-alien-function ((type (eql 'boolean)) &rest args)
660 (declare (ignore type args))
664 (defmethod from-alien-form (boolean (type (eql 'boolean)) &rest args)
665 (declare (ignore type args))
666 `(not (zerop ,boolean)))
668 (defmethod from-alien-function ((type (eql 'boolean)) &rest args)
669 (declare (ignore type args))
671 (not (zerop boolean))))
673 (defmethod writer-function ((type (eql 'boolean)) &rest args)
674 (declare (ignore type))
675 (let ((writer (apply #'writer-function 'signed-byte args)))
676 #'(lambda (boolean location &optional (offset 0))
677 (funcall writer (if boolean 1 0) location offset))))
679 (defmethod reader-function ((type (eql 'boolean)) &rest args)
680 (declare (ignore type))
681 (let ((reader (apply #'reader-function 'signed-byte args)))
682 #'(lambda (location &optional (offset 0))
683 (not (zerop (funcall reader location offset))))))
686 (defmethod alien-type ((type (eql 'or)) &rest args)
687 (let ((alien-type (alien-type (first args))))
688 (unless (every #'(lambda (type)
689 (eq alien-type (alien-type type)))
691 (error "No common alien type specifier for union type: ~A"
695 (defmethod size-of ((type (eql 'or)) &rest args)
696 (declare (ignore type))
697 (size-of (first args)))
699 (defmethod to-alien-form (form (type (eql 'or)) &rest args)
700 (declare (ignore type))
701 `(let ((value ,form))
705 `(,type ,(to-alien-form 'value type)))
708 (defmethod to-alien-function ((type (eql 'or)) &rest types)
709 (declare (ignore type))
710 (let ((functions (mapcar #'to-alien-function types)))
713 for function in functions
715 when (typep value type)
716 do (return (funcall function value))
717 finally (error "~S is not of type ~A" value `(or ,@types))))))
719 (defmethod alien-type ((type (eql 'system-area-pointer)) &rest args)
720 (declare (ignore type args))
721 'system-area-pointer)
723 (defmethod size-of ((type (eql 'system-area-pointer)) &rest args)
724 (declare (ignore type args))
727 (defmethod writer-function ((type (eql 'system-area-pointer)) &rest args)
728 (declare (ignore type args))
729 #'(lambda (sap location &optional (offset 0))
730 (setf (sap-ref-sap location offset) sap)))
732 (defmethod reader-function ((type (eql 'system-area-pointer)) &rest args)
733 (declare (ignore type args))
734 #'(lambda (location &optional (offset 0))
735 (sap-ref-sap location offset)))
738 (defmethod alien-type ((type (eql 'null)) &rest args)
739 (declare (ignore type args))
740 (alien-type 'pointer))
742 (defmethod size-of ((type (eql 'null)) &rest args)
743 (declare (ignore type args))
746 (defmethod to-alien-form (null (type (eql 'null)) &rest args)
747 (declare (ignore null type args))
750 (defmethod to-alien-function ((type (eql 'null)) &rest args)
751 (declare (ignore type args))
753 (declare (ignore null))
757 (defmethod alien-type ((type (eql 'nil)) &rest args)
758 (declare (ignore type args))
761 (defmethod from-alien-function ((type (eql 'nil)) &rest args)
762 (declare (ignore type args))
764 (declare (ignore value))
768 (defmethod alien-type ((type (eql 'copy-of)) &rest args)
769 (declare (ignore type))
770 (alien-type (first args)))
772 (defmethod size-of ((type (eql 'copy-of)) &rest args)
773 (declare (ignore type))
774 (size-of (first args)))
776 (defmethod to-alien-form (form (type (eql 'copy-of)) &rest args)
777 (declare (ignore type))
778 (copy-to-alien-form form (first args)))
780 (defmethod to-alien-function ((type (eql 'copy-of)) &rest args)
781 (declare (ignore type))
782 (copy-to-alien-function (first args)))
784 (defmethod from-alien-form (form (type (eql 'copy-of)) &rest args)
785 (declare (ignore type))
786 (copy-from-alien-form form (first args)))
788 (defmethod from-alien-function ((type (eql 'copy-of)) &rest args)
789 (declare (ignore type))
790 (copy-from-alien-function (first args)))
792 (defmethod reader-function ((type (eql 'copy-of)) &rest args)
793 (declare (ignore type))
794 (reader-function (first args)))
796 (defmethod writer-function ((type (eql 'copy-of)) &rest args)
797 (declare (ignore type))
798 (writer-function (first args)))