From: Stas Boukarev <stassats@gmail.com>
Date: Thu, 16 May 2013 17:08:48 +0000 (+0400)
Subject: Add a stub for %other-pointer-p.
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=f3a2cdc53b0e8c329fe56937468931fd84955e26;p=sbcl.git

Add a stub for %other-pointer-p.

Otherwise the VOP isn't translated on literal objects, and
sb-sequence:do-sequence stops working on literal vectors. Having a
stub allows constant folding to work.

Reported by adeht on #lisp.
---

diff --git a/NEWS b/NEWS
index dd2f299..1cb0834 100644
--- a/NEWS
+++ b/NEWS
@@ -34,6 +34,7 @@ changes relative to sbcl-1.1.7:
     threaded FreeBSD/x86-64.
   * bug fix: some LOOP statements couldn't be compiled.
     (lp#1178989)
+  * bug fix: sb-sequence:dosequence works on literal vectors.
   * optimization: faster ISQRT on fixnums and small bignums
   * optimization: faster and smaller INTEGER-LENGTH on fixnums on x86-64.
   * optimization: On x86-64, the number of multi-byte NOP instructions used
diff --git a/src/code/pred.lisp b/src/code/pred.lisp
index 44e6f19..ae1dd7f 100644
--- a/src/code/pred.lisp
+++ b/src/code/pred.lisp
@@ -122,6 +122,7 @@
   (def-type-predicate-wrapper single-float-p)
   (def-type-predicate-wrapper %instancep)
   (def-type-predicate-wrapper symbolp)
+  (def-type-predicate-wrapper %other-pointer-p)
   (def-type-predicate-wrapper system-area-pointer-p)
   (def-type-predicate-wrapper weak-pointer-p)
   #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
diff --git a/src/compiler/generic/vm-fndb.lisp b/src/compiler/generic/vm-fndb.lisp
index 3712e4c..c988c25 100644
--- a/src/compiler/generic/vm-fndb.lisp
+++ b/src/compiler/generic/vm-fndb.lisp
@@ -20,7 +20,7 @@
            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 %other-pointer-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
@@ -64,9 +64,14 @@
            weak-pointer-p code-component-p lra-p
            funcallable-instance-p)
   (t) boolean (movable foldable flushable))
+
 (defknown #.(loop for (name) in *vector-without-complex-typecode-infos*
                   collect name)
-  (t) boolean (movable foldable flushable))
+    (t) boolean (movable foldable flushable))
+
+(defknown %other-pointer-p (t) boolean
+  (movable foldable flushable always-translatable))
+
 
 ;;;; miscellaneous "sub-primitives"