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

diff --git a/src/code/target-alieneval.lisp b/src/code/target-alieneval.lisp
index e7d5054..c130387 100644
--- a/src/code/target-alieneval.lisp
+++ b/src/code/target-alieneval.lisp
@@ -45,7 +45,7 @@
 	 (error "badly formed alien name"))
        (values (cadr name) (car name))))))
 
-(defmacro def-alien-variable (name type &environment env)
+(defmacro define-alien-variable (name type &environment env)
   #!+sb-doc
   "Define NAME as an external alien variable of type TYPE. NAME should be
    a list of a string holding the alien name and a symbol to use as the Lisp
@@ -57,13 +57,17 @@
 	`(eval-when (:compile-toplevel :load-toplevel :execute)
 	   ,@(when *new-auxiliary-types*
 	       `((%def-auxiliary-alien-types ',*new-auxiliary-types*)))
-	   (%def-alien-variable ',lisp-name
-				',alien-name
-				',alien-type))))))
+	   (%define-alien-variable ',lisp-name
+				   ',alien-name
+				   ',alien-type))))))
 
-;;; Do the actual work of DEF-ALIEN-VARIABLE.
+(defmacro def-alien-variable (&rest rest)
+  (deprecation-warning 'def-alien-variable 'define-alien-variable)
+  `(define-alien-variable ,@rest))
+
+;;; Do the actual work of DEFINE-ALIEN-VARIABLE.
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (defun %def-alien-variable (lisp-name alien-name type)
+  (defun %define-alien-variable (lisp-name alien-name type)
     (setf (info :variable :kind lisp-name) :alien)
     (setf (info :variable :where-from lisp-name) :defined)
     (clear-info :variable :constant-value lisp-name)
@@ -191,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)
@@ -341,7 +345,7 @@
     (etypecase type
       (alien-pointer-type
        (when (cdr indices)
-	 (error "too many indices when derefing ~S: ~D"
+	 (error "too many indices when DEREF'ing ~S: ~W"
 		type
 		(length indices)))
        (let ((element-type (alien-pointer-type-to type)))
@@ -353,7 +357,7 @@
 		     0))))
       (alien-array-type
        (unless (= (length indices) (length (alien-array-type-dimensions type)))
-	 (error "incorrect number of indices when derefing ~S: ~D"
+	 (error "incorrect number of indices when DEREF'ing ~S: ~W"
 		type (length indices)))
        (labels ((frob (dims indices offset)
 		  (if (null dims)
@@ -432,10 +436,10 @@
 	 (alien-sap (alien-sap alien)))
     (finalize
      alien
-     #'(lambda ()
-	 (alien-funcall
-	  (extern-alien "free" (function (values) system-area-pointer))
-	  alien-sap)))
+     (lambda ()
+       (alien-funcall
+	(extern-alien "free" (function (values) system-area-pointer))
+	alien-sap)))
     alien))
 
 (defun note-local-alien-type (info alien)
@@ -547,7 +551,7 @@
   (funcall (coerce (compute-deposit-lambda type) 'function)
 	   sap offset type value))
 
-;;;; ALIEN-FUNCALL, DEF-ALIEN-ROUTINE
+;;;; ALIEN-FUNCALL, DEFINE-ALIEN-ROUTINE
 
 (defun alien-funcall (alien &rest args)
   #!+sb-doc
@@ -561,7 +565,7 @@
       (alien-fun-type
        (unless (= (length (alien-fun-type-arg-types type))
 		  (length args))
-	 (error "wrong number of arguments for ~S~%expected ~D, got ~D"
+	 (error "wrong number of arguments for ~S~%expected ~W, got ~W"
 		type
 		(length (alien-fun-type-arg-types type))
 		(length args)))
@@ -579,9 +583,11 @@
       (t
        (error "~S is not an alien function." alien)))))
 
-(defmacro def-alien-routine (name result-type &rest args &environment lexenv)
+(defmacro define-alien-routine (name result-type
+				     &rest args
+				     &environment lexenv)
   #!+sb-doc
-  "DEF-ALIEN-ROUTINE Name Result-Type {(Arg-Name Arg-Type [Style])}*
+  "DEFINE-ALIEN-ROUTINE Name Result-Type {(Arg-Name Arg-Type [Style])}*
 
   Define a foreign interface function for the routine with the specified NAME.
   Also automatically DECLAIM the FTYPE of the defined function.
@@ -653,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)
@@ -672,6 +694,10 @@
 		      (values ,@temps ,@(results))))
 		 `(values (alien-funcall ,lisp-name ,@(alien-args))
 			  ,@(results)))))))))
+
+(defmacro def-alien-routine (&rest rest)
+  (deprecation-warning 'def-alien-routine 'define-alien-routine)
+  `(define-alien-routine ,@rest))
 
 (defun alien-typep (object type)
   #!+sb-doc