--- a/Behavior.st Thu Jul 22 17:14:33 2010 +0100
+++ b/Behavior.st Fri Jul 23 18:11:42 2010 +0100
@@ -1166,9 +1166,9 @@
].
ns := newMethod nameSpace.
- selector := ns
- ifNotNil:[(':' , ns name , '::' , newSelector) asSymbol]
- ifNil:[newSelector].
+ selector := (ns isNil or:[ns == self programmingLanguage])
+ ifTrue:[newSelector]
+ ifFalse:[(':' , ns name , '::' , newSelector) asSymbol].
oldMethod := self compiledMethodAt:selector.
@@ -1179,7 +1179,8 @@
(self primAddSelector:selector withMethod:newMethod) ifFalse:[^ false].
- ns ifNotNil:[self lookupObject: NamespaceAwareLookup].
+ selector isNameSpaceSelector ifTrue:
+ [self lookupObject: NamespaceAwareLookup].
"
if I have no subclasses, all we have to flush is cached
@@ -4077,7 +4078,18 @@
"return true, if the receiver or one of its superclasses implements aSelector.
(i.e. true if my instances understand aSelector)"
+ "JV @ 2010-08-22: Rewritten to respect lookup object."
+ ^ (self lookupObject
+ lookupMethodForSelector:aSelector
+ directedTo:self
+ for: nil "Fake receiver"
+ withArguments: nil "Fake arguments"
+ from: thisContext sender) notNil
+
+ "Original implementation"
+ "
^ (self lookupMethodFor:aSelector) notNil
+ "
"
True canUnderstand:#ifTrue:
@@ -4299,6 +4311,16 @@
Return the method, or nil if instances do not understand aSelector.
EXPERIMENTAL: take care of multiple superclasses."
+ "JV @ 2010-08-22: Rewritten to respect lookup object."
+ ^ (self lookupObject
+ lookupMethodForSelector:aSelector
+ directedTo:self
+ for: nil "Fake receiver"
+ withArguments: nil "Fake arguments"
+ from: thisContext sender)
+
+ "Original implementation"
+ "
|m cls|
cls := self.
@@ -4316,6 +4338,7 @@
]
].
^ nil
+ "
!
responseTo:aSelector
@@ -4686,7 +4709,7 @@
!Behavior class methodsFor:'documentation'!
version
- ^ '$Id: Behavior.st 10555 2010-07-22 16:12:06Z vranyj1 $'
+ ^ '$Id: Behavior.st 10557 2010-07-23 17:11:42Z vranyj1 $'
!
version_CVS
@@ -4694,5 +4717,5 @@
!
version_SVN
- ^ '$Id: Behavior.st 10555 2010-07-22 16:12:06Z vranyj1 $'
+ ^ '$Id: Behavior.st 10557 2010-07-23 17:11:42Z vranyj1 $'
! !
--- a/BuiltinLookup.st Thu Jul 22 17:14:33 2010 +0100
+++ b/BuiltinLookup.st Fri Jul 23 18:11:42 2010 +0100
@@ -54,42 +54,8 @@
"Modified: / 26-04-2010 / 21:32:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-!BuiltinLookup methodsFor:'lookup'!
-
-lookupMethodForSelector:aSelector directedTo:searchClass for:aReceiver withArguments:argArrayOrNil from:sendingContext
- "invoked by the VM to ask me for a method to call.
- The arguments are: the selector, receiver and arguments,
- the class to start the search in (for here-, super and directed sends)
- the sending context.
-
- The returned method object will be put into the inline- and polyCache
- at the call site; it might therefore be called more than once for the
- same receiver-class/selector combination (once for each call site).
- If I return nil, a doesNotUnderstand will be invoked.
-
- BuiltinLookup represents the lookup as perfomed by the VM. Class
- variable 'Instance' is a special value for the VM, if found in
- class's lookupObject slot, the lookup is done in the VM. "
-
-
-
- |cls md method|
-
- cls := searchClass.
- cls isNil ifTrue:[ cls := aReceiver class ].
- [ cls notNil ] whileTrue:[
- md := cls methodDictionary.
- method := md at:aSelector ifAbsent:nil.
- method notNil ifTrue:[^ method ].
- cls := cls superclass.
- ].
- ^ nil
-
- "Modified: / 26-04-2010 / 21:18:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-! !
-
!BuiltinLookup class methodsFor:'documentation'!
version_SVN
- ^ '$Id: BuiltinLookup.st 10518 2010-04-29 15:55:35Z vranyj1 $'
+ ^ '$Id: BuiltinLookup.st 10557 2010-07-23 17:11:42Z vranyj1 $'
! !
--- a/Lookup.st Thu Jul 22 17:14:33 2010 +0100
+++ b/Lookup.st Fri Jul 23 18:11:42 2010 +0100
@@ -54,11 +54,18 @@
!Lookup methodsFor:'lookup'!
-lookupMethodForSelector: selector directedTo: searchClass
+lookupMethodForSelector: selector directedTo: initialSearchClass
|cls md method|
- cls := searchClass.
+ "Following C code is just a performance optimization.
+ It is not neccessary, however it speeds up UI code,
+ since it heavily uses perform:"
+%{
+ RETURN ( __lookup(initialSearchClass, selector) );
+%}.
+
+ cls := initialSearchClass.
[ cls notNil ] whileTrue:[
md := cls methodDictionary.
method := md at:selector ifAbsent:nil.
@@ -70,7 +77,7 @@
"Created: / 27-04-2010 / 15:30:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-lookupMethodForSelector:aSelector directedTo:searchClass for:aReceiver withArguments:argArrayOrNil from:sendingContext
+lookupMethodForSelector:selector directedTo:initialSearchClass for:aReceiver withArguments:argArrayOrNil from:sendingContext
"invoked by the VM to ask me for a method to call.
The arguments are: the selector, receiver and arguments,
the class to start the search in (for here-, super and directed sends)
@@ -83,21 +90,22 @@
|cls md method|
- cls := searchClass.
- cls isNil ifTrue:[ cls := aReceiver class ].
- [ cls notNil ] whileTrue:[
- md := cls methodDictionary.
- method := md at:aSelector ifAbsent:nil.
- method notNil ifTrue:[^ method ].
- cls := cls superclass.
- ].
- ^ nil
+ "Following C code is just a performance optimization.
+ It is not neccessary, however it speeds up UI code,
+ since it heavily uses perform:"
+%{
+ RETURN ( __lookup(initialSearchClass, selector) );
+%}.
+ ^ self lookupMethodForSelector: selector
+ directedTo: initialSearchClass
+
+
! !
!Lookup class methodsFor:'documentation'!
version_SVN
- ^ '$Id: Lookup.st 10518 2010-04-29 15:55:35Z vranyj1 $'
+ ^ '$Id: Lookup.st 10557 2010-07-23 17:11:42Z vranyj1 $'
! !
Lookup initialize!
--- a/ObjectMemory.st Thu Jul 22 17:14:33 2010 +0100
+++ b/ObjectMemory.st Fri Jul 23 18:11:42 2010 +0100
@@ -1083,6 +1083,23 @@
"
!
+ilcMisses: newValue
+
+ newValue class == SmallInteger ifFalse:[^self error:'Not an integer value'].
+%{
+ RETURN ( __MKSMALLINT ( ilcMisses ( __intVal ( newValue ) ) ) );
+%}
+
+!
+
+ilcMissesTrace: bool
+
+%{
+ RETURN ( ilcMissesTrace ( bool == true ) ? true : false );
+%}
+
+!
+
trapRestrictedMethods:trap
"Allow/Deny execution of restricted Methods (see Method>>>restricted:)
@@ -5353,7 +5370,7 @@
!ObjectMemory class methodsFor:'documentation'!
version
- ^ '$Id: ObjectMemory.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: ObjectMemory.st 10557 2010-07-23 17:11:42Z vranyj1 $'
!
version_CVS
@@ -5361,7 +5378,7 @@
!
version_SVN
- ^ '$Id: ObjectMemory.st 10544 2010-07-12 16:20:36Z vranyj1 $'
+ ^ '$Id: ObjectMemory.st 10557 2010-07-23 17:11:42Z vranyj1 $'
! !
ObjectMemory initialize!
--- a/stx_libbasic.st Thu Jul 22 17:14:33 2010 +0100
+++ b/stx_libbasic.st Fri Jul 23 18:11:42 2010 +0100
@@ -534,13 +534,13 @@
"Return a SVN revision number of myself.
This number is updated after a commit"
- ^ "$SVN-Revision:"'10551:10554M'"$"
+ ^ "$SVN-Revision:"'10556M'"$"
! !
!stx_libbasic class methodsFor:'documentation'!
version
- ^ '$Id: stx_libbasic.st 10556 2010-07-22 16:14:33Z vranyj1 $'
+ ^ '$Id: stx_libbasic.st 10557 2010-07-23 17:11:42Z vranyj1 $'
!
version_CVS
@@ -548,5 +548,5 @@
!
version_SVN
- ^ '$Id: stx_libbasic.st 10556 2010-07-22 16:14:33Z vranyj1 $'
+ ^ '$Id: stx_libbasic.st 10557 2010-07-23 17:11:42Z vranyj1 $'
! !