Skip to content
Browse files

Micro-optimize access to ID.

  • Loading branch information...
1 parent 9b7b361 commit 426ac3607e99e4c47092c647bcff68abc91df954 @stassats committed Dec 21, 2012
Showing with 33 additions and 5 deletions.
  1. +3 −2 disk.lisp
  2. +12 −3 mop.lisp
  3. +12 −0 util-generic.lisp
  4. +6 −0 util-sbcl.lisp
View
5 disk.lisp
@@ -444,7 +444,8 @@
(write-n-bytes #.(type-code 'list-of-objects) 1 stream)
(write-n-bytes (length list) +sequence-length+ stream)
(dolist (object list)
- (write-n-bytes (id object) +id-length+ stream)))
+ (write-n-bytes (fast-id object)
+ +id-length+ stream)))
(defreader list-of-objects (stream)
(loop repeat (read-n-bytes +sequence-length+ stream)
@@ -639,7 +640,7 @@
(defmethod write-object ((object identifiable) stream)
(write-n-bytes #.(type-code 'identifiable) 1 stream)
- (write-n-bytes (id object) +id-length+ stream))
+ (write-n-bytes (fast-id object) +id-length+ stream))
(declaim (inline get-instance))
(defun get-instance (id)
View
15 mop.lisp
@@ -161,9 +161,12 @@
(slots-with-relations class))
(setf (relations-location class)
(slot-definition-location
- (or (find-slot 'relations class)
- (error "Can't find ~s slot in ~s."
- 'relations class))))
+ (find-slot-or-error 'relations class)))
+ #+(or sbcl ecl ccl)
+ (assert
+ (= (slot-definition-location
+ (find-slot-or-error 'id class))
+ +id-location+))
(compute-search-key class)))
(defmethod finalize-inheritance :after ((class storable-class))
@@ -173,6 +176,12 @@
(find slot-name (class-slots class)
:key #'slot-definition-name))
+(defun find-slot-or-error (slot-name class)
+ (or (find slot-name (class-slots class)
+ :key #'slot-definition-name)
+ (error "Can't find ~s slot in ~s."
+ slot-name class)))
+
(defun compute-search-key (class)
(with-slots (search-key) class
(let* ((key (or search-key
View
12 util-generic.lisp
@@ -19,3 +19,15 @@
do (initialize-slots instance slot-cache)
(setf (aref array index) instance)
(incf index)))))
+
+(defconstant +id-location+ 0)
+
+(declaim (inline fast-id))
+
+#+(or ccl ecl)
+(defun fast-id (object)
+ (standard-instance-access object +id-location+))
+
+#-(or ccl ecl)
+(defun fast-id (object)
+ (id object))
View
6 util-sbcl.lisp
@@ -24,3 +24,9 @@
do
(setf (aref array index) instance)
(incf index)))))
+
+(defconstant +id-location+ 0)
+
+(declaim (inline fast-id))
+(defun fast-id (object)
+ (standard-instance-access object +id-location+))

0 comments on commit 426ac36

Please sign in to comment.
Something went wrong with that request. Please try again.