Update of /cvsroot/sbcl/sbcl/src/compiler
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv7298/src/compiler
Modified Files:
fndb.lisp globaldb.lisp srctran.lisp
Log Message:
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.
Index: fndb.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/fndb.lisp,v
retrieving revision 1.111
retrieving revision 1.112
diff -u -d -r1.111 -r1.112
--- fndb.lisp 5 Aug 2005 03:28:32 -0000 1.111
+++ fndb.lisp 6 Aug 2005 15:24:38 -0000 1.112
@@ -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))
Index: globaldb.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/globaldb.lisp,v
retrieving revision 1.42
retrieving revision 1.43
diff -u -d -r1.42 -r1.43
--- globaldb.lisp 14 Jul 2005 18:56:59 -0000 1.42
+++ globaldb.lisp 6 Aug 2005 15:24:38 -0000 1.43
@@ -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)
Index: srctran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/srctran.lisp,v
retrieving revision 1.130
retrieving revision 1.131
diff -u -d -r1.130 -r1.131
--- srctran.lisp 5 Aug 2005 03:28:33 -0000 1.130
+++ srctran.lisp 6 Aug 2005 15:24:38 -0000 1.131
@@ -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)
|