(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))
(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)))
\f
;;;; the ALIEN-VALUE type
(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)
(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)))))
\f
;;; 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)
(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)))
(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
#!+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)))
\f
;;;; 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)))
(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)))
(def-alien-type-translator array (ele-type &rest dims &environment env)
- ;; This declaration is a workaround for bug 119, which causes the
- ;; EVERY #'INTEGERP expression below to be compiled incorrectly
- ;; by the byte compiler. Since as of sbcl-0.pre7.x we are using
- ;; the byte compiler to do all the tricky stuff for the 'interpreter',
- ;; and since we use 'interpreted' definitions of these type translators
- ;; at cross-compilation time, this means that cross-compilation
- ;; doesn't work properly unless we force this function to be
- ;; native compiled instead of byte-compiled.
- ;;
- ;; FIXME: So, when bug 119 is fixed, this declaration can go away.
- (declare (optimize (speed 2))) ; i.e. not byte-compiled
-
(when dims
(unless (typep (first dims) '(or index null))
(error "The first dimension is not a non-negative fixnum or NIL: ~S"
(record-fields-match (alien-record-type-fields type1)
(alien-record-type-fields type2) 0)))
\f
-;;;; 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))
projects / sbcl.git / blobdiff