X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fhost-alieneval.lisp;h=0a263e11fa5a7f5eb9621609dc839ff3b1c2b67b;hb=5edd74f6911093805a009a152b32216b3dba59f7;hp=7d525877a084bb7865c1a6199eab49164b1f8e94;hpb=e33fb894f991b2926d8f3bace9058e4c0b2c3a37;p=sbcl.git diff --git a/src/code/host-alieneval.lisp b/src/code/host-alieneval.lisp index 7d52587..0a263e1 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) @@ -593,7 +593,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 +673,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 +706,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 +738,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 +748,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,7 +759,7 @@ `(sap-ref-double ,sap (/ ,offset sb!vm:n-byte-bits))) #!+long-float -(define-alien-type-class (long-float :include (float (:bits #!+x86 96 +(define-alien-type-class (long-float :include (float (bits #!+x86 96 #!+sparc 128)) :include-args (type))) @@ -774,7 +774,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 +856,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 +999,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 +1070,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 +1085,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))