--- a/Behavior.st Tue May 07 19:56:48 2013 +0200
+++ b/Behavior.st Tue May 07 21:53:10 2013 +0200
@@ -809,9 +809,9 @@
This is an alternate algorithm showing cycles"
- |classes orderedTuples|
-
- orderedTuples := OrderedCollection new:classes size.
+ |orderedTuples|
+
+ orderedTuples := OrderedCollection new:aCollectionOfClasses size.
aCollectionOfClasses do:[:eachClass|
|sharedPools|
orderedTuples add:(Array with:eachClass with:eachClass superclass).
@@ -1074,6 +1074,8 @@
"Created: / 01-06-2012 / 20:37:46 / cg"
! !
+
+
!Behavior methodsFor:'Compatibility-Dolphin'!
allSubinstances
@@ -1228,6 +1230,8 @@
^ self nameWithoutPrefix
! !
+
+
!Behavior methodsFor:'accessing'!
addSelector:newSelector withMethod:newMethod
@@ -1495,6 +1499,7 @@
"Created: 16.4.1996 / 16:27:16 / cg"
! !
+
!Behavior methodsFor:'compiler interface'!
browserClass
@@ -2065,6 +2070,7 @@
^ self
! !
+
!Behavior methodsFor:'instance creation'!
basicNew
@@ -2077,7 +2083,7 @@
%{ /* NOCONTEXT */
REGISTER OBJ newobj;
- REGISTER char *nextPtr;
+ REGISTER void *nextPtr;
unsigned INT instsize;
REGISTER unsigned INT nInstVars;
@@ -2091,124 +2097,122 @@
instsize = OHDR_SIZE + __OBJS2BYTES__(nInstVars);
newobj = (OBJ) __newNextPtr;
- nextPtr = ((char *)newobj) + instsize;
+ nextPtr = ((void *)newobj) + instsize;
/*
- * dont argue about the goto and the arrangement below - it saves
+ * don't argue about the goto and the arrangement below - it saves
* an extra nil-compare and branch in the common case ...
* (i.e. if no GC is needed, we fall through without a branch)
*/
- if (nextPtr < __newEndPtr) {
- _objPtr(newobj)->o_size = instsize;
- /* o_allFlags(newobj) = 0; */
- /* _objPtr(newobj)->o_space = __newSpace; */
- o_setAllFlags(newobj, __newSpace);
+ if (nextPtr < (void *)__newEndPtr) {
+ _objPtr(newobj)->o_size = instsize;
+ /* o_allFlags(newobj) = 0; */
+ /* _objPtr(newobj)->o_space = __newSpace; */
+ o_setAllFlags(newobj, __newSpace);
#ifdef __HAS_ALIGN4__
- /*
- * if the alignment is 4, we are already sat,
- * since a non-indexed object always has a word-aligned size.
- */
- __newNextPtr = nextPtr;
+ /*
+ * if the alignment is 4, we are already sat,
+ * since a non-indexed object always has a word-aligned size.
+ */
+ __newNextPtr = nextPtr;
#else
- if (instsize & (__ALIGN__-1)) {
- __newNextPtr = (char *)newobj + (instsize & ~(__ALIGN__-1)) + __ALIGN__;
- } else {
- __newNextPtr = nextPtr;
- }
+ if (instsize & (__ALIGN__-1)) {
+ __newNextPtr = (void *)newobj + (instsize & ~(__ALIGN__-1)) + __ALIGN__;
+ } else {
+ __newNextPtr = nextPtr;
+ }
#endif
ok:
- __InstPtr(newobj)->o_class = self;
- __qSTORE(newobj, self);
-
- if (nInstVars) {
+ __InstPtr(newobj)->o_class = self;
+ __qSTORE(newobj, self);
+
+ if (nInstVars) {
#if defined(memset4) && defined(FAST_OBJECT_MEMSET4) || defined(FAST_MEMSET4)
- memset4(__InstPtr(newobj)->i_instvars, nil, nInstVars);
+ memset4(__InstPtr(newobj)->i_instvars, nil, nInstVars);
#else
- REGISTER OBJ *op;
-
- op = __InstPtr(newobj)->i_instvars;
-
- /*
- * knowing that nil is 0
- */
+ REGISTER OBJ *op = __InstPtr(newobj)->i_instvars;
+
+ /*
+ * knowing that nil is 0
+ */
# if defined(FAST_OBJECT_MEMSET_DOUBLES_UNROLLED)
- if (nInstVars > 8) {
- *op++ = nil; /* for alignment */
- nInstVars--;
- while (nInstVars >= 8) {
- *(double *)op = 0.0;
- ((double *)op)[1] = 0.0;
- ((double *)op)[2] = 0.0;
- ((double *)op)[3] = 0.0;
- op += 8;
- nInstVars -= 8;
- }
- }
- while (nInstVars != 0) {
- *op++ = 0;
- nInstVars--;
- }
+ if (nInstVars > 8) {
+ *op++ = nil; /* for alignment */
+ nInstVars--;
+ while (nInstVars >= 8) {
+ *(double *)op = 0.0;
+ ((double *)op)[1] = 0.0;
+ ((double *)op)[2] = 0.0;
+ ((double *)op)[3] = 0.0;
+ op += 8;
+ nInstVars -= 8;
+ }
+ }
+ while (nInstVars != 0) {
+ *op++ = 0;
+ nInstVars--;
+ }
# else
# if defined(FAST_OBJECT_MEMSET_LONGLONG_UNROLLED)
- if (nInstVars > 8) {
- *op++ = nil; /* for alignment */
- nInstVars--;
- while (nInstVars >= 8) {
- *(long long *)op = 0;
- ((long long *)op)[1] = 0;
- ((long long *)op)[2] = 0;
- ((long long *)op)[3] = 0;
- op += 8;
- nInstVars -= 8;
- }
- }
- while (nInstVars != 0) {
- *op++ = 0;
- nInstVars--;
- }
+ if (nInstVars > 8) {
+ *op++ = nil; /* for alignment */
+ nInstVars--;
+ while (nInstVars >= 8) {
+ *(long long *)op = 0;
+ ((long long *)op)[1] = 0;
+ ((long long *)op)[2] = 0;
+ ((long long *)op)[3] = 0;
+ op += 8;
+ nInstVars -= 8;
+ }
+ }
+ while (nInstVars != 0) {
+ *op++ = 0;
+ nInstVars--;
+ }
# else
# if defined(FAST_OBJECT_MEMSET_WORDS_UNROLLED)
- while (nInstVars >= 8) {
- *op = nil;
- *(op+1) = nil;
- *(op+2) = nil;
- *(op+3) = nil;
- *(op+4) = nil;
- *(op+5) = nil;
- *(op+6) = nil;
- *(op+7) = nil;
- op += 8;
- nInstVars -= 8;
- }
- while (nInstVars != 0) {
- *op++ = nil;
- nInstVars--;
- }
+ while (nInstVars >= 8) {
+ *op = nil;
+ *(op+1) = nil;
+ *(op+2) = nil;
+ *(op+3) = nil;
+ *(op+4) = nil;
+ *(op+5) = nil;
+ *(op+6) = nil;
+ *(op+7) = nil;
+ op += 8;
+ nInstVars -= 8;
+ }
+ while (nInstVars != 0) {
+ *op++ = nil;
+ nInstVars--;
+ }
# else
# if defined(FAST_MEMSET)
- memset(__InstPtr(newobj)->i_instvars, 0, instsize-OHDR_SIZE);
+ memset(__InstPtr(newobj)->i_instvars, 0, instsize-OHDR_SIZE);
# else
- while (nInstVars >= 8) {
- nInstVars -= 8;
- op[0] = nil; op[1] = nil;
- op[2] = nil; op[3] = nil;
- op[4] = nil; op[5] = nil;
- op[6] = nil; op[7] = nil;
- op += 8;
- }
- while (nInstVars != 0) {
- *op++ = nil;
- nInstVars--;
- }
+ while (nInstVars >= 8) {
+ nInstVars -= 8;
+ op[0] = nil; op[1] = nil;
+ op[2] = nil; op[3] = nil;
+ op[4] = nil; op[5] = nil;
+ op[6] = nil; op[7] = nil;
+ op += 8;
+ }
+ while (nInstVars != 0) {
+ *op++ = nil;
+ nInstVars--;
+ }
# endif
# endif
# endif
# endif
#endif
- }
- RETURN ( newobj );
+ }
+ RETURN ( newobj );
}
/*
@@ -2985,17 +2989,17 @@
|dict oldMethod|
newMethod isNil ifTrue:[
- self error:'invalid method'.
+ self error:'invalid method'.
].
- (Smalltalk
- changeRequest:#methodInClass
- with:(Array with:self with:aSelector with:oldMethod)) ifFalse:[
- ^ false
- ].
- "/ oldMethod := self compiledMethodAt:aSelector.
dict := self methodDictionary.
- "/ oldMethod := dict at:aSelector ifAbsent:nil.
+ oldMethod := dict at:aSelector ifAbsent:nil.
+
+ (Smalltalk
+ changeRequest:#methodInClass
+ with:(Array with:self with:aSelector with:oldMethod)) ifFalse:[
+ ^ false
+ ].
self setMethodDictionary:(dict at:aSelector putOrAppend:newMethod).
newMethod mclass:self.
@@ -4312,12 +4316,12 @@
"JV @ 2010-08-22: Rewritten to respect lookup object."
(l := self lookupObject) notNil ifTrue:[
- ^ (l
- lookupMethodForSelector:aSelector
- directedTo:self
- for: nil "Fake receiver"
- withArguments: nil "Fake arguments"
- from: thisContext sender) notNil
+ ^ (l
+ lookupMethodForSelector:aSelector
+ directedTo:self
+ for: nil "Fake receiver"
+ withArguments: nil "Fake arguments"
+ from: thisContext methodHome sender) notNil
].
"Original implementation"
@@ -4542,27 +4546,27 @@
"JV @ 2010-08-22: Rewritten to respect lookup object."
(l := self lookupObject) notNil ifTrue:[
- ^ (l
- lookupMethodForSelector:aSelector
- directedTo:self
- for: nil "Fake receiver"
- withArguments: nil "Fake arguments"
- from: thisContext sender)
+ ^ (l
+ lookupMethodForSelector:aSelector
+ directedTo:self
+ for: nil "Fake receiver"
+ withArguments: nil "Fake arguments"
+ from: thisContext methodHome sender)
].
cls := self.
[cls notNil] whileTrue:[
- m := cls compiledMethodAt:aSelector.
- m notNil ifTrue:[^ m].
- cls hasMultipleSuperclasses ifTrue:[
- cls superclasses do:[:aSuperClass |
- m := aSuperClass lookupMethodFor:aSelector.
- m notNil ifTrue:[^ m].
- ].
- ^ nil
- ] ifFalse:[
- cls := cls superclass
- ]
+ m := cls compiledMethodAt:aSelector.
+ m notNil ifTrue:[^ m].
+ cls hasMultipleSuperclasses ifTrue:[
+ cls superclasses do:[:aSuperClass |
+ m := aSuperClass lookupMethodFor:aSelector.
+ m notNil ifTrue:[^ m].
+ ].
+ ^ nil
+ ] ifFalse:[
+ cls := cls superclass
+ ]
].
^ nil
!
@@ -4948,10 +4952,10 @@
!Behavior class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.340 2013-04-19 11:32:07 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.341 2013-05-07 19:53:10 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.340 2013-04-19 11:32:07 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.341 2013-05-07 19:53:10 stefan Exp $'
! !