X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=src%2Fprimitives.cl;h=8a29b21318087606e6956b928cd377776206114a;hb=a831d46a26cd75fe1d6884191a3a08b54185138b;hp=bf013e65669c2e9ca658bad075ae254978007429;hpb=0ed0429c5921629ae1912f96379a8715e2d48a3b;p=uffi.git diff --git a/src/primitives.cl b/src/primitives.cl index bf013e6..8a29b21 100644 --- a/src/primitives.cl +++ b/src/primitives.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: primitives.cl,v 1.11 2002/03/21 10:58:57 kevin Exp $ +;;;; $Id: primitives.cl,v 1.13 2002/03/23 09:32:43 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -64,7 +64,9 @@ supports takes advantage of this optimization." (:unsigned-long . (alien:unsigned 32)) (:float . alien:single-float) (:double . alien:double-float) - )) + ) + "Conversions in CMUCL or def-foreign-type are different thatn in def-function") + #+cmu (defconstant +type-conversion-list+ @@ -98,8 +100,9 @@ supports takes advantage of this optimization." (defconstant +type-conversion-list+ '((* . :pointer) (:void . :void) (:short . :short) - (:pointer-void . (:pointer :unsigned :void)) - (:cstring . (:pointer (:unsigned :char))) + (:pointer-void . (:pointer :void)) + (:cstring . (:reference-pass :ef-mb-string :allow-null t)) + (:cstring-returning . (:reference :ef-mb-string :allow-null t)) (:char . :char) (:byte :byte) (:unsigned-char . (:unsigned :char)) @@ -115,6 +118,12 @@ supports takes advantage of this optimization." (dolist (type +cmu-def-type-list+) (setf (gethash (car type) +cmu-def-type-hash+) (cdr type))) +(defun basic-convert-from-uffi-type (type) + (let ((found-type (gethash type +type-conversion-hash+))) + (if found-type + found-type + type))) + (defun convert-from-uffi-type (type context) "Converts from a uffi type to an implementation specific type" (if (atom type) @@ -128,17 +137,15 @@ supports takes advantage of this optimization." (let ((cmu-type (gethash type +cmu-def-type-hash+))) (if cmu-type cmu-type - (let ((found-type (gethash type +type-conversion-hash+))) - (if found-type - found-type - type))))) + (basic-convert-from-uffi-type type)))) + #+lispworks + ((and (eq context :return) + (eq type :cstring)) + (basic-convert-from-uffi-type :cstring-returning)) (t - (let ((found-type (gethash type +type-conversion-hash+))) - (if found-type - found-type - type)))) - (cons (convert-from-uffi-type (first type) context) - (convert-from-uffi-type (rest type) context)))) + (basic-convert-from-uffi-type type))) + (cons (convert-from-uffi-type (first type) context) + (convert-from-uffi-type (rest type) context))))