;;;; Programmers: Kevin M. Rosenberg and John DeSoi
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: primitives.cl,v 1.3 2002/09/20 13:05:59 kevin Exp $
+;;;; $Id: primitives.cl,v 1.4 2002/09/30 01:57:32 kevin Exp $
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;; and John DeSoi
(defmacro def-foreign-type (name uffi-type)
(let ((type (convert-from-uffi-type uffi-type :type)))
- (unless (keywordp type)
+ (unless (or (keywordp type) (consp type))
(setf type `(quote ,type)))
#-openmcl
`(def-mcl-type ,(keyword name) ,type)
"Converts from a uffi type to an implementation specific type"
(if (atom type)
(cond
- #-openmcl
- ((and (eq type :void) (eq context :return)) nil)
+ #-openmcl ((and (eq type :void) (eq context :return)) nil)
(t (basic-convert-from-uffi-type type)))
- (if (eq (car type) 'cl:quote)
- (%convert-from-uffi-type (cadr type) context)
- (cons (%convert-from-uffi-type (first type) context)
- (%convert-from-uffi-type (rest type) context)))))
+ (let ((sub-type (car type)))
+ (case sub-type
+ (cl:quote
+ (%convert-from-uffi-type (cadr type) context))
+ (:struct-pointer
+ #+openmcl `(:* (:struct ,(convert-from-uffi-type (cadr type) :struct)))
+ #-openmcl `(,(convert-from-uffi-type (list '* (cadr type)) :struct))
+ )
+ (:struct
+ #+openmcl `(:struct ,(convert-from-uffi-type (cadr type) :struct))
+ #-openmcl `(,(convert-from-uffi-type (cadr type) :struct))
+ )
+ (t
+ (cons (%convert-from-uffi-type (first type) context)
+ (%convert-from-uffi-type (rest type) context)))))))
(defun convert-from-uffi-type (type context)
(let ((result (%convert-from-uffi-type type context)))
(cond
((atom result) result)
#+openmcl
- ((eq (car result) :address) :address)
+ ((eq (car result) :address)
+ (if (eq context :struct)
+ (append '(:*) (cdr result))
+ :address))
#-openmcl
((and (eq (car result) :pointer) (eq context :allocation) :pointer))
(t result))))