summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--JOURNAL22
-rw-r--r--Lisp/libobjcl.lisp8
-rw-r--r--Lisp/memory-management.lisp5
3 files changed, 29 insertions, 6 deletions
diff --git a/JOURNAL b/JOURNAL
index 926e9ce..0ac5324 100644
--- a/JOURNAL
+++ b/JOURNAL
@@ -3,7 +3,7 @@
#title Objective-CL Development Diary
#desc News from the Objective-CL lab
-; Time-stamp: <2008-03-19 03:07:26 mulk>
+; Time-stamp: <2008-03-19 03:19:55 mulk>
;
; C-c i t insert-time-stamp
; C-c C-t muse-project-publish-this-file
@@ -45,7 +45,7 @@ Evaluation took:
After:
-</example>
+<example>
Evaluation took:
5.868 seconds of real time
5.824364 seconds of user run time
@@ -60,6 +60,24 @@ What I did was add a **name** slot to class **selector** so that **selector-name
need only access a slot now instead of calling a foreign function and
converting the returned value to a Lisp string.
+After that, I enhanced **intern-pointer-wrapper** to intern classes, because
+**object-get-class**, another frequently called function, had to first
+acquire the class name associated with a class pointer and then finally
+call **find-objc-class-by-name** with that name. The result:
+
+<example>
+Evaluation took:
+ 4.058 seconds of real time
+ 4.020251 seconds of user run time
+ 0.016001 seconds of system run time
+ [Run times include 0.148 seconds GC run time.]
+ 0 calls to %EVAL
+ 0 page faults and
+ 76,830,440 bytes consed.
+</example>
+
+That's gonna be it for now. I'll call it a night.
+
* 2008-03-18, 15:31:30 CET
diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp
index 39b1e2d..38b244f 100644
--- a/Lisp/libobjcl.lisp
+++ b/Lisp/libobjcl.lisp
@@ -732,9 +732,11 @@ separating parts by hyphens works nicely in all of the `:INVERT`,
(defun object-get-class (obj)
;; OPTIMISE: Both find-objc-class-by-name and %objcl-class-name are
- ;; slow and mostly unneeded.
- (find-objc-class-by-name
- (%objcl-class-name (%objcl-object-get-class (pointer obj)))))
+ ;; slow and mostly unneeded. We can simply retrieve classes by class
+ ;; pointer if they have already been registered in a hash table
+ ;; somewhere.
+ (intern-pointer-wrapper 'objective-c-class
+ :pointer (%objcl-object-get-class (pointer obj))))
(defun object-get-meta-class (obj)
(find-objc-meta-class-by-name
diff --git a/Lisp/memory-management.lisp b/Lisp/memory-management.lisp
index 890e96f..bca6a84 100644
--- a/Lisp/memory-management.lisp
+++ b/Lisp/memory-management.lisp
@@ -21,6 +21,7 @@
(defvar *id-objects* (make-weak-value-hash-table))
(defvar *exception-objects* (make-weak-value-hash-table))
(defvar *selector-objects* (make-weak-value-hash-table))
+(defvar *class-objects* (make-hash-table))
(defun intern-pointer-wrapper (class &rest initargs &key pointer &allow-other-keys)
@@ -37,7 +38,9 @@
(find-objc-meta-class-by-name (%objcl-class-name pointer))))
((%objcl-object-is-class pointer)
(return-from intern-pointer-wrapper
- (find-objc-class-by-name (%objcl-class-name pointer))))
+ (or (gethash (pointer-address pointer) *class-objects*)
+ (setf (gethash (pointer-address pointer) *class-objects*)
+ (find-objc-class-by-name (%objcl-class-name pointer))))))
((objcl-object-backed-by-lisp-class-p/pointer pointer)
(return-from intern-pointer-wrapper
(apply #'intern-lisp-managed-foreign-instance initargs)))))