--- a/Behavior.st Wed Apr 07 19:36:33 2010 +0200
+++ b/Behavior.st Wed Apr 07 19:50:20 2010 +0200
@@ -1143,7 +1143,6 @@
! !
-
!Behavior methodsFor:'accessing'!
addSelector:newSelector withMethod:newMethod
@@ -1269,14 +1268,6 @@
^ lookupObject
!
-setLookupObject:aMethodLookupObject
- "set the lookupObject (Jan's MetaObjectProtocol support) or nil.
- If non-nil, no lookup is performed by the VM, instead the lookupObject
- has to provide a method object for message sends."
-
- lookupObject := aMethodLookupObject
-!
-
methodDictionary
"return the receivers method dictionary."
@@ -1330,51 +1321,18 @@
"Modified: 12.11.1996 / 11:31:51 / cg"
!
+setLookupObject:aMethodLookupObject
+ "set the lookupObject (Jan's MetaObjectProtocol support) or nil.
+ If non-nil, no lookup is performed by the VM, instead the lookupObject
+ has to provide a method object for message sends."
+
+ lookupObject := aMethodLookupObject
+!
+
superclass
"return the receivers superclass"
^ superclass
-!
-
-superclass:aClass
- "set the superclass - this actually creates a new class,
- recompiling all methods for the new one. The receiving class stays
- around anonymous to allow existing instances some life.
- This may change in the future (adjusting existing instances)"
-
- |owner ns name|
-
- Class flushSubclassInfo.
-
- "must flush caches since lookup chain changes"
- ObjectMemory flushCaches.
-
- "/ for correct recompilation, just create a new class ...
- "/ but care to avoid a nameSpace change, by giving my
- "/ full name and answering with Smalltalk to a nameSpace query.
-
- (owner := self owningClass) notNil ifTrue:[
- ns := owner.
- name := self nameWithoutPrefix asSymbol
- ] ifFalse:[
- ns := Smalltalk.
- name := self name
- ].
-
- Class classRedefinitionNotification answer:#keep do:[
- Class nameSpaceQuerySignal answer:ns
- do:[
- aClass
- perform:(self definitionSelector)
- withArguments:(Array with:name
- with:(self instanceVariableString)
- with:(self classVariableString)
- with:'' "/ pool
- with:(self category)).
- ]
- ]
-
- "Modified: / 20.6.1998 / 18:17:37 / cg"
! !
!Behavior methodsFor:'autoload check'!
@@ -3112,26 +3070,43 @@
isSubclassOf:aClass
"return true, if I am a subclass of the argument, aClass"
- |theClass|
-
- theClass := superclass.
- [theClass notNil] whileTrue:[
- (theClass == aClass) ifTrue:[^ true].
-%{
- if (__isBehaviorLike(theClass)) {
- theClass = __ClassInstPtr(theClass)->c_superclass;
- } else {
- theClass = nil;
- }
+%{ /* NOCONTEXT */
+ OBJ __theClass = __INST(superclass);
+
+ while (__theClass != nil) {
+ if (__theClass == aClass) {
+ RETURN(true);
+ }
+ if (__isBehaviorLike(__theClass)) {
+ __theClass = __ClassInstPtr(__theClass)->c_superclass;
+ } else {
+ __theClass = nil;
+ }
+ }
+ RETURN (false);
%}.
-"/ theClass := theClass superclass.
- ].
- ^ false
+
+"/ |theClass|
+"/
+"/ theClass := superclass.
+"/ [theClass notNil] whileTrue:[
+"/ (theClass == aClass) ifTrue:[^ true].
+"/%{
+"/ if (__isBehaviorLike(theClass)) {
+"/ theClass = __ClassInstPtr(theClass)->c_superclass;
+"/ } else {
+"/ theClass = nil;
+"/ }
+"/%}.
+"/"/ theClass := theClass superclass.
+"/ ].
+"/ ^ false
"
- String isSubclassOf:Collection
- LinkedList isSubclassOf:Array
+ String isSubclassOf:Collection
+ LinkedList isSubclassOf:Array
1 isSubclassOf:Number <- will fail since 1 is no class
+ Number isSubclassOf:1
"
!
@@ -4571,9 +4546,9 @@
!Behavior class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.300 2010-04-07 14:52:07 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.301 2010-04-07 17:50:20 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.300 2010-04-07 14:52:07 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.301 2010-04-07 17:50:20 cg Exp $'
! !