X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-alieneval.lisp;h=2f62bfc54c128c30760c662107b576c4c701dd97;hb=771b864c8f32af7734bc0550aeaf1539fc4df194;hp=cb061ee8bb434569cb9c111fbdc5a0f6d620eb23;hpb=ca20672bfac54095ae593d1f7da0eccbc0bf6257;p=sbcl.git

diff --git a/src/code/target-alieneval.lisp b/src/code/target-alieneval.lisp
index cb061ee..2f62bfc 100644
--- a/src/code/target-alieneval.lisp
+++ b/src/code/target-alieneval.lisp
@@ -73,19 +73,20 @@
     (clear-info :variable :constant-value lisp-name)
     (setf (info :variable :alien-info lisp-name)
 	  (make-heap-alien-info :type type
-				:sap-form `(foreign-symbol-address
-					    ',alien-name)))))
+				:sap-form `(foreign-symbol-address ',alien-name t)))))
 
 (defmacro extern-alien (name type &environment env)
   #!+sb-doc
   "Access the alien variable named NAME, assuming it is of type TYPE. This
    is SETFable."
-  (let ((alien-name (etypecase name
-		      (symbol (guess-alien-name-from-lisp-name name))
-		      (string name))))
+  (let* ((alien-name (etypecase name
+		       (symbol (guess-alien-name-from-lisp-name name))
+		       (string name)))
+	 (alien-type (parse-alien-type type env))
+	 (datap (not (alien-fun-type-p alien-type))))
     `(%heap-alien ',(make-heap-alien-info
-		     :type (parse-alien-type type env)
-		     :sap-form `(foreign-symbol-address ',alien-name)))))
+		     :type alien-type
+		     :sap-form `(foreign-symbol-address ',alien-name ,datap)))))
 
 (defmacro with-alien (bindings &body body &environment env)
   #!+sb-doc
@@ -109,7 +110,8 @@
 	  (symbol type &optional (opt1 nil opt1p) (opt2 nil opt2p))
 	  binding
 	(/show symbol type opt1 opt2)
-	(let ((alien-type (parse-alien-type type env)))
+	(let* ((alien-type (parse-alien-type type env))
+	       (datap (not (alien-fun-type-p alien-type))))
 	  (/show alien-type)
 	  (multiple-value-bind (allocation initial-value)
 	      (if opt2p
@@ -137,16 +139,17 @@
 				`((setq ,symbol ,initial-value)))
 			    ,@body)))))
 		    (:extern
-		     (/show ":EXTERN case")
+		     (/show0 ":EXTERN case")
 		     (let ((info (make-heap-alien-info
 				  :type alien-type
 				  :sap-form `(foreign-symbol-address
-					      ',initial-value))))
+					      ',initial-value
+					      ,datap))))
 		       `((symbol-macrolet
 			  ((,symbol (%heap-alien ',info)))
 			  ,@body))))
 		    (:local
-		     (/show ":LOCAL case")
+		     (/show0 ":LOCAL case")
 		     (let ((var (gensym))
 			   (initval (if initial-value (gensym)))
 			   (info (make-local-alien-info :type alien-type)))
@@ -164,7 +167,7 @@
 			       (dispose-local-alien ',info ,var))))))))))))
     (/show "revised" body)
     (verify-local-auxiliaries-okay)
-    (/show "back from VERIFY-LOCAL-AUXILIARIES-OK, returning")
+    (/show0 "back from VERIFY-LOCAL-AUXILIARIES-OK, returning")
     `(symbol-macrolet ((&auxiliary-type-definitions&
 			,(append *new-auxiliary-types*
 				 (auxiliary-type-definitions env))))
@@ -178,9 +181,10 @@
 (def!method print-object ((value alien-value) stream)
   (print-unreadable-object (value stream)
     (format stream
-	    "~S :SAP #X~8,'0X"
+	    "~S ~S #X~8,'0X ~S ~S"
 	    'alien-value
-	    (sap-int (alien-value-sap value)))))
+	    :sap (sap-int (alien-value-sap value))
+	    :type (unparse-alien-type (alien-value-type value)))))
 
 #!-sb-fluid (declaim (inline null-alien))
 (defun null-alien (x)
@@ -603,25 +607,25 @@
   way that the argument is passed.
 
   :IN
-	An :IN argument is simply passed by value. The value to be passed is
-	obtained from argument(s) to the interface function. No values are
-	returned for :In arguments. This is the default mode.
+        An :IN argument is simply passed by value. The value to be passed is
+        obtained from argument(s) to the interface function. No values are
+        returned for :In arguments. This is the default mode.
 
   :OUT
-	The specified argument type must be a pointer to a fixed sized object.
-	A pointer to a preallocated object is passed to the routine, and the
-	the object is accessed on return, with the value being returned from
-	the interface function. :OUT and :IN-OUT cannot be used with pointers
-	to arrays, records or functions.
+        The specified argument type must be a pointer to a fixed sized object.
+        A pointer to a preallocated object is passed to the routine, and the
+        the object is accessed on return, with the value being returned from
+        the interface function. :OUT and :IN-OUT cannot be used with pointers
+        to arrays, records or functions.
 
   :COPY
-	This is similar to :IN, except that the argument values are stored
+        This is similar to :IN, except that the argument values are stored
         on the stack, and a pointer to the object is passed instead of
-	the value itself.
+        the value itself.
 
   :IN-OUT
-	This is a combination of :OUT and :COPY. A pointer to the argument is
-        passed,	with the object being initialized from the supplied argument
+        This is a combination of :OUT and :COPY. A pointer to the argument is
+        passed, with the object being initialized from the supplied argument
         and the return value being determined by accessing the object on
         return."
   (multiple-value-bind (lisp-name alien-name)
@@ -678,7 +682,7 @@
 	 ;; alien values) both messy to do by hand and very important
 	 ;; for performance of later code which uses the return value.
 	 (declaim (ftype (function ,(lisp-arg-types)
-                                   (values ,@(lisp-result-types)))
+                                   (values ,@(lisp-result-types) &optional))
                          ,lisp-name))
 	 (defun ,lisp-name ,(lisp-args)
 	   ,@(docs)