X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-alieneval.lisp;h=c93516556097b7746b0863f84fd17c07a3983367;hb=bee53328c93be3433477821131ab805557476c8b;hp=c0c48613b1d70ca4a12ccd1ede3985c45c99375c;hpb=4f64f131a7bca59d0dc8be9e74d05a7645f27e67;p=sbcl.git

diff --git a/src/code/target-alieneval.lisp b/src/code/target-alieneval.lisp
index c0c4861..c935165 100644
--- a/src/code/target-alieneval.lisp
+++ b/src/code/target-alieneval.lisp
@@ -97,12 +97,16 @@
      :EXTERN
        No alien is allocated, but VAR is established as a local name for
        the external alien given by EXTERNAL-NAME."
+  (/show "entering WITH-ALIEN" bindings)
   (with-auxiliary-alien-types env
     (dolist (binding (reverse bindings))
+      (/show binding)
       (destructuring-bind
 	  (symbol type &optional (opt1 nil opt1p) (opt2 nil opt2p))
 	  binding
+	(/show symbol type opt1 opt2)
 	(let ((alien-type (parse-alien-type type env)))
+	  (/show alien-type)
 	  (multiple-value-bind (allocation initial-value)
 	      (if opt2p
 		  (values opt1 opt2)
@@ -113,6 +117,7 @@
 		     (values opt1 nil))
 		    (t
 		     (values :local opt1))))
+	    (/show allocation initial-value)
 	    (setf body
 		  (ecase allocation
 		    #+nil
@@ -128,6 +133,7 @@
 				`((setq ,symbol ,initial-value)))
 			    ,@body)))))
 		    (:extern
+		     (/show ":EXTERN case")
 		     (let ((info (make-heap-alien-info
 				  :type alien-type
 				  :sap-form `(foreign-symbol-address
@@ -136,9 +142,11 @@
 			  ((,symbol (%heap-alien ',info)))
 			  ,@body))))
 		    (:local
+		     (/show ":LOCAL case")
 		     (let ((var (gensym))
 			   (initval (if initial-value (gensym)))
 			   (info (make-local-alien-info :type alien-type)))
+		       (/show var initval info)
 		       `((let ((,var (make-local-alien ',info))
 			       ,@(when initial-value
 				   `((,initval ,initial-value))))
@@ -150,7 +158,9 @@
 				    `((setq ,symbol ,initval)))
 				,@body)
 			       (dispose-local-alien ',info ,var))))))))))))
+    (/show "revised" body)
     (verify-local-auxiliaries-okay)
+    (/show "back from VERIFY-LOCAL-AUXILIARIES-OK, returning")
     `(symbol-macrolet ((&auxiliary-type-definitions&
 			,(append *new-auxiliary-types*
 				 (auxiliary-type-definitions env))))
@@ -158,8 +168,6 @@
 
 ;;;; runtime C values that don't correspond directly to Lisp types
 
-;;; ALIEN-VALUE
-;;;
 ;;; Note: The DEFSTRUCT for ALIEN-VALUE lives in a separate file
 ;;; 'cause it has to be real early in the cold-load order.
 #!-sb-fluid (declaim (freeze-type alien-value))
@@ -244,15 +252,16 @@
 ;;; system area pointer to it.
 #!-sb-fluid (declaim (inline %make-alien))
 (defun %make-alien (bits)
-  (declare (type index bits) (optimize-interface (safety 2)))
-  (alien-funcall (extern-alien "malloc" (function system-area-pointer unsigned))
+  (declare (type index bits))
+  (alien-funcall (extern-alien "malloc"
+			       (function system-area-pointer unsigned))
 		 (ash (the index (+ bits 7)) -3)))
 
 #!-sb-fluid (declaim (inline free-alien))
 (defun free-alien (alien)
   #!+sb-doc
   "Dispose of the storage pointed to by ALIEN. ALIEN must have been allocated
-   by MAKE-ALIEN or ``malloc''."
+   by MAKE-ALIEN or malloc(3)."
   (alien-funcall (extern-alien "free" (function (values) system-area-pointer))
 		 (alien-sap alien))
   nil)
@@ -265,7 +274,7 @@
 	   (type symbol slot))
   (or (find slot (alien-record-type-fields type)
 	    :key #'alien-record-field-name)
-      (error "There is no slot named ~S in ~S" slot type)))
+      (error "There is no slot named ~S in ~S." slot type)))
 
 ;;; Extract the value from the named slot from the record ALIEN. If
 ;;; ALIEN is actually a pointer, then DEREF it first.
@@ -451,12 +460,10 @@
     (values nil
 	    nil
 	    (list value)
-	    (if sb!c:*converting-for-interpreter*
-		`(%set-local-alien ',info ,alien ,value)
-		`(if (%local-alien-forced-to-memory-p ',info)
-		     (%set-local-alien ',info ,alien ,value)
-		     (setf ,alien
-			   (deport ,value ',(local-alien-info-type info)))))
+	    `(if (%local-alien-forced-to-memory-p ',info)
+		 (%set-local-alien ',info ,alien ,value)
+		 (setf ,alien
+		       (deport ,value ',(local-alien-info-type info))))
 	    whole)))
 
 (defun %local-alien-forced-to-memory-p (info)
@@ -484,7 +491,7 @@
 (defun %cast (alien target-type)
   (declare (type alien-value alien)
 	   (type alien-type target-type)
-	   (optimize-interface (safety 2))
+	   (optimize (safety 2))
 	   (optimize (inhibit-warnings 3)))
   (if (or (alien-pointer-type-p target-type)
 	  (alien-array-type-p target-type)