From: Christophe Rhodes <c.rhodes@gold.ac.uk>
Date: Mon, 30 Sep 2013 16:03:10 +0000 (+0100)
Subject: alter ftype declarations in genesis.lisp
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=1471fe66b2159cf5edbee456a34ee14226db2aaa;p=sbcl.git

alter ftype declarations in genesis.lisp

change (or descriptor symbol) to (or symbol descriptor) to work
around a CCL bug regarding type test elision.
---

diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
index a6b2632..20e1839 100644
--- a/src/compiler/generic/genesis.lisp
+++ b/src/compiler/generic/genesis.lisp
@@ -572,7 +572,7 @@
              *current-reversed-cold-toplevels*)
   (values))
 
-(declaim (ftype (function (descriptor sb!vm:word (or descriptor symbol))) write-wordindexed))
+(declaim (ftype (function (descriptor sb!vm:word (or symbol descriptor))) write-wordindexed))
 (defun write-wordindexed (address index value)
   #!+sb-doc
   "Write VALUE displaced INDEX words from ADDRESS."
@@ -590,7 +590,7 @@
       (setf (bvref-word bytes byte-index)
             (descriptor-bits value)))))
 
-(declaim (ftype (function (descriptor (or descriptor symbol))) write-memory))
+(declaim (ftype (function (descriptor (or symbol descriptor))) write-memory))
 (defun write-memory (address value)
   #!+sb-doc
   "Write VALUE (a DESCRIPTOR) at ADDRESS (also a DESCRIPTOR)."
@@ -846,7 +846,7 @@ core and return a descriptor to it."
 ;;; descriptor of a cold symbol or (in an abbreviation for the
 ;;; most common usage pattern) an ordinary symbol, which will be
 ;;; automatically cold-interned.
-(declaim (ftype (function ((or descriptor symbol) descriptor)) cold-set))
+(declaim (ftype (function ((or symbol descriptor) descriptor)) cold-set))
 (defun cold-set (symbol-or-symbol-des value)
   (let ((symbol-des (etypecase symbol-or-symbol-des
                       (descriptor symbol-or-symbol-des)
@@ -1459,7 +1459,7 @@ core and return a descriptor to it."
 
 ;;; Given a cold representation of a function name, return a warm
 ;;; representation.
-(declaim (ftype (function ((or descriptor symbol)) (or symbol list)) warm-fun-name))
+(declaim (ftype (function ((or symbol descriptor)) (or symbol list)) warm-fun-name))
 (defun warm-fun-name (des)
   (let ((result
          (if (symbolp des)
@@ -1485,7 +1485,7 @@ core and return a descriptor to it."
     result))
 
 (defun cold-fdefinition-object (cold-name &optional leave-fn-raw)
-  (declare (type (or descriptor symbol) cold-name))
+  (declare (type (or symbol descriptor) cold-name))
   (/show0 "/cold-fdefinition-object")
   (let ((warm-name (warm-fun-name cold-name)))
     (or (gethash warm-name *cold-fdefn-objects*)
@@ -1509,7 +1509,7 @@ core and return a descriptor to it."
 ;;; Handle the at-cold-init-time, fset-for-static-linkage operation
 ;;; requested by FOP-FSET.
 (defun static-fset (cold-name defn)
-  (declare (type (or descriptor symbol) cold-name))
+  (declare (type (or symbol descriptor) cold-name))
   (let ((fdefn (cold-fdefinition-object cold-name t))
         (type (logand (descriptor-low (read-memory defn)) sb!vm:widetag-mask)))
     (write-wordindexed fdefn sb!vm:fdefn-fun-slot defn)