X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=src%2Fprimitives.lisp;h=5522f5a73e55e79f4baea4a7d0e844d46357d53b;hb=13635ed2b774e454b90823e085d84aa968da9eb4;hp=73027ef4c37798c83656dcd536f437f8b2a160b4;hpb=a27a393f26a7a423d758e902dbff07c81ccead91;p=uffi.git

diff --git a/src/primitives.lisp b/src/primitives.lisp
index 73027ef..5522f5a 100644
--- a/src/primitives.lisp
+++ b/src/primitives.lisp
@@ -7,7 +7,7 @@
 ;;;; 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
 ;;;;
@@ -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))
@@ -116,10 +115,13 @@ 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)
       )
   "Conversions in SBCL for def-foreign-type are different than in def-function")
 
@@ -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)))
@@ -286,3 +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 
+      #+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*)))