From e63bff30be008c4dfe1ee225c1879baecbeb0ab3 Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Wed, 19 Mar 2008 03:07:42 +0100 Subject: Add a NAME slot to class SELECTOR. darcs-hash:c51f1608afb05ec84f8f615114cb7f9f65abf8fe --- JOURNAL | 45 ++++++++++++++++++++++++++++++++++++++++++++- Lisp/data-types.lisp | 42 +++++++++++++++++++++++++++++++++++++++++- Lisp/libobjcl.lisp | 42 ++---------------------------------------- objective-cl.asd | 3 ++- 4 files changed, 89 insertions(+), 43 deletions(-) diff --git a/JOURNAL b/JOURNAL index 81398ef..926e9ce 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-18 18:00:52 mulk> +; Time-stamp: <2008-03-19 03:07:26 mulk> ; ; C-c i t insert-time-stamp ; C-c C-t muse-project-publish-this-file @@ -18,6 +18,49 @@ Context: [[http://matthias.benkard.de/objective-cl][The Objective-CL Project]]. ---- +* 2008-03-19, 03:03:50 CET + +** Optimising INVOKE + +The benchmark: + + +(let ((x (invoke (find-objc-class 'ns-method-signature) + :method-signature-for-selector 'new))) + (time (dotimes (i 100000) (invoke x :get-argument-type-at-index 0)))) + + +Before: + + +Evaluation took: + 7.727 seconds of real time + 7.136446 seconds of user run time + 0.080005 seconds of system run time + [Run times include 0.288 seconds GC run time.] + 0 calls to %EVAL + 0 page faults and + 218,448,224 bytes consed. + + +After: + + +Evaluation took: + 5.868 seconds of real time + 5.824364 seconds of user run time + 0.032002 seconds of system run time + [Run times include 0.256 seconds GC run time.] + 0 calls to %EVAL + 0 page faults and + 122,487,656 bytes consed. + + +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. + + * 2008-03-18, 15:31:30 CET ** Profiling INVOKE diff --git a/Lisp/data-types.lisp b/Lisp/data-types.lisp index 67dcb70..e2a5358 100644 --- a/Lisp/data-types.lisp +++ b/Lisp/data-types.lisp @@ -81,8 +81,46 @@ t) +(defgeneric selector-name (selector) + (:documentation "Find the name of a selector. + +## Arguments and Values: + +*selector* --- an **object** of **type** __selector__. + +Returns: *name* --- a **string**. + + +## Description: + +__selector-name__ returns the name of *selector*. + + +## Examples: + + (selector-name (selector '(:string-with-c-string :encoding))) + ;=> \"stringWithCString:encoding:\" + + +## Note: + +If *x* is an **object** of **type** __selector__: + + (objc-equal x (find-selector (selector-name x))) ;=> T + +If *name* is the name of an existing selector: + + (equal name (selector-name (find-selector name))) ;=> T + + +## See Also: + + __find-selector__, __selector__")) + + (defclass selector (c2mop:funcallable-standard-object c-pointer-wrapper) - () + ((name :accessor selector-name + :type string)) (:metaclass c2mop:funcallable-standard-class) (:documentation "An Objective-C method selector. @@ -134,6 +172,8 @@ The following calls are all equivalent: ;; Therefore, we handle this in a somewhat different manner for CMUCL. ;; See SELECTOR-FUNCTION below. (declare (ignore slot-names initargs)) + (setf (slot-value selector 'name) + (%objcl-selector-name (pointer-to selector))) (c2mop:set-funcallable-instance-function selector #-cmu #'(lambda (receiver &rest args) diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp index dd0b3b0..39b1e2d 100644 --- a/Lisp/libobjcl.lisp +++ b/Lisp/libobjcl.lisp @@ -525,46 +525,6 @@ If *name* is the name of an existing class: (%objcl-class-name (pointer-to class))) -#? selector -> string -(defun selector-name (selector) - "Find the name of a selector. - -## Arguments and Values: - -*selector* --- an **object** of **type** __selector__. - -Returns: *name* --- a **string**. - - -## Description: - -__selector-name__ returns the name of *selector*. - - -## Examples: - - (selector-name (selector '(:string-with-c-string :encoding))) - ;=> \"stringWithCString:encoding:\" - - -## Note: - -If *x* is an **object** of **type** __selector__: - - (objc-equal x (find-selector (selector-name x))) ;=> T - -If *name* is the name of an existing selector: - - (equal name (selector-name (find-selector name))) ;=> T - - -## See Also: - - __find-selector__, __selector__" - (declare (type selector selector)) - (%objcl-selector-name (pointer-to selector))) - - #? (or id objective-c-class exception) selector -> t (defun get-method-implementation (object selector) (declare (type selector selector)) @@ -771,6 +731,8 @@ separating parts by hyphens works nicely in all of the `:INVERT`, (%objcl-object-is-meta-class (pointer obj))) (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))))) diff --git a/objective-cl.asd b/objective-cl.asd index 4e72ec0..64dcbfb 100644 --- a/objective-cl.asd +++ b/objective-cl.asd @@ -60,7 +60,8 @@ (:file "performance-hacks" :depends-on ("defpackage")) (:file "policy" :depends-on ("defpackage" "parameters" - "libobjcl")) + "libobjcl" + "data-types")) (:file "libobjcl" :depends-on ("defpackage" "internal-reader-syntax" "constant-data" -- cgit v1.2.3