X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=src%2Faggregates.cl;h=3fc32a34f093a2096ae06ce2779f5b4c778e42a6;hb=6957305d2fba5a66f90568af5ae9efc331482f55;hp=3bb97f9ae59f46c37cb94771bc3b24b16fa8608b;hpb=fb93b1923db347f01bdebc7226e5e1eaacacc9f9;p=uffi.git diff --git a/src/aggregates.cl b/src/aggregates.cl index 3bb97f9..3fc32a3 100644 --- a/src/aggregates.cl +++ b/src/aggregates.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: aggregates.cl,v 1.6 2002/03/17 17:33:30 kevin Exp $ +;;;; $Id: aggregates.cl,v 1.8 2002/03/23 12:58:12 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -49,23 +49,23 @@ of the enum-name name, separator-string, and field-name" cmds)) -(defmacro def-array (name-array type) +(defmacro def-array-pointer (name-array type) #+allegro `(ff:def-foreign-type ,name-array - (:array ,(convert-from-uffi-type type :array))) + (:array ,(convert-from-uffi-type type :array))) #+lispworks `(fli:define-c-typedef ,name-array - (:pointer (:pointer ,(convert-from-uffi-type type :array)))) + (:c-array ,(convert-from-uffi-type type :array))) #+cmu `(alien:def-alien-type ,name-array - (* ,(convert-from-uffi-type type :array))) + (* ,(convert-from-uffi-type type :array))) ) -(defun process-struct-args (name args) +(defun process-struct-fields (name fields) (let (processed) - (dolist (arg args) - (let ((field-name (car arg)) - (type (cadr arg))) + (dolist (field fields) + (let ((field-name (car field)) + (type (cadr field))) (push (append (list field-name) (if (eq type :pointer-self) #+cmu `((* (alien:struct ,name))) @@ -75,13 +75,13 @@ of the enum-name name, separator-string, and field-name" (nreverse processed))) -(defmacro def-struct (name &rest args) +(defmacro def-struct (name &rest fields) #+cmu - `(alien:def-alien-type ,name (alien:struct ,name ,@(process-struct-args name args))) + `(alien:def-alien-type ,name (alien:struct ,name ,@(process-struct-fields name fields))) #+allegro - `(ff:def-foreign-type ,name (:struct ,@(process-struct-args name args))) + `(ff:def-foreign-type ,name (:struct ,@(process-struct-fields name fields))) #+lispworks - `(fli:define-c-struct ,name ,@(process-struct-args name args)) + `(fli:define-c-struct ,name ,@(process-struct-fields name fields)) ) @@ -113,7 +113,13 @@ of the enum-name name, separator-string, and field-name" #+allegro `(ff:fslot-value-typed ,type :c ,obj ,i) ) - - +(defmacro def-union (name &rest fields) + #+allegro + `(ff:def-foreign-type ,name (:union ,@(process-struct-fields name fields))) + #+lispworks + `(fli:define-c-union ,name ,@(process-struct-fields name fields)) + #+cmu + `(alien:def-alien-type ,name (alien:union ,name ,@(process-struct-fields name fields))) +)