summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNikodemus Siivola <nikodemus@random-state.net>2010-03-26 12:59:25 +0000
committerNikodemus Siivola <nikodemus@random-state.net>2010-03-26 12:59:25 +0000
commit8258b3ef68a2ce4529c4c62e54ad2035193c1a53 (patch)
tree4dc5934d90ca3f1cda78611d368ac52d9223a2eb
parent0cfd289365b37a66fd4108054f0d99e95d396a8a (diff)
1.0.36.40: fix PPC build
* 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.
-rw-r--r--src/code/early-type.lisp20
-rw-r--r--src/code/late-type.lisp38
-rw-r--r--src/compiler/generic/primtype.lisp1
-rw-r--r--version.lisp-expr2
4 files changed, 27 insertions, 34 deletions
diff --git a/src/code/early-type.lisp b/src/code/early-type.lisp
index 7e419f0ab..a4160a278 100644
--- a/src/code/early-type.lisp
+++ b/src/code/early-type.lisp
@@ -34,6 +34,26 @@
(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
diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index 609d33c7b..3953c543a 100644
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -1373,45 +1373,21 @@
(!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)
@@ -1424,16 +1400,12 @@
(!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)
diff --git a/src/compiler/generic/primtype.lisp b/src/compiler/generic/primtype.lisp
index 2b5e2c604..43c5e26f3 100644
--- a/src/compiler/generic/primtype.lisp
+++ b/src/compiler/generic/primtype.lisp
@@ -143,6 +143,7 @@
;;; !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
diff --git a/version.lisp-expr b/version.lisp-expr
index ec8196d74..913dbd24f 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -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"