X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fhost-alieneval.lisp;h=a550ffed5d90a5900d825b4b28f56ab974d70092;hb=50305b602c3953440af716137a56f50cd204375d;hp=b380b605530e3e636e206c98b42aae65bece32d5;hpb=f774359565ca753df2e64671613994f6ac568cfe;p=sbcl.git diff --git a/src/code/host-alieneval.lisp b/src/code/host-alieneval.lisp index b380b60..a550ffe 100644 --- a/src/code/host-alieneval.lisp +++ b/src/code/host-alieneval.lisp @@ -332,7 +332,7 @@ (def-alien-type-translator system-area-pointer () (make-alien-system-area-pointer-type - :bits #!-alpha sb!vm:word-bits #!+alpha 64)) + :bits #!-alpha sb!vm:n-word-bits #!+alpha 64)) (def-alien-type-method (system-area-pointer :unparse) (type) (declare (ignore type)) @@ -357,7 +357,7 @@ (def-alien-type-method (system-area-pointer :extract-gen) (type sap offset) (declare (ignore type)) - `(sap-ref-sap ,sap (/ ,offset sb!vm:byte-bits))) + `(sap-ref-sap ,sap (/ ,offset sb!vm:n-byte-bits))) ;;;; the ALIEN-VALUE type @@ -509,13 +509,13 @@ (def-alien-type-class (integer) (signed t :type (member t nil))) -(def-alien-type-translator signed (&optional (bits sb!vm:word-bits)) +(def-alien-type-translator signed (&optional (bits sb!vm:n-word-bits)) (make-alien-integer-type :bits bits)) -(def-alien-type-translator integer (&optional (bits sb!vm:word-bits)) +(def-alien-type-translator integer (&optional (bits sb!vm:n-word-bits)) (make-alien-integer-type :bits bits)) -(def-alien-type-translator unsigned (&optional (bits sb!vm:word-bits)) +(def-alien-type-translator unsigned (&optional (bits sb!vm:n-word-bits)) (make-alien-integer-type :bits bits :signed nil)) (def-alien-type-method (integer :unparse) (type) @@ -559,7 +559,7 @@ (32 'sap-ref-32) #!+alpha (64 'sap-ref-64))))) (if ref-fun - `(,ref-fun ,sap (/ ,offset sb!vm:byte-bits)) + `(,ref-fun ,sap (/ ,offset sb!vm:n-byte-bits)) (error "cannot extract ~D bit integers" (alien-integer-type-bits type))))) @@ -569,7 +569,7 @@ ;;; FIXME: Check to make sure that we aren't attaching user-readable ;;; stuff to CL:BOOLEAN in any way which impairs ANSI compliance. -(def-alien-type-translator boolean (&optional (bits sb!vm:word-bits)) +(def-alien-type-translator boolean (&optional (bits sb!vm:n-word-bits)) (make-alien-boolean-type :bits bits :signed nil)) (def-alien-type-method (boolean :unparse) (type) @@ -742,7 +742,7 @@ (def-alien-type-method (single-float :extract-gen) (type sap offset) (declare (ignore type)) - `(sap-ref-single ,sap (/ ,offset sb!vm:byte-bits))) + `(sap-ref-single ,sap (/ ,offset sb!vm:n-byte-bits))) (def-alien-type-class (double-float :include (float (:bits 64)) :include-args (type))) @@ -752,7 +752,7 @@ (def-alien-type-method (double-float :extract-gen) (type sap offset) (declare (ignore type)) - `(sap-ref-double ,sap (/ ,offset sb!vm:byte-bits))) + `(sap-ref-double ,sap (/ ,offset sb!vm:n-byte-bits))) #!+long-float (def-alien-type-class (long-float :include (float (:bits #!+x86 96 @@ -766,12 +766,13 @@ #!+long-float (def-alien-type-method (long-float :extract-gen) (type sap offset) (declare (ignore type)) - `(sap-ref-long ,sap (/ ,offset sb!vm:byte-bits))) + `(sap-ref-long ,sap (/ ,offset sb!vm:n-byte-bits))) ;;;; the POINTER type (def-alien-type-class (pointer :include (alien-value (:bits - #!-alpha sb!vm:word-bits + #!-alpha + sb!vm:n-word-bits #!+alpha 64))) (to nil :type (or alien-type null))) @@ -831,7 +832,7 @@ (def-alien-type-method (mem-block :extract-gen) (type sap offset) (declare (ignore type)) - `(sap+ ,sap (/ ,offset sb!vm:byte-bits))) + `(sap+ ,sap (/ ,offset sb!vm:n-byte-bits))) (def-alien-type-method (mem-block :deposit-gen) (type sap offset value) (let ((bits (alien-mem-block-type-bits type))) @@ -846,6 +847,7 @@ (dimensions (required-argument) :type list)) (def-alien-type-translator array (ele-type &rest dims &environment env) + (when dims (unless (typep (first dims) '(or index null)) (error "The first dimension is not a non-negative fixnum or NIL: ~S" @@ -1062,36 +1064,36 @@ (record-fields-match (alien-record-type-fields type1) (alien-record-type-fields type2) 0))) -;;;; the FUNCTION and VALUES types +;;;; the FUNCTION and VALUES alien types (defvar *values-type-okay* nil) -(def-alien-type-class (function :include mem-block) +(def-alien-type-class (fun :include mem-block) (result-type (required-argument) :type alien-type) (arg-types (required-argument) :type list) (stub nil :type (or null function))) (def-alien-type-translator function (result-type &rest arg-types &environment env) - (make-alien-function-type + (make-alien-fun-type :result-type (let ((*values-type-okay* t)) (parse-alien-type result-type env)) :arg-types (mapcar (lambda (arg-type) (parse-alien-type arg-type env)) arg-types))) -(def-alien-type-method (function :unparse) (type) - `(function ,(%unparse-alien-type (alien-function-type-result-type type)) +(def-alien-type-method (fun :unparse) (type) + `(function ,(%unparse-alien-type (alien-fun-type-result-type type)) ,@(mapcar #'%unparse-alien-type - (alien-function-type-arg-types type)))) + (alien-fun-type-arg-types type)))) -(def-alien-type-method (function :type=) (type1 type2) - (and (alien-type-= (alien-function-type-result-type type1) - (alien-function-type-result-type type2)) - (= (length (alien-function-type-arg-types type1)) - (length (alien-function-type-arg-types type2))) +(def-alien-type-method (fun :type=) (type1 type2) + (and (alien-type-= (alien-fun-type-result-type type1) + (alien-fun-type-result-type type2)) + (= (length (alien-fun-type-arg-types type1)) + (length (alien-fun-type-arg-types type2))) (every #'alien-type-= - (alien-function-type-arg-types type1) - (alien-function-type-arg-types type2)))) + (alien-fun-type-arg-types type1) + (alien-fun-type-arg-types type2)))) (def-alien-type-class (values) (values (required-argument) :type list))