X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-alieneval.lisp;h=c130387f58d8dd3fb077425037c286797699fa1c;hb=86210c4e406c1b2ff10cc3bac0e71435867db48b;hp=3150c14febe167d5d5b2c22f9d59450de96427b3;hpb=e0814eee6f6dea52db010b45a330100f2fe65832;p=sbcl.git

diff --git a/src/code/target-alieneval.lisp b/src/code/target-alieneval.lisp
index 3150c14..c130387 100644
--- a/src/code/target-alieneval.lisp
+++ b/src/code/target-alieneval.lisp
@@ -195,7 +195,7 @@
   (let ((alien-type (parse-alien-type type env)))
     (if (eq (compute-alien-rep-type alien-type) 'system-area-pointer)
 	`(%sap-alien ,sap ',alien-type)
-	(error "cannot make aliens of type ~S out of SAPs" type))))
+	(error "cannot make an alien of type ~S out of a SAP" type))))
 
 (defun %sap-alien (sap type)
   (declare (type system-area-pointer sap)
@@ -659,9 +659,25 @@
 	 ;; anyway, and (2) such a declamation can be (especially for
 	 ;; alien values) both messy to do by hand and very important
 	 ;; for performance of later code which uses the return value.
-	 (declaim (ftype (function ,(mapcar (constantly t) args)
-				   (alien ,result-type))
-			 ,lisp-name))
+	 ,(let (;; FIXME: Ideally, we'd actually declare useful types
+		;; here, so e.g. an alien function of "int" and "char"
+		;; arguments would get Lisp arg types WORD and CHARACTER
+		;; or something. Meanwhile, for now we just punt.
+		(lisp-arg-types (mapcar (constantly t) args))
+		;; KLUDGE: This is a quick hack to solve bug 133,
+		;; where PROCLAIM trying to translate alien void result
+		;; types would signal an error here ("cannot use values
+		;; types here"), and the kludgy SB!ALIEN::*VALUE-TYPE-OKAY*
+		;; flag to enable values types didn't fit into PROCLAIM
+		;; in any reasonable way. But there's likely a better
+		;; way to do this. (If there isn't a suitable utility
+		;; to systematically translate C return types into
+		;; Lisp return types, there should be.) -- WHN 2002-01-22
+		(lisp-result-type (if (eql result-type 'void)
+				      '(values)
+				      `(alien ,result-type))))
+	    `(declaim (ftype (function ,lisp-arg-types ,lisp-result-type)
+			     ,lisp-name)))
 
 	 (defun ,lisp-name ,(lisp-args)
 	   ,@(docs)