From 1cae060fd9735f9c1f63538969e68c99b48f46e6 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Thu, 9 Dec 2004 16:15:57 +0000 Subject: [PATCH] 0.8.17.27: Improve ENUM support a little. (VJA sbcl-devel 2004-12-09) ... SB-ALIEN enums not limited to symbols any more; ... SB-GROVEL enum grovelation; ... tests (which pass despite the current, erm, suboptimality of arithmetic :) --- NEWS | 2 ++ contrib/sb-grovel/def-to-lisp.lisp | 15 +++++++++++++++ contrib/sb-grovel/sb-grovel.texinfo | 10 ++++++++++ doc/manual/ffi.texinfo | 4 ++-- src/code/host-alieneval.lisp | 10 +++++----- tests/alien.impure.lisp | 21 +++++++++++++++++++++ version.lisp-expr | 2 +- 7 files changed, 56 insertions(+), 8 deletions(-) diff --git a/NEWS b/NEWS index e7a6a05..4e93d5a 100644 --- a/NEWS +++ b/NEWS @@ -7,6 +7,8 @@ changes in sbcl-0.8.18 relative to sbcl-0.8.17: available at runtime. * Solaris 10 (aka SunOS 5.10) on the SPARC platform is now supported. (thanks to Dan Debertin) + * SB-ALIEN enums can now be represented in Lisp by any symbols, not + just keywords. (thanks to Vincent Arkesteijn) * fixed bug #331: structure-class instances corresponding to DEFSTRUCT forms are now created eagerly. * fixed bug #345: backtraces from calls to undefined functions work diff --git a/contrib/sb-grovel/def-to-lisp.lisp b/contrib/sb-grovel/def-to-lisp.lisp index 01ff4d6..b39ff5e 100644 --- a/contrib/sb-grovel/def-to-lisp.lisp +++ b/contrib/sb-grovel/def-to-lisp.lisp @@ -37,6 +37,19 @@ code: (c-escape formatter) args))) +(defun c-for-enum (lispname elements export) + (printf "(cl:eval-when (:compile-toplevel :load-toplevel :execute) (sb-alien:define-alien-type ~A (sb-alien:enum nil" lispname) + (dolist (element elements) + (destructuring-bind (lisp-element-name c-element-name) element + (printf " (~S %d)" lisp-element-name c-element-name))) + (printf ")))") + (when export + (dolist (element elements) + (destructuring-bind (lisp-element-name c-element-name) element + (declare (ignore c-element-name)) + (unless (keywordp lisp-element-name) + (printf "(export '~S)" lisp-element-name)))))) + (defun c-for-structure (lispname cstruct) (destructuring-bind (cname &rest elements) cstruct (printf "(cl:eval-when (:compile-toplevel :load-toplevel :execute) (sb-grovel::define-c-struct ~A %d" lispname @@ -87,6 +100,8 @@ code: (as-c "#else") (printf "(sb-int:style-warn \"Couldn't grovel for ~A (unknown to the C compiler).\")" cname) (as-c "#endif")) + (:enum + (c-for-enum lispname cname export)) (:type (printf "(cl:eval-when (:compile-toplevel :load-toplevel :execute) (sb-alien:define-alien-type ~A (sb-alien:%ssigned %d)))" lispname (format nil "SIGNED_(~A)" cname) diff --git a/contrib/sb-grovel/sb-grovel.texinfo b/contrib/sb-grovel/sb-grovel.texinfo index ccb6fd2..8c7b0aa 100644 --- a/contrib/sb-grovel/sb-grovel.texinfo +++ b/contrib/sb-grovel/sb-grovel.texinfo @@ -112,6 +112,16 @@ Here's how to use the grovel clauses: other forms are possible. @item +@code{:enum} +@lisp + (:enum lisp-type-name ((lisp-enumerated-name c-enumerated-name) ...))) +@end lisp + +An @code{sb-alien:enum} type with name @code{lisp-type-name} will be defined. +The symbols are the @code{lisp-enumerated-name}s, and the values +are grovelled from the @code{c-enumerated-name}s. + +@item @code{:structure} - alien structure definitions look like this: @lisp (:structure lisp-struct-name ("struct c_structure" diff --git a/doc/manual/ffi.texinfo b/doc/manual/ffi.texinfo index 80e6a59..c8bc8d5 100644 --- a/doc/manual/ffi.texinfo +++ b/doc/manual/ffi.texinfo @@ -216,9 +216,9 @@ determine which field is active from context. @item The foreign type specifier @code{(sb-alien:enum @var{name} &rest @var{specs})} describes an enumeration type that maps between integer -values and keywords. If @var{name} is @code{nil}, then the type is +values and symbols. If @var{name} is @code{nil}, then the type is anonymous. Each element of the @var{specs} list is either a Lisp -keyword, or a list @code{(@var{keyword} @var{value})}. @var{value} is +symbol, or a list @code{(@var{symbol} @var{value})}. @var{value} is an integer. If @var{value} is not supplied, then it defaults to one greater than the value for the preceding spec (or to zero if it is the first spec). diff --git a/src/code/host-alieneval.lisp b/src/code/host-alieneval.lisp index bd3ad14..e1c2488 100644 --- a/src/code/host-alieneval.lisp +++ b/src/code/host-alieneval.lisp @@ -607,8 +607,8 @@ (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 - to ; alist or vector from integers to keywords + from ; alist from symbols to integers + to ; alist or vector from integers to symbols kind ; kind of from mapping, :VECTOR or :ALIST offset) ; offset to add to value for :VECTOR from mapping @@ -649,8 +649,8 @@ (values (first el) (second el)) (values el (1+ prev))) (setf prev val) - (unless (keywordp sym) - (error "The enumeration element ~S is not a keyword." sym)) + (unless (symbolp sym) + (error "The enumeration element ~S is not a symbol." sym)) (unless (integerp val) (error "The element value ~S is not an integer." val)) (unless (and max (> max val)) (setq max val)) @@ -718,7 +718,7 @@ (:alist `(ecase ,alien ,@(mapcar (lambda (mapping) - `(,(car mapping) ,(cdr mapping))) + `(,(car mapping) ',(cdr mapping))) (alien-enum-type-to type)))))) (define-alien-type-method (enum :deport-gen) (type value) diff --git a/tests/alien.impure.lisp b/tests/alien.impure.lisp index 536acf3..6cd9807 100644 --- a/tests/alien.impure.lisp +++ b/tests/alien.impure.lisp @@ -94,5 +94,26 @@ ;;; reported on sbcl-help 2004-11-16 by John Morrison (define-alien-type enum.1 (enum nil (:val0 0))) +(define-alien-type enum.2 (enum nil (zero 0) (one 1) (two 2) (three 3) + (four 4) (five 5) (six 6) (seven 7) + (eight 8) (nine 9))) +(with-alien ((integer-array (array integer 3))) + (let ((enum-array (cast integer-array (array enum.2 3)))) + (setf (deref enum-array 0) 'three + (deref enum-array 1) 'four) + (setf (deref integer-array 2) (+ (deref integer-array 0) + (deref integer-array 1))) + (assert (eql (deref enum-array 2) 'seven)))) +;; The code that is used for mapping from integers to symbols depends on the +;; `density' of the set of used integers, so test with a sparse set as well. +(define-alien-type enum.3 (enum nil (zero 0) (one 1) (k-one 1001) (k-two 1002))) +(with-alien ((integer-array (array integer 3))) + (let ((enum-array (cast integer-array (array enum.3 3)))) + (setf (deref enum-array 0) 'one + (deref enum-array 1) 'k-one) + (setf (deref integer-array 2) (+ (deref integer-array 0) + (deref integer-array 1))) + (assert (eql (deref enum-array 2) 'k-two)))) + ;;; success (quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index 4c11e51..673838c 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.8.17.26" +"0.8.17.27" -- 1.7.10.4