From 09120f07344932375511dd6239ea809a6e444554 Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Tue, 11 Oct 2005 20:21:16 +0000 Subject: [PATCH] 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) --- NEWS | 2 ++ doc/manual/ffi.texinfo | 6 ++++-- src/code/host-alieneval.lisp | 6 +++--- tests/alien.impure.lisp | 27 +++++++++++++++++++++++++++ version.lisp-expr | 2 +- 5 files changed, 37 insertions(+), 6 deletions(-) diff --git a/NEWS b/NEWS index 148efa8..2ccc5a0 100644 --- 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 --- 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 --- 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 --- 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 --- 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" -- 1.7.10.4