From: Christophe Rhodes 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)