X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-type.lisp;h=665b45367d3b8f73fd3f481367e7681ce133e751;hb=5fdb9edd71a21b3697ba6f407aca270060ef173c;hp=321d0a420ac8c9272b613a25ccce6a85a559e1f7;hpb=0aecc2b20142e08068c3434273500131cb13fe2d;p=sbcl.git

diff --git a/src/code/target-type.lisp b/src/code/target-type.lisp
index 321d0a4..665b453 100644
--- a/src/code/target-type.lisp
+++ b/src/code/target-type.lisp
@@ -125,13 +125,16 @@
          ;; Note: was #.((CLASS-LAYOUT (SB!XC:FIND-CLASS 'NULL))).
          ;; I (WHN 19990209) replaced this with an expression evaluated at
          ;; run time in order to make it easier to build the cross-compiler.
-         ;; If it doesn't work, something else will be needed..
-         (locally
-           ;; KLUDGE: In order to really make this run at run time
-           ;; (instead of doing some weird broken thing at cold load
-           ;; time), we need to suppress a DEFTRANSFORM.. -- WHN 19991004
-           (declare (notinline find-classoid))
-           (classoid-layout (find-classoid 'null))))
+         ;;
+         ;; KLUDGE: Since there's a DEFTRANSFORM for FIND-CLASSOID on
+         ;; constant names which creates non-cold-loadable code, we
+         ;; can't just use (CLASSOID-LAYOUT (FIND-CLASSOID 'NULL))
+         ;; here. The original (WHN 19991004) solution was to locally
+         ;; notinline FIND-CLASSOID. However, the full call to
+         ;; FIND-CLASSOID caused suboptimal register allocation in PCL
+         ;; dfuns. So instead we now use a special variable which is
+         ;; initialized during cold init. -- JES, 2006-07-04
+         *null-classoid-layout*)
         (t (svref *built-in-class-codes* (widetag-of x)))))
 
 #!-sb-fluid (declaim (inline classoid-of))
@@ -140,10 +143,6 @@
   "Return the class of the supplied object, which may be any Lisp object, not
    just a CLOS STANDARD-OBJECT."
   (layout-classoid (layout-of object)))
-
-;;; Pull the type specifier out of a function object.
-(defun extract-fun-type (fun)
-  (specifier-type (%simple-fun-type (%closure-fun fun))))
 
 ;;;; miscellaneous interfaces
 
@@ -179,7 +178,7 @@
     (function
      (if (funcallable-instance-p x)
          (classoid-of x)
-         (extract-fun-type x)))
+         (specifier-type (sb!impl::%fun-type x))))
     (symbol
      (make-member-type :members (list x)))
     (number