X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Fhost-alieneval.lisp;h=adb9eff281c10bd1a4199504de72b2e4d4b681e8;hb=64bf93a97814ea1caf62bbdcc7ef43e2fbfc8f73;hp=13c4223e46476cf427a77fabcc348803c8786e17;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git diff --git a/src/code/host-alieneval.lisp b/src/code/host-alieneval.lisp index 13c4223..adb9eff 100644 --- a/src/code/host-alieneval.lisp +++ b/src/code/host-alieneval.lisp @@ -11,9 +11,6 @@ ;;;; files for more information. (in-package "SB!ALIEN") - -(file-comment - "$Header$") ;;;; utility functions @@ -64,7 +61,7 @@ (setf (gethash name *alien-type-classes*) (make-alien-type-class :name name :include include))))) -(defconstant method-slot-alist +(defparameter *method-slot-alist* '((:unparse . alien-type-class-unparse) (:type= . alien-type-class-type=) (:subtypep . alien-type-class-subtypep) @@ -79,13 +76,13 @@ (:result-tn . alien-type-class-result-tn))) (defun method-slot (method) - (cdr (or (assoc method method-slot-alist) + (cdr (or (assoc method *method-slot-alist*) (error "no method ~S" method)))) ) ; EVAL-WHEN -;;; We define a keyword "BOA" constructor so that we can reference the slot -;;; names in init forms. +;;; We define a keyword "BOA" constructor so that we can reference the +;;; slot names in init forms. (def!macro def-alien-type-class ((name &key include include-args) &rest slots) (let ((defstruct-name (intern (concatenate 'string "ALIEN-" (symbol-name name) "-TYPE")))) @@ -614,8 +611,8 @@ kind ; Kind of from mapping, :vector or :alist. offset) ; Offset to add to value for :vector from mapping. -(def-alien-type-translator enum (&whole type - name +(def-alien-type-translator enum (&whole + type name &rest mappings &environment env) (cond (mappings @@ -772,7 +769,8 @@ `(sap-ref-double ,sap (/ ,offset sb!vm:byte-bits))) #!+long-float -(def-alien-type-class (long-float :include (float (:bits #!+x86 96 #!+sparc 128)) +(def-alien-type-class (long-float :include (float (:bits #!+x86 96 + #!+sparc 128)) :include-args (type))) #!+long-float @@ -863,10 +861,10 @@ (def-alien-type-translator array (ele-type &rest dims &environment env) (when dims - (unless (typep (first dims) '(or sb!kernel:index null)) + (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 'sb!kernel: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))))