;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: primitives.lisp,v 1.12 2003/08/15 02:34:34 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
(make-hash-table :size 20 :test #'eq))
)
-#+(or cmu sbcl scl)
-(defvar *cmu-sbcl-def-type-list* nil)
-
#+(or cmu scl)
(defvar *cmu-sbcl-def-type-list*
'((:char . (alien:signed 8))
(:unsigned-short . (alien:unsigned 16))
(:int . (alien:signed 32))
(:unsigned-int . (alien:unsigned 32))
- (:long . (alien:signed 32))
- (:unsigned-long . (alien:unsigned 32))
+ #-x86-64 (:long . (alien:signed 32))
+ #-x86-64 (:unsigned-long . (alien:unsigned 32))
+ #+x86-64 (:long . (alien:signed 64))
+ #+x86-64 (:unsigned-long . (alien:unsigned 64))
(:float . alien:single-float)
(:double . alien:double-float)
+ (:void . t)
)
"Conversions in CMUCL for def-foreign-type are different than in def-function")
+
#+sbcl
(defvar *cmu-sbcl-def-type-list*
'((:char . (sb-alien:signed 8))
(:unsigned-short . (sb-alien:unsigned 16))
(:int . (sb-alien:signed 32))
(:unsigned-int . (sb-alien:unsigned 32))
- (:long . (sb-alien:signed 32))
- (:unsigned-long . (sb-alien:unsigned 32))
+ #-x86-64 (:long . (sb-alien:signed 32))
+ #-x86-64 (:unsigned-long . (sb-alien:unsigned 32))
+ #+x86-64 (:long . (sb-alien:signed 64))
+ #+x86-64 (:unsigned-long . (sb-alien:unsigned 64))
(:float . sb-alien:single-float)
(:double . sb-alien:double-float)
+ (:void . t)
)
"Conversions in SBCL for def-foreign-type are different than in def-function")
(setq *type-conversion-list*
'((* . *) (:void . sb-alien:void)
(:pointer-void . (* t))
- (:cstring . sb-alien:c-string)
+ #-sb-unicode(:cstring . sb-alien:c-string)
+ #+sb-unicode(:cstring . sb-alien:utf8-string)
(:char . sb-alien:char)
(:unsigned-char . (sb-alien:unsigned 8))
(:byte . (sb-alien:signed 8))
(:unsigned-byte . (sb-alien:unsigned 8))
(:short . sb-alien:short)
(:unsigned-short . sb-alien:unsigned-short)
- (:int . sb-alien:integer) (:unsigned-int . sb-alien:unsigned-int)
+ (:int . sb-alien:int) (:unsigned-int . sb-alien:unsigned-int)
(:long . sb-alien:long) (:unsigned-long . sb-alien:unsigned-long)
(:float . sb-alien:float) (:double . sb-alien:double)
(:array . sb-alien:array)))
#+mcl `(:struct ,(%convert-from-uffi-type (cadr type) :struct))
#-mcl (%convert-from-uffi-type (cadr type) :struct)
)
- (t
- (cons (%convert-from-uffi-type (first type) context)
- (%convert-from-uffi-type (rest type) context)))))))
+ (:union
+ #+mcl `(:union ,(%convert-from-uffi-type (cadr type) :union))
+ #-mcl (%convert-from-uffi-type (cadr type) :union)
+ )
+ (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)))
((and (eq (car result) :pointer) (eq context :allocation) :pointer))
(t result))))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (when (char= #\a (schar (symbol-name '#:a) 0))
+ (pushnew :uffi-lowercase-reader *features*))
+ (when (not (string= (symbol-name '#:a)
+ (symbol-name '#:A)))
+ (pushnew :uffi-case-sensitive *features*)))
+
+(defun make-lisp-name (name)
+ (let ((converted (substitute #\- #\_ name)))
+ (intern
+ #+uffi-case-sensitive converted
+ #+(and (not uffi-lowercase-reader) (not uffi-case-sensitive)) (string-upcase converted)
+ #+(and uffi-lowercase-reader (not uffi-case-sensitive)) (string-downcase converted))))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (setq cl:*features* (delete :uffi-lowercase-reader *features*))
+ (setq cl:*features* (delete :uffi-case-sensitive *features*)))