X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=src%2Fprimitives.lisp;h=5522f5a73e55e79f4baea4a7d0e844d46357d53b;hb=13635ed2b774e454b90823e085d84aa968da9eb4;hp=26737bdce30205db01bcb2bee0eab4a6fa27ff67;hpb=ac9eafca18c6a684c2a7ed3c353c5eeac3456849;p=uffi.git diff --git a/src/primitives.lisp b/src/primitives.lisp index 26737bd..5522f5a 100644 --- a/src/primitives.lisp +++ b/src/primitives.lisp @@ -115,8 +115,10 @@ supports takes advantage of this optimization." (: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) @@ -145,14 +147,15 @@ supports takes advantage of this optimization." (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))) @@ -277,15 +280,6 @@ supports takes advantage of this optimization." (let ((result (%convert-from-uffi-type type context))) (cond ((atom result) result) - ;; Arrays without size are really pointers to type on SBCL/CMUCL - #+sbcl - ((and (consp type) (= 2 (length type)) (eq :array (car type))) - (setf (car result) 'sb-alien:*) - result) - #+cmu - ((and (consp type) (= 2 (length type)) (eq :array (car type))) - (setf (car result) 'alien:*) - result) #+openmcl ((eq (car result) :address) (if (eq context :struct) @@ -295,9 +289,20 @@ supports takes advantage of this optimization." ((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 - #+case-sensitive converted - #-case-sensitive (string-upcase converted)))) + #+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*)))