1.0.36.40: fix PPC build
authorNikodemus Siivola <nikodemus@random-state.net>
Fri, 26 Mar 2010 12:59:25 +0000 (12:59 +0000)
committerNikodemus Siivola <nikodemus@random-state.net>
Fri, 26 Mar 2010 12:59:25 +0000 (12:59 +0000)
 * Resent unknown-type reparsing changes could result in LVAR-TYPE
   being #<UNKNOWN-TYPE RESTART> but _behaving_ as if it actually was
   #<STRUCTURE-CLASSOID RESTART> -- make PRIMITIVE-TYPE reparse the type
   if appropriate so that the right template can be found.

 * This problem was masked on x86oids as they have %INSTANCE-REF arg
   type *, whereas PPC had INSTANCE.

 Fixes launchpad bug #542894.

src/code/early-type.lisp
src/code/late-type.lisp
src/compiler/generic/primtype.lisp
version.lisp-expr

index 7e419f0..a4160a2 100644 (file)
 (defstruct (unknown-type (:include hairy-type)
                          (:copier nil)))
 
+(defun maybe-reparse-specifier (type)
+  (when (unknown-type-p type)
+    (let* ((spec (unknown-type-specifier type))
+           (name (if (consp spec)
+                     (car spec)
+                     spec)))
+      (when (info :type :kind name)
+        (let ((new-type (specifier-type spec)))
+          (unless (unknown-type-p new-type)
+            new-type))))))
+
+;;; Evil macro.
+(defmacro maybe-reparse-specifier! (type)
+  (assert (symbolp type))
+  (with-unique-names (new-type)
+    `(let ((,new-type (maybe-reparse-specifier ,type)))
+       (when ,new-type
+         (setf ,type ,new-type)
+         t))))
+
 (defstruct (negation-type (:include ctype
                                     (class-info (type-class-or-lose 'negation))
                                     ;; FIXME: is this right?  It's
index 609d33c..3953c54 100644 (file)
 (!define-type-method (hairy :unparse) (x)
   (hairy-type-specifier x))
 
-(defun maybe-specifier-for-reparse (type)
-  (when (unknown-type-p type)
-    (let* ((spec (unknown-type-specifier type))
-           (name (if (consp spec)
-                     (car spec)
-                     spec)))
-      (when (info :type :kind name)
-        spec))))
-
-;;; Evil macro.
-(defmacro maybe-reparse-specifier! (type)
-  (assert (symbolp type))
-  (with-unique-names (spec)
-    `(let ((,spec (maybe-specifier-for-reparse ,type)))
-       (when ,spec
-         (setf ,type (specifier-type ,spec))
-         t))))
-
 (!define-type-method (hairy :simple-subtypep) (type1 type2)
   (let ((hairy-spec1 (hairy-type-specifier type1))
         (hairy-spec2 (hairy-type-specifier type2)))
     (cond ((equal-but-no-car-recursion hairy-spec1 hairy-spec2)
            (values t t))
           ((maybe-reparse-specifier! type1)
-           (if (unknown-type-p type1)
-               (values nil nil)
-               (csubtypep type1 type2)))
+           (csubtypep type1 type2))
           ((maybe-reparse-specifier! type2)
-           (if (unknown-type-p type2)
-               (values nil nil)
-               (csubtypep type1 type2)))
+           (csubtypep type1 type2))
           (t
            (values nil nil)))))
 
 (!define-type-method (hairy :complex-subtypep-arg2) (type1 type2)
   (if (maybe-reparse-specifier! type2)
-      (if (unknown-type-p type2)
-          (values nil nil)
-          (csubtypep type1 type2))
+      (csubtypep type1 type2)
       (let ((specifier (hairy-type-specifier type2)))
         (cond ((and (consp specifier) (eql (car specifier) 'satisfies))
                (case (cadr specifier)
 
 (!define-type-method (hairy :complex-subtypep-arg1) (type1 type2)
   (if (maybe-reparse-specifier! type1)
-      (if (unknown-type-p type1)
-          (values nil nil)
-          (csubtypep type1 type2))
+      (csubtypep type1 type2)
       (values nil nil)))
 
 (!define-type-method (hairy :complex-=) (type1 type2)
   (if (maybe-reparse-specifier! type2)
-      (if (unknown-type-p type2)
-          (values nil nil)
-          (type= type1 type2))
+      (type= type1 type2)
       (values nil nil)))
 
 (!define-type-method (hairy :simple-intersection2 :complex-intersection2)
index 2b5e2c6..43c5e26 100644 (file)
 ;;; !DEF-VM-SUPPORT-ROUTINE and DEFUN-CACHED.
 (/show0 "primtype.lisp 188")
 (!def-vm-support-routine primitive-type (type)
+  (sb!kernel::maybe-reparse-specifier! type)
   (primitive-type-aux type))
 (/show0 "primtype.lisp 191")
 (defun-cached (primitive-type-aux
index ec8196d..913dbd2 100644 (file)
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.36.39"
+"1.0.36.40"