From af6137c3d8580b3e939e6f78eadfbf41015b9668 Mon Sep 17 00:00:00 2001 From: Stas Boukarev 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