Make INTERN-POINTER-WRAPPER intern OBJECTIVE-C-CLASSes.

darcs-hash:8ea30cedc918a1d45612a6efb68126715c2cf8ef

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)))))