0.7.3.1:

[sbcl.git] / src / code / host-alieneval.lisp

diff --git a/src/code/host-alieneval.lisp b/src/code/host-alieneval.lisp
index 712deb3..647dc39 100644 (file)
--- 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 @@
 \f
 ;;;; 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.
@@ -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 @@
 \f
 ;;;; 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)))
@@ -1070,6 +1073,13 @@
 \f
 ;;;; 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