X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fhost-alieneval.lisp;h=647dc3975be2c43ee15c4436a387ccbc10b2f7e7;hb=86210c4e406c1b2ff10cc3bac0e71435867db48b;hp=7d525877a084bb7865c1a6199eab49164b1f8e94;hpb=e33fb894f991b2926d8f3bace9058e4c0b2c3a37;p=sbcl.git

diff --git a/src/code/host-alieneval.lisp b/src/code/host-alieneval.lisp
index 7d52587..647dc39 100644
--- a/src/code/host-alieneval.lisp
+++ b/src/code/host-alieneval.lisp
@@ -107,7 +107,7 @@
 	   (create-alien-type-class-if-necessary ',name ',(or include 'root)))
 	 (def!struct (,defstruct-name
 			(:include ,include-defstruct
-				  (:class ',name)
+				  (class ',name)
 				  ,@overrides)
 			(:constructor
 			 ,(symbolicate "MAKE-" defstruct-name)
@@ -115,7 +115,9 @@
 			       ,@(mapcar (lambda (x)
 					   (if (atom x) x (car x)))
 					 slots)
-			       ,@include-args)))
+			       ,@include-args
+			       ;; KLUDGE
+			       &aux (alignment (or alignment (guess-alignment bits))))))
 	   ,@slots)))))
 
 (def!macro define-alien-type-method ((class method) lambda-list &rest body)
@@ -322,10 +324,11 @@
 
 (def!struct (alien-type
 	     (:make-load-form-fun sb!kernel:just-dump-it-normally)
-	     (:constructor make-alien-type (&key class bits alignment)))
+	     (:constructor make-alien-type (&key class bits alignment
+					    &aux (alignment (or alignment (guess-alignment bits))))))
   (class 'root :type symbol)
   (bits nil :type (or null unsigned-byte))
-  (alignment (guess-alignment bits) :type (or null unsigned-byte)))
+  (alignment nil :type (or null unsigned-byte)))
 (def!method print-object ((type alien-type) stream)
   (print-unreadable-object (type stream :type t)
     (prin1 (unparse-alien-type type) stream)))
@@ -593,7 +596,7 @@
 
 ;;;; the ENUM type
 
-(define-alien-type-class (enum :include (integer (:bits 32))
+(define-alien-type-class (enum :include (integer (bits 32))
 			       :include-args (signed))
   name		; name of this enum (if any)
   from		; alist from keywords to integers.
@@ -673,21 +676,21 @@
        (t
 	(make-alien-enum-type :name name :signed signed
 			      :from from-alist
-			      :to (mapcar #'(lambda (x) (cons (cdr x) (car x)))
+			      :to (mapcar (lambda (x) (cons (cdr x) (car x)))
 					  from-alist)
 			      :kind :alist))))))
 
 (define-alien-type-method (enum :unparse) (type)
   `(enum ,(alien-enum-type-name type)
 	 ,@(let ((prev -1))
-	     (mapcar #'(lambda (mapping)
-			 (let ((sym (car mapping))
-			       (value (cdr mapping)))
-			   (prog1
-			       (if (= (1+ prev) value)
-				   sym
-				   `(,sym ,value))
-			     (setf prev value))))
+	     (mapcar (lambda (mapping)
+		       (let ((sym (car mapping))
+			     (value (cdr mapping)))
+			 (prog1
+			     (if (= (1+ prev) value)
+				 sym
+				 `(,sym ,value))
+			   (setf prev value))))
 		     (alien-enum-type-from type)))))
 
 (define-alien-type-method (enum :type=) (type1 type2)
@@ -706,14 +709,14 @@
 	     (+ ,alien ,(alien-enum-type-offset type))))
     (:alist
      `(ecase ,alien
-	,@(mapcar #'(lambda (mapping)
-		      `(,(car mapping) ,(cdr mapping)))
+	,@(mapcar (lambda (mapping)
+		    `(,(car mapping) ,(cdr mapping)))
 		  (alien-enum-type-to type))))))
 
 (define-alien-type-method (enum :deport-gen) (type value)
   `(ecase ,value
-     ,@(mapcar #'(lambda (mapping)
-		   `(,(car mapping) ,(cdr mapping)))
+     ,@(mapcar (lambda (mapping)
+		 `(,(car mapping) ,(cdr mapping)))
 	       (alien-enum-type-from type))))
 
 ;;;; the FLOAT types
@@ -738,7 +741,7 @@
   (declare (ignore type))
   value)
 
-(define-alien-type-class (single-float :include (float (:bits 32))
+(define-alien-type-class (single-float :include (float (bits 32))
 				       :include-args (type)))
 
 (define-alien-type-translator single-float ()
@@ -748,7 +751,7 @@
   (declare (ignore type))
   `(sap-ref-single ,sap (/ ,offset sb!vm:n-byte-bits)))
 
-(define-alien-type-class (double-float :include (float (:bits 64))
+(define-alien-type-class (double-float :include (float (bits 64))
 				       :include-args (type)))
 
 (define-alien-type-translator double-float ()
@@ -759,8 +762,8 @@
   `(sap-ref-double ,sap (/ ,offset sb!vm:n-byte-bits)))
 
 #!+long-float
-(define-alien-type-class (long-float :include (float (:bits #!+x86 96
-							    #!+sparc 128))
+(define-alien-type-class (long-float :include (float (bits #!+x86 96
+							   #!+sparc 128))
 				     :include-args (type)))
 
 #!+long-float
@@ -774,7 +777,7 @@
 
 ;;;; the POINTER type
 
-(define-alien-type-class (pointer :include (alien-value (:bits
+(define-alien-type-class (pointer :include (alien-value (bits
 							 #!-alpha
 							 sb!vm:n-word-bits
 							 #!+alpha 64)))
@@ -856,7 +859,7 @@
     (unless (typep (first dims) '(or index null))
       (error "The first dimension is not a non-negative fixnum or NIL: ~S"
 	     (first dims)))
-    (let ((loser (find-if-not #'(lambda (x) (typep x 'index))
+    (let ((loser (find-if-not (lambda (x) (typep x 'index))
 			      (rest dims))))
       (when loser
 	(error "A dimension is not a non-negative fixnum: ~S" loser))))
@@ -999,11 +1002,11 @@
     ,(alien-record-type-name type)
     ,@(unless (member type *record-types-already-unparsed* :test #'eq)
 	(push type *record-types-already-unparsed*)
-	(mapcar #'(lambda (field)
-		    `(,(alien-record-field-name field)
-		      ,(%unparse-alien-type (alien-record-field-type field))
-		      ,@(if (alien-record-field-bits field)
-			    (list (alien-record-field-bits field)))))
+	(mapcar (lambda (field)
+		  `(,(alien-record-field-name field)
+		    ,(%unparse-alien-type (alien-record-field-type field))
+		    ,@(if (alien-record-field-bits field)
+			  (list (alien-record-field-bits field)))))
 		(alien-record-type-fields type)))))
 
 ;;; Test the record fields. The depth is limiting in case of cyclic
@@ -1070,6 +1073,13 @@
 
 ;;;; the FUNCTION and VALUES alien types
 
+;;; not documented in CMU CL:-(
+;;;
+;;; reverse engineering observations:
+;;;   * seems to be set when translating return values
+;;;   * seems to enable the translation of (VALUES), which is the
+;;;     Lisp idiom for C's return type "void" (which is likely
+;;;     why it's set when when translating return values)
 (defvar *values-type-okay* nil)
 
 (define-alien-type-class (fun :include mem-block)
@@ -1078,7 +1088,7 @@
   (stub nil :type (or null function)))
 
 (define-alien-type-translator function (result-type &rest arg-types
-						 &environment env)
+						    &environment env)
   (make-alien-fun-type
    :result-type (let ((*values-type-okay* t))
 		  (parse-alien-type result-type env))
@@ -1130,14 +1140,15 @@
 (def!struct (local-alien-info
 	     (:make-load-form-fun sb!kernel:just-dump-it-normally)
 	     (:constructor make-local-alien-info
-			   (&key type force-to-memory-p)))
+			   (&key type force-to-memory-p
+			    &aux (force-to-memory-p (or force-to-memory-p
+							(alien-array-type-p type)
+							(alien-record-type-p type))))))
   ;; the type of the local alien
   (type (missing-arg) :type alien-type)
   ;; Must this local alien be forced into memory? Using the ADDR macro
   ;; on a local alien will set this.
-  (force-to-memory-p (or (alien-array-type-p type)
-			 (alien-record-type-p type))
-		     :type (member t nil)))
+  (force-to-memory-p nil :type (member t nil)))
 (def!method print-object ((info local-alien-info) stream)
   (print-unreadable-object (info stream :type t)
     (format stream