From f9180cd67505f16a8588a83da82f263bc395b347 Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Wed, 19 Mar 2008 03:20:52 +0100 Subject: Make INTERN-POINTER-WRAPPER intern OBJECTIVE-C-CLASSes. darcs-hash:8ea30cedc918a1d45612a6efb68126715c2cf8ef --- JOURNAL | 22 ++++++++++++++++++++-- Lisp/libobjcl.lisp | 8 +++++--- Lisp/memory-management.lisp | 5 ++++- 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: - + 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: + + +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. + + +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))))) -- cgit v1.2.3