X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=src%2Fprimitives.lisp;h=02348a3bc1edaa3a74cc8f6f6d5aebef939c420d;hb=fb079870a636e776d02df1710c5728ed134584ca;hp=007355c316209082abc7d6d22886cfe297b3403a;hpb=ebedde4e67b858b1f65c5eb4dc7bc45978ed1e40;p=uffi.git diff --git a/src/primitives.lisp b/src/primitives.lisp index 007355c..02348a3 100644 --- a/src/primitives.lisp +++ b/src/primitives.lisp @@ -87,9 +87,6 @@ supports takes advantage of this optimization." (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)) @@ -104,8 +101,10 @@ supports takes advantage of this optimization." (:unsigned-long . (alien:unsigned 32)) (: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)) @@ -120,6 +119,7 @@ supports takes advantage of this optimization." (:unsigned-long . (sb-alien:unsigned 32)) (: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") @@ -152,7 +152,7 @@ supports takes advantage of this optimization." (: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))) @@ -286,3 +286,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 + #+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*)))