;;; Simple TYPEP uses that don't have any standard predicate are
;;; translated into non-standard unary predicates.
(defknown (fixnump bignump ratiop
- short-float-p single-float-p double-float-p long-float-p
- complex-rational-p complex-float-p complex-single-float-p
- complex-double-float-p #!+long-float complex-long-float-p
- complex-vector-p
- base-char-p %standard-char-p %instancep
- base-string-p simple-base-string-p
- array-header-p
- simple-array-p simple-array-nil-p vector-nil-p
- simple-array-unsigned-byte-2-p
- simple-array-unsigned-byte-4-p simple-array-unsigned-byte-7-p
- simple-array-unsigned-byte-8-p simple-array-unsigned-byte-15-p
- simple-array-unsigned-byte-16-p
+ short-float-p single-float-p double-float-p long-float-p
+ complex-rational-p complex-float-p complex-single-float-p
+ complex-double-float-p #!+long-float complex-long-float-p
+ complex-vector-p
+ base-char-p %standard-char-p %instancep
+ base-string-p simple-base-string-p
+ #!+sb-unicode character-string-p
+ #!+sb-unicode simple-character-string-p
+ array-header-p
+ simple-array-p simple-array-nil-p vector-nil-p
+ simple-array-unsigned-byte-2-p
+ simple-array-unsigned-byte-4-p simple-array-unsigned-byte-7-p
+ simple-array-unsigned-byte-8-p simple-array-unsigned-byte-15-p
+ simple-array-unsigned-byte-16-p
#!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
simple-array-unsigned-byte-29-p
- simple-array-unsigned-byte-31-p
- simple-array-unsigned-byte-32-p
+ simple-array-unsigned-byte-31-p
+ simple-array-unsigned-byte-32-p
#!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
simple-array-unsigned-byte-60-p
#!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
simple-array-unsigned-byte-63-p
#!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
simple-array-unsigned-byte-64-p
- simple-array-signed-byte-8-p simple-array-signed-byte-16-p
+ simple-array-signed-byte-8-p simple-array-signed-byte-16-p
#!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
- simple-array-signed-byte-30-p
+ simple-array-signed-byte-30-p
simple-array-signed-byte-32-p
#!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
simple-array-signed-byte-61-p
#!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
simple-array-signed-byte-64-p
- simple-array-single-float-p simple-array-double-float-p
- #!+long-float simple-array-long-float-p
- simple-array-complex-single-float-p
- simple-array-complex-double-float-p
- #!+long-float simple-array-complex-long-float-p
- system-area-pointer-p realp
- #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
+ simple-array-single-float-p simple-array-double-float-p
+ #!+long-float simple-array-long-float-p
+ simple-array-complex-single-float-p
+ simple-array-complex-double-float-p
+ #!+long-float simple-array-complex-long-float-p
+ system-area-pointer-p realp
+ ;; #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
unsigned-byte-32-p
- #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
+ ;; #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
signed-byte-32-p
#!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
unsigned-byte-64-p
#!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
signed-byte-64-p
- vector-t-p weak-pointer-p code-component-p lra-p
- funcallable-instance-p)
+ vector-t-p weak-pointer-p code-component-p lra-p
+ funcallable-instance-p)
(t) boolean (movable foldable flushable))
\f
;;;; miscellaneous "sub-primitives"
(unsafe))
(defknown %layout-invalid-error (t layout) nil)
+(defknown %raw-instance-ref/word (instance index) sb!vm:word
+ (flushable))
+(defknown %raw-instance-set/word (instance index sb!vm:word) sb!vm:word
+ (unsafe))
+(defknown %raw-instance-ref/single (instance index) single-float
+ (flushable))
+(defknown %raw-instance-set/single (instance index single-float) single-float
+ (unsafe))
+(defknown %raw-instance-ref/double (instance index) double-float
+ (flushable))
+(defknown %raw-instance-set/double (instance index double-float) double-float
+ (unsafe))
+(defknown %raw-instance-ref/complex-single (instance index)
+ (complex single-float)
+ (flushable))
+(defknown %raw-instance-set/complex-single
+ (instance index (complex single-float))
+ (complex single-float)
+ (unsafe))
+(defknown %raw-instance-ref/complex-double (instance index)
+ (complex double-float)
+ (flushable))
+(defknown %raw-instance-set/complex-double
+ (instance index (complex double-float))
+ (complex double-float)
+ (unsafe))
(sb!xc:deftype raw-vector () '(simple-array sb!vm:word (*)))
(foldable flushable))
(defknown (%set-raw-bits) (t fixnum sb!vm:word) sb!vm:word
(unsafe))
+;; These two are mostly used for bit-bashing operations.
+(defknown %vector-raw-bits (t fixnum) sb!vm:word
+ (foldable flushable))
+(defknown (%set-vector-raw-bits) (t fixnum sb!vm:word) sb!vm:word
+ (unsafe))
(defknown allocate-vector ((unsigned-byte 8) index index) (simple-array * (*))
(flushable movable))
(defknown (dynamic-space-free-pointer binding-stack-pointer-sap
- control-stack-pointer-sap) ()
+ control-stack-pointer-sap) ()
system-area-pointer
(flushable))
\f
(foldable flushable movable))
(defknown (word-logical-and word-logical-nand
- word-logical-or word-logical-nor
- word-logical-xor word-logical-eqv
- word-logical-andc1 word-logical-andc2
- word-logical-orc1 word-logical-orc2)
- (sb!vm:word sb!vm:word) sb!vm:word
+ word-logical-or word-logical-nor
+ word-logical-xor word-logical-eqv
+ word-logical-andc1 word-logical-andc2
+ word-logical-orc1 word-logical-orc2)
+ (sb!vm:word sb!vm:word) sb!vm:word
(foldable flushable movable))
(defknown (shift-towards-start shift-towards-end) (sb!vm:word fixnum)
(foldable flushable movable))
(defknown (%add-with-carry %subtract-with-borrow)
- (bignum-element-type bignum-element-type (mod 2))
+ (bignum-element-type bignum-element-type (mod 2))
(values bignum-element-type (mod 2))
(foldable flushable movable))
(defknown %multiply-and-add
- (bignum-element-type bignum-element-type bignum-element-type
- &optional bignum-element-type)
+ (bignum-element-type bignum-element-type bignum-element-type
+ &optional bignum-element-type)
(values bignum-element-type bignum-element-type)
(foldable flushable movable))
(foldable flushable movable))
(defknown (%ashl %ashr %digit-logical-shift-right)
- (bignum-element-type (mod #.sb!vm:n-word-bits)) bignum-element-type
+ (bignum-element-type (mod #.sb!vm:n-word-bits)) bignum-element-type
(foldable flushable movable))
\f
;;;; bit-bashing routines
-(defknown copy-to-system-area
- ((simple-unboxed-array (*)) index system-area-pointer index index)
- (values)
- ())
-
-(defknown copy-from-system-area
- (system-area-pointer index (simple-unboxed-array (*)) index index)
- (values)
- ())
-
-(defknown system-area-copy
- (system-area-pointer index system-area-pointer index index)
- (values)
- ())
-
-(defknown bit-bash-copy
- ((simple-unboxed-array (*)) index
- (simple-unboxed-array (*)) index index)
- (values)
- ())
+;;; FIXME: there's some ugly duplication between the (INTERN (FORMAT ...))
+;;; magic here and the same magic in src/code/bit-bash.lisp. I don't know
+;;; of any good way to clean it up, but it's definitely violating OAOO.
+(macrolet ((define-known-copiers ()
+ `(progn
+ ,@(loop for i = 1 then (* i 2)
+ collect `(defknown ,(intern (format nil "UB~D-BASH-COPY" i)
+ (find-package "SB!KERNEL"))
+ ((simple-unboxed-array (*)) index (simple-unboxed-array (*)) index index)
+ (values)
+ ())
+ collect `(defknown ,(intern (format nil "SYSTEM-AREA-UB~D-COPY" i)
+ (find-package "SB!KERNEL"))
+ (system-area-pointer index system-area-pointer index index)
+ (values)
+ ())
+ collect `(defknown ,(intern (format nil "COPY-UB~D-TO-SYSTEM-AREA" i)
+ (find-package "SB!KERNEL"))
+ ((simple-unboxed-array (*)) index system-area-pointer index index)
+ (values)
+ ())
+ collect `(defknown ,(intern (format nil "COPY-UB~D-FROM-SYSTEM-AREA" i)
+ (find-package "SB!KERNEL"))
+ (system-area-pointer index (simple-unboxed-array (*)) index index)
+ (values)
+ ())
+ until (= i sb!vm:n-word-bits)))))
+ (define-known-copiers))
;;; (not really a bit-bashing routine, but starting to take over from
;;; bit-bashing routines in byte-sized copies as of sbcl-0.6.12.29:)
(defknown fun-subtype (function) (unsigned-byte #.sb!vm:n-widetag-bits)
(flushable))
(defknown ((setf fun-subtype))
- ((unsigned-byte #.sb!vm:n-widetag-bits) function)
+ ((unsigned-byte #.sb!vm:n-widetag-bits) function)
(unsigned-byte #.sb!vm:n-widetag-bits)
())
(defknown %data-vector-and-index (array index)
(values (simple-array * (*)) index)
- (foldable flushable))
+ (foldable flushable))