From af6137c3d8580b3e939e6f78eadfbf41015b9668 Mon Sep 17 00:00:00 2001
From: Stas Boukarev <stassats@gmail.com>
Date: Thu, 3 Oct 2013 04:13:03 +0400
Subject: [PATCH] Optimize the compiler a bit.

Optimize make-values-type-cached by adding a declaration or two.
Building SBCL sans contribs goes from 1:52 to 1:39.
---
 contrib/sb-bsd-sockets/name-service.lisp |    2 +-
 src/code/early-extensions.lisp           |   14 +++++++-------
 src/code/early-type.lisp                 |    4 +++-
 src/code/typedefs.lisp                   |   12 ++++++------
 4 files changed, 17 insertions(+), 15 deletions(-)

diff --git a/contrib/sb-bsd-sockets/name-service.lisp b/contrib/sb-bsd-sockets/name-service.lisp
index 51c1c82..bf7c37d 100644
--- a/contrib/sb-bsd-sockets/name-service.lisp
+++ b/contrib/sb-bsd-sockets/name-service.lisp
@@ -97,7 +97,7 @@ weird stuff - see gethostbyname(3) or getaddrinfo(3) for the details."
 
 #+sb-bsd-sockets-addrinfo
 (declaim (inline get-address-info))
-#+sb-bsd-sockets-addrinfo 
+#+sb-bsd-sockets-addrinfo
 (defun get-address-info (node)
   (declare (optimize speed))
   (sb-alien:with-alien ((info (* sockint::addrinfo)))
diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp
index 577d3c3..dd7742e 100644
--- a/src/code/early-extensions.lisp
+++ b/src/code/early-extensions.lisp
@@ -715,13 +715,13 @@
 ;;; our equality tests, because MEMBER and friends refer to EQLity.
 ;;; So:
 (defun equal-but-no-car-recursion (x y)
-  (cond
-    ((eql x y) t)
-    ((consp x)
-     (and (consp y)
-          (eql (car x) (car y))
-          (equal-but-no-car-recursion (cdr x) (cdr y))))
-    (t nil)))
+  (do () (())
+    (cond ((eql x y) (return t))
+          ((and (consp x)
+                (consp y)
+                (eql (pop x) (pop y))))
+          (t
+           (return)))))
 
 ;;;; package idioms
 
diff --git a/src/code/early-type.lisp b/src/code/early-type.lisp
index 20f1642..c5cacb3 100644
--- a/src/code/early-type.lisp
+++ b/src/code/early-type.lisp
@@ -151,7 +151,9 @@
                                          (if rest
                                              (type-hash-value rest)
                                              42)
-                                         (sxhash allowp))
+                                         (if allowp
+                                             #.(logand #xFF (sxhash t))
+                                             #.(logand #xFF (sxhash nil))))
                                         #xFF)))
     ((required equal-but-no-car-recursion)
      (optional equal-but-no-car-recursion)
diff --git a/src/code/typedefs.lisp b/src/code/typedefs.lisp
index e8480f1..e652fc4 100644
--- a/src/code/typedefs.lisp
+++ b/src/code/typedefs.lisp
@@ -140,12 +140,12 @@
 #!-sb-fluid (declaim (inline type-list-cache-hash))
 (declaim (ftype (function (list) (unsigned-byte 8)) type-list-cache-hash))
 (defun type-list-cache-hash (types)
-  (logand (loop with res = 0
-             for type in types
-             for hash = (type-hash-value type)
-             do (setq res (logxor res hash))
-             finally (return res))
-          #xFF))
+  (logand #xFF
+          (loop with res fixnum = 0
+                for type in types
+                for hash = (type-hash-value type)
+                do (setq res (logxor res hash))
+                finally (return res))))
 
 ;;;; cold loading initializations
 
-- 
1.7.10.4