0.9.3.33

      Add source transform for GET to eliminate hairy arg processing overhead.
      Cache CLASS-INFO-OR-LOSE using the property list of the class name.
       speeding up the function by a factor of about 3.

diff --git a/src/code/symbol.lisp b/src/code/symbol.lisp
index ab82c19..2ef5dc5 100644 (file)
--- a/src/code/symbol.lisp
+++ b/src/code/symbol.lisp
@@ -15,7 +15,7 @@
 
 (in-package "SB!IMPL")
 
-(declaim (maybe-inline get %put getf remprop %putf get-properties keywordp))
+(declaim (maybe-inline get get2 get3 %put getf remprop %putf get-properties keywordp))
 
 (defun symbol-value (symbol)
   #!+sb-doc
@@ -94,13 +94,32 @@
   #!+sb-doc
   "Look on the property list of SYMBOL for the specified INDICATOR. If this
   is found, return the associated value, else return DEFAULT."
-  (do ((pl (symbol-plist symbol) (cddr pl)))
-      ((atom pl) default)
-    (cond ((atom (cdr pl))
-           (error "~S has an odd number of items in its property list."
-                   symbol))
-          ((eq (car pl) indicator)
-           (return (cadr pl))))))
+  (get3 symbol indicator default))
+
+(defun get2 (symbol indicator)
+  (get3 symbol indicator nil))
+#|
+  (let (cdr-pl)
+    (do ((pl (symbol-plist symbol) (cdr cdr-pl)))
+        ((atom pl) nil)
+      (setf cdr-pl (cdr pl))
+      (cond ((atom cdr-pl)
+             (error "~S has an odd number of items in its property list."
+                    symbol))
+            ((eq (car pl) indicator)
+             (return (car cdr-pl)))))))
+|#
+
+(defun get3 (symbol indicator default)
+  (let (cdr-pl)
+    (do ((pl (symbol-plist symbol) (cdr cdr-pl)))
+       ((atom pl) default)
+      (setq cdr-pl (cdr pl))
+      (cond ((atom cdr-pl)
+            (error "~S has an odd number of items in its property list."
+                   symbol))
+           ((eq (car pl) indicator)
+            (return (car cdr-pl)))))))
 
 (defun %put (symbol indicator value)
   #!+sb-doc

diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index fdc846c..04cf286 100644 (file)
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -156,6 +156,8 @@
 ;;;; from the "Symbols" chapter:
 
 (defknown get (symbol t &optional t) t (flushable))
+(defknown sb!impl::get2 (symbol t) t (flushable))
+(defknown sb!impl::get3 (symbol t t) t (flushable))
 (defknown remprop (symbol t) t)
 (defknown symbol-plist (symbol) list (flushable))
 (defknown getf (list t &optional t) t (foldable flushable))

diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp
index c203447..b72a672 100644 (file)
--- a/src/compiler/globaldb.lisp
+++ b/src/compiler/globaldb.lisp
@@ -180,7 +180,7 @@
 (declaim (hash-table *info-classes*))
 #-sb-xc ; as per KLUDGE note above
 (eval-when (:compile-toplevel :execute)
-  (setf *info-classes* (make-hash-table)))
+  (setf *info-classes* (make-hash-table :test #'eq)))
 
 ;;; If NAME is the name of a type in CLASS, then return the TYPE-INFO,
 ;;; otherwise NIL.
@@ -197,8 +197,14 @@
   #+sb-xc (/noshow0 "entering CLASS-INFO-OR-LOSE, CLASS=..")
   #+sb-xc (/nohexstr class)
   (prog1
-      (or (gethash class *info-classes*)
-          (error "~S is not a defined info class." class))
+      (flet ((lookup (class)
+              (or (gethash class *info-classes*)
+                  (error "~S is not a defined info class." class))))
+       (if (symbolp class)
+           (or (get class 'class-info-or-lose-cache)
+               (setf (get class 'class-info-or-lose-cache)
+                     (lookup class)))
+           (lookup class)))
     #+sb-xc (/noshow0 "returning from CLASS-INFO-OR-LOSE")))
 (declaim (ftype (function (keyword keyword) type-info) type-info-or-lose))
 (defun type-info-or-lose (class type)
@@ -1378,7 +1384,7 @@
 (!cold-init-forms
   (/show0 "beginning *INFO-CLASSES* init, calling MAKE-HASH-TABLE")
   (setf *info-classes*
-        (make-hash-table :size #.(hash-table-size *info-classes*)))
+        (make-hash-table :test 'eq :size #.(hash-table-size *info-classes*)))
   (/show0 "done with MAKE-HASH-TABLE in *INFO-CLASSES* init")
   (dolist (class-info-name '#.(let ((result nil))
                                 (maphash (lambda (key value)

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 7383e72..da487e6 100644 (file)
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -134,6 +134,11 @@
    (2 `(sb!impl::gethash2 ,@args))
    (3 `(sb!impl::gethash3 ,@args))
    (t (values nil t))))
+(define-source-transform get (&rest args)
+  (case (length args)
+   (2 `(sb!impl::get2 ,@args))
+   (3 `(sb!impl::get3 ,@args))
+   (t (values nil t))))
 
 (defvar *default-nthcdr-open-code-limit* 6)
 (defvar *extreme-nthcdr-open-code-limit* 20)

diff --git a/version.lisp-expr b/version.lisp-expr
index 41894ba..21c3d00 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.3.32"
+"0.9.3.33"