From 8dbc4249380e18a193f4e79306bd958cd88ad9aa Mon Sep 17 00:00:00 2001 From: "Paul F. Dietz" Date: Sat, 6 Aug 2005 15:24:19 +0000 Subject: [PATCH] 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. --- src/code/symbol.lisp | 35 +++++++++++++++++++++++++++-------- src/compiler/fndb.lisp | 2 ++ src/compiler/globaldb.lisp | 14 ++++++++++---- src/compiler/srctran.lisp | 5 +++++ version.lisp-expr | 2 +- 5 files changed, 45 insertions(+), 13 deletions(-) diff --git a/src/code/symbol.lisp b/src/code/symbol.lisp index ab82c19..2ef5dc5 100644 --- 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 --- 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 --- 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 --- 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 --- 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" -- 1.7.10.4