X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fpred.lisp;h=27158cfbc17f1e18582bd6d66440411e0090e0cc;hb=dcb73f3edef1e31078fbe585e2fafbd26743efd7;hp=a3d18bd692c7a0052f0f6e97d0cb9e684e513f3e;hpb=3ceaa081c90a970f6779e02bed659835a202772c;p=sbcl.git diff --git a/src/code/pred.lisp b/src/code/pred.lisp index a3d18bd..27158cf 100644 --- a/src/code/pred.lisp +++ b/src/code/pred.lisp @@ -21,7 +21,8 @@ (defun vector-t-p (x) (or (simple-vector-p x) (and (complex-vector-p x) - (simple-vector-p (%array-data-vector x))))) + (do ((data (%array-data-vector x) (%array-data-vector data))) + ((not (array-header-p data)) (simple-vector-p data)))))) ;;;; primitive predicates. These must be supported directly by the ;;;; compiler. @@ -73,6 +74,8 @@ (def-type-predicate-wrapper integerp) (def-type-predicate-wrapper listp) (def-type-predicate-wrapper long-float-p) + #!+(and sb-thread sb-lutex) + (def-type-predicate-wrapper lutexp) (def-type-predicate-wrapper lra-p) (def-type-predicate-wrapper null) (def-type-predicate-wrapper numberp) @@ -93,8 +96,14 @@ (def-type-predicate-wrapper system-area-pointer-p) (def-type-predicate-wrapper weak-pointer-p) (def-type-predicate-wrapper vectorp) + #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) (def-type-predicate-wrapper unsigned-byte-32-p) + #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or)) (def-type-predicate-wrapper signed-byte-32-p) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + (def-type-predicate-wrapper unsigned-byte-64-p) + #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or)) + (def-type-predicate-wrapper signed-byte-64-p) (def-type-predicate-wrapper simple-array-nil-p) (def-type-predicate-wrapper simple-array-unsigned-byte-2-p) (def-type-predicate-wrapper simple-array-unsigned-byte-4-p) @@ -212,10 +221,12 @@ (defun equal (x y) #!+sb-doc - "Return T if X and Y are EQL or if they are structured components - whose elements are EQUAL. Strings and bit-vectors are EQUAL if they - are the same length and have identical components. Other arrays must be - EQ to be EQUAL." + "Return T if X and Y are EQL or if they are structured components whose +elements are EQUAL. Strings and bit-vectors are EQUAL if they are the same +length and have identical components. Other arrays must be EQ to be EQUAL." + ;; Non-tail self-recursion implemented with a local auxiliary function + ;; is a lot faster than doing it the straightforward way (at least + ;; on x86oids) due to calling convention differences. -- JES, 2005-12-30 (labels ((equal-aux (x y) (cond ((%eql x y) t) @@ -231,6 +242,8 @@ (and (bit-vector-p y) (bit-vector-= x y))) (t nil)))) + ;; Use MAYBE-INLINE to get the inline expansion only once (instead + ;; of 200 times with INLINE). -- JES, 2005-12-30 (declare (maybe-inline equal-aux)) (equal-aux x y)))