0.9.5.42:

        The alignment of alien structure fields can be explicitly specified.
	(Patch by Cyrus Harmon on sbcl-devel "[PATCH] optional explicit
        sb-alien struct alignment", 2005-09-30)

diff --git a/NEWS b/NEWS
index 148efa8..2ccc5a0 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -19,6 +19,8 @@ changes in sbcl-0.9.6 relative to sbcl-0.9.5:
   * new feature: ignoring the return values of destructive functions
     like NREVERSE signals a compile-time style-warning.
     (thanks to Kevin Reid)
+  * new feature: the alignment of alien structure fields can be 
+    explicitly specified. (thanks to Cyrus Harmon)
   * threads
     ** bug fix: threads stacks belonging to dead threads are freed by the
        next exiting thread, no need to gc to collect thread stacks anymore

diff --git a/doc/manual/ffi.texinfo b/doc/manual/ffi.texinfo
index 354e659..73871eb 100644 (file)
--- a/doc/manual/ffi.texinfo
+++ b/doc/manual/ffi.texinfo
@@ -196,8 +196,10 @@ variables. Dynamic arrays can only be allocated using
 The foreign type specifier @code{(sb-alien:struct @var{name} &rest
 @var{fields})} describes a structure type with the specified
 @var{name} and @var{fields}. Fields are allocated at the same offsets
-used by the implementation's C compiler. If @var{name} is @code{nil}
-then the structure is anonymous.
+used by the implementation's C compiler, as guessed by the SBCL
+internals. An optional @code{:alignment} keyword argument can be
+specified for each field to explicitly control the alignment of a
+field. If @var{name} is @code{nil} then the structure is anonymous.
 
 If a named foreign @code{struct} specifier is passed to
 @code{define-alien-type} or @code{with-alien}, then this defines,

diff --git a/src/code/host-alieneval.lisp b/src/code/host-alieneval.lisp
index bb0956c..3466981 100644 (file)
--- a/src/code/host-alieneval.lisp
+++ b/src/code/host-alieneval.lisp
@@ -966,14 +966,14 @@
         (overall-alignment 1)
         (parsed-fields nil))
     (dolist (field fields)
-      (destructuring-bind (var type &optional bits) field
-        (declare (ignore bits))
+      (destructuring-bind (var type &key alignment) field
         (let* ((field-type (parse-alien-type type env))
                (bits (alien-type-bits field-type))
-               (alignment (alien-type-alignment field-type))
                (parsed-field
                 (make-alien-record-field :type field-type
                                          :name var)))
+          (unless alignment
+            (setf alignment (alien-type-alignment field-type)))
           (push parsed-field parsed-fields)
           (when (null bits)
             (error "unknown size: ~S" (unparse-alien-type field-type)))

diff --git a/tests/alien.impure.lisp b/tests/alien.impure.lisp
index e215ad2..6c6b002 100644 (file)
--- a/tests/alien.impure.lisp
+++ b/tests/alien.impure.lisp
@@ -136,4 +136,31 @@
                          v)))))
   (assert (typep (funcall f "HOME") '(or string null))))
 
+
+;;; CLH: Test for non-standard alignment in alien structs
+;;;
+(sb-alien:define-alien-type align-test-struct
+    (sb-alien:union align-test-union
+                    (s (sb-alien:struct nil
+                                        (s1 sb-alien:unsigned-char)
+                                        (c1 sb-alien:unsigned-char :alignment 16)
+                                        (c2 sb-alien:unsigned-char :alignment 32)
+                                        (c3 sb-alien:unsigned-char :alignment 32)
+                                        (c4 sb-alien:unsigned-char :alignment 8)))
+                    (u (sb-alien:array sb-alien:unsigned-char 16))))
+
+(let ((a1 (sb-alien:make-alien align-test-struct)))
+  (declare (type (sb-alien:alien (* align-test-struct)) a1))
+  (setf (sb-alien:slot (sb-alien:slot a1 's) 's1) 1)
+  (setf (sb-alien:slot (sb-alien:slot a1 's) 'c1) 21)
+  (setf (sb-alien:slot (sb-alien:slot a1 's) 'c2) 41)
+  (setf (sb-alien:slot (sb-alien:slot a1 's) 'c3) 61)
+  (setf (sb-alien:slot (sb-alien:slot a1 's) 'c4) 81)
+  (assert (equal '(1 21 41 61 81)
+                 (list (sb-alien:deref (sb-alien:slot a1 'u) 0)
+                       (sb-alien:deref (sb-alien:slot a1 'u) 2)
+                       (sb-alien:deref (sb-alien:slot a1 'u) 4)
+                       (sb-alien:deref (sb-alien:slot a1 'u) 8)
+                       (sb-alien:deref (sb-alien:slot a1 'u) 9)))))
+
 ;;; success

diff --git a/version.lisp-expr b/version.lisp-expr
index a613852..d24046b 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.5.41"
+"0.9.5.42"