Changeset 12586


Ignore:
Timestamp:
04/09/10 21:27:14 (13 years ago)
Author:
ehuelsmann
Message:

Reduce function dispatch speed with 6% by

replacing dynamic STANDARD-CLASS lookup with
a defined constant.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/abcl/src/org/armedbear/lisp/clos.lisp

    r12583 r12586  
    5353
    5454(export '(class-precedence-list class-slots))
     55(defconstant +the-standard-class+ (find-class 'standard-class))
    5556
    5657;; Don't use DEFVAR, because that disallows loading clos.lisp
    … …  
    297298(defun std-finalize-inheritance (class)
    298299  (setf (class-precedence-list class)
    299    (funcall (if (eq (class-of class) (find-class 'standard-class))
     300   (funcall (if (eq (class-of class) +the-standard-class+)
    300301                #'std-compute-class-precedence-list
    301302                #'compute-class-precedence-list)
    … …  
    305306      (return-from std-finalize-inheritance)))
    306307  (setf (class-slots class)
    307                    (funcall (if (eq (class-of class) (find-class 'standard-class))
     308                   (funcall (if (eq (class-of class) +the-standard-class+)
    308309                                #'std-compute-slots
    309310                     #'compute-slots) class))
    … …  
    438439    (mapcar #'(lambda (name)
    439440               (funcall
    440                 (if (eq (class-of class) (find-class 'standard-class))
     441                (if (eq (class-of class) +the-standard-class+)
    441442                    #'std-compute-effective-slot-definition
    442443                    #'compute-effective-slot-definition)
    … …  
    487488
    488489(defun slot-value (object slot-name)
    489   (if (eq (class-of (class-of object)) (find-class 'standard-class))
     490  (if (eq (class-of (class-of object)) +the-standard-class+)
    490491      (std-slot-value object slot-name)
    491492      (slot-value-using-class (class-of object) object slot-name)))
    … …  
    494495
    495496(defun %set-slot-value (object slot-name new-value)
    496   (if (eq (class-of (class-of object)) (find-class 'standard-class))
     497  (if (eq (class-of (class-of object)) +the-standard-class+)
    497498      (setf (std-slot-value object slot-name) new-value)
    498499      (set-slot-value-using-class new-value (class-of object)
    … …  
    502503
    503504(defun slot-boundp (object slot-name)
    504   (if (eq (class-of (class-of object)) (find-class 'standard-class))
     505  (if (eq (class-of (class-of object)) +the-standard-class+)
    505506      (std-slot-boundp object slot-name)
    506507      (slot-boundp-using-class (class-of object) object slot-name)))
    … …  
    517518
    518519(defun slot-makunbound (object slot-name)
    519   (if (eq (class-of (class-of object)) (find-class 'standard-class))
     520  (if (eq (class-of (class-of object)) +the-standard-class+)
    520521      (std-slot-makunbound object slot-name)
    521522      (slot-makunbound-using-class (class-of object) object slot-name)))
    … …  
    526527
    527528(defun slot-exists-p (object slot-name)
    528   (if (eq (class-of (class-of object)) (find-class 'standard-class))
     529  (if (eq (class-of (class-of object)) +the-standard-class+)
    529530      (std-slot-exists-p object slot-name)
    530531      (slot-exists-p-using-class (class-of object) object slot-name)))
    … …  
    539540                                     &allow-other-keys)
    540541  (declare (ignore metaclass))
    541   (let ((class (std-allocate-instance (find-class 'standard-class))))
     542  (let ((class (std-allocate-instance +the-standard-class+)))
    542543    (%set-class-name name class)
    543544    (%set-class-layout nil class)
    … …  
    570571        (add-writer-method class writer (%slot-definition-name direct-slot)))))
    571572  (setf (class-direct-default-initargs class) direct-default-initargs)
    572   (funcall (if (eq (class-of class) (find-class 'standard-class))
     573  (funcall (if (eq (class-of class) +the-standard-class+)
    573574               #'std-finalize-inheritance
    574575               #'finalize-inheritance)
    … …  
    614615                 ((typep old-class 'forward-referenced-class)
    615616                  (let ((new-class (apply #'make-instance-standard-class
    616                                           (find-class 'standard-class)
     617                                          +the-standard-class+
    617618                                          :name name all-keys)))
    618619                    (%set-find-class name new-class)
    … …  
    632633                                   #'make-instance-standard-class)
    633634                               (or metaclass
    634                                    (find-class 'standard-class))
     635                                   +the-standard-class+)
    635636                               :name name all-keys)))
    636637             (%set-find-class name class)
    … …  
    17791780(defun add-reader-method (class function-name slot-name)
    17801781  (let* ((lambda-expression
    1781           (if (eq (class-of class) (find-class 'standard-class))
     1782          (if (eq (class-of class) +the-standard-class+)
    17821783              `(lambda (object) (std-slot-value object ',slot-name))
    17831784              `(lambda (object) (slot-value object ',slot-name))))
    … …  
    18061807(defun add-writer-method (class function-name slot-name)
    18071808  (let* ((lambda-expression
    1808           (if (eq (class-of class) (find-class 'standard-class))
     1809          (if (eq (class-of class) +the-standard-class+)
    18091810              `(lambda (new-value object)
    18101811                 (setf (std-slot-value object ',slot-name) new-value))
Note: See TracChangeset for help on using the changeset viewer.