--- a/Behavior.st Wed Jan 23 18:57:32 2013 +0100
+++ b/Behavior.st Wed Jan 23 19:00:00 2013 +0100
@@ -1187,30 +1187,30 @@
|oldMethod ns selector newLookupObject|
(newSelector isMemberOf:Symbol) ifFalse:[
- self error:'invalid selector'.
+ self error:'invalid selector'.
].
ns := newMethod nameSpace.
(ns notNil and:[ns ~= self programmingLanguage defaultSelectorNameSpacePrefix]) ifTrue:[
- selector := (':' , ns , '::' , newSelector) asSymbol.
- newLookupObject := Smalltalk at: #NamespaceAwareLookup. "/ so it can be nilled to disable that feature
+ selector := (':' , ns , '::' , newSelector) asSymbol.
+ newLookupObject := Smalltalk at: #NamespaceAwareLookup. "/ so it can be nilled to disable that feature
] ifFalse:[
- selector := newSelector
+ selector := newSelector
].
"/ Q (cg): isn't that something that the caller should decide?
oldMethod := self compiledMethodAt:selector.
oldMethod notNil ifTrue:[
- newMethod restricted:(oldMethod isRestricted).
- newMethod setPrivacy:(oldMethod privacy) flushCaches:false.
+ newMethod restricted:(oldMethod isRestricted).
+ newMethod setPrivacy:(oldMethod privacy) flushCaches:false.
].
(self primAddSelector:selector withMethod:newMethod) ifFalse:[^ false].
newLookupObject notNil ifTrue:[
- lookupObject ~= newLookupObject ifTrue:[
- self lookupObject: newLookupObject
- ]
+ lookupObject ~= newLookupObject ifTrue:[
+ self lookupObject: newLookupObject
+ ]
].
"
@@ -1220,12 +1220,12 @@
"
"
problem: this is slower; since looking for all subclasses is (currently)
- a bit slow :-(
- We need the hasSubclasses-info bit in Behavior; now
+ a bit slow :-(
+ We need the hasSubclasses-info bit in Behavior; now
self withAllSubclassesDo:[:aClass |
- ObjectMemory flushInlineCachesFor:aClass withArgs:nargs.
- ObjectMemory flushMethodCacheFor:aClass
+ ObjectMemory flushInlineCachesFor:aClass withArgs:nargs.
+ ObjectMemory flushMethodCacheFor:aClass
].
"
@@ -1340,11 +1340,11 @@
(anObject respondsTo: #lookupMethodForSelector:directedTo:for:withArguments:from:)
ifFalse:[
- self error:'Lookup object does not respond to #lookupMethodForSelector:directedTo:for:withArguments:from:'
+ self error:'Lookup object does not respond to #lookupMethodForSelector:directedTo:for:withArguments:from:'
].
(anObject respondsTo:#superLookupObject:)
ifTrue:[
- anObject superLookupObject: self lookupObject
+ anObject superLookupObject: self lookupObject
].
self setLookupObject: anObject.
@@ -2010,8 +2010,8 @@
%{ /* NOCONTEXT */
REGISTER OBJ newobj;
REGISTER char *nextPtr;
- unsigned int instsize;
- REGISTER unsigned int nInstVars;
+ unsigned INT instsize;
+ REGISTER unsigned INT nInstVars;
/*
* the following ugly code is nothing more than a __new() followed
@@ -2122,10 +2122,18 @@
# if defined(FAST_MEMSET)
memset(__InstPtr(newobj)->i_instvars, 0, instsize-OHDR_SIZE);
# else
- do {
+ 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 != 0);
+ }
# endif
# endif
# endif
@@ -2139,7 +2147,7 @@
* the slow case - a GC will occur
*/
__PROTECT_CONTEXT__
- newobj = __STX___new(instsize);
+ newobj = __STX___new((INT)instsize);
__UNPROTECT_CONTEXT__
if (newobj != nil) goto ok;
%}
@@ -2164,7 +2172,8 @@
%{ /* NOCONTEXT */
OBJ newobj;
- unsigned INT instsize, nInstVars;
+ unsigned INT nInstVars;
+ unsigned INT instsize;
INT nindexedinstvars;
unsigned INT flags;
#if ! defined(FAST_ARRAY_MEMSET)
@@ -2202,10 +2211,10 @@
memset(__InstPtr(newobj)->i_instvars, 0, nindexedinstvars);
# else
cp = (char *)__InstPtr(newobj)->i_instvars;
- while (nindexedinstvars >= sizeof(long)) {
- *(long *)cp = 0;
- cp += sizeof(long);
- nindexedinstvars -= sizeof(long);
+ while (nindexedinstvars >= sizeof(INT)) {
+ *(INT *)cp = (INT)0;
+ cp += sizeof(INT);
+ nindexedinstvars -= sizeof(INT);
}
while (nindexedinstvars--)
*cp++ = '\0';
@@ -2240,10 +2249,10 @@
while (nInstVars--)
*op++ = nil;
cp = (char *)op;
- while (nindexedinstvars >= sizeof(long)) {
- *(long *)cp = 0;
- cp += sizeof(long);
- nindexedinstvars -= sizeof(long);
+ while (nindexedinstvars >= sizeof(INT)) {
+ *(INT *)cp = 0;
+ cp += sizeof(INT);
+ nindexedinstvars -= sizeof(INT);
}
while (nindexedinstvars--)
*cp++ = '\0';
@@ -2499,6 +2508,14 @@
memset(__InstPtr(newobj)->i_instvars, 0, instsize - OHDR_SIZE);
# else
op = __InstPtr(newobj)->i_instvars;
+ 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--)
*op++ = nil;
# endif
@@ -2799,13 +2816,13 @@
<resource: #programImage>
self isLoaded ifFalse:[
- ^ #autoloadedClassBrowserIcon
+ ^ #autoloadedClassBrowserIcon
].
(self isBrowserStartable) ifTrue:[
- self isVisualStartable ifTrue:[
- ^ #visualStartableClassBrowserIcon
- ].
- ^ #startableClassBrowserIcon
+ self isVisualStartable ifTrue:[
+ ^ #visualStartableClassBrowserIcon
+ ].
+ ^ #startableClassBrowserIcon
].
"/ give ruby and other special metaclasses a chance to provide their own icon...
@@ -2845,7 +2862,7 @@
"/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
"/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
(aGCOrStream isStream) ifFalse:[
- ^ super displayOn:aGCOrStream
+ ^ super displayOn:aGCOrStream
].
aGCOrStream nextPutAll:self name
@@ -3050,9 +3067,9 @@
has to provide a method object for message sends."
lookupObject ~~ aMethodLookupObject ifTrue:[
- lookupObject := aMethodLookupObject.
- ObjectMemory flushCachesFor: self.
- self allSubclassesDo:[:cls|ObjectMemory flushCachesFor: cls]
+ lookupObject := aMethodLookupObject.
+ ObjectMemory flushCachesFor: self.
+ self allSubclassesDo:[:cls|ObjectMemory flushCachesFor: cls]
]
"Modified: / 22-07-2010 / 18:10:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -3451,13 +3468,13 @@
^ superclass commonSuperclass:aClass
"
- Integer commonSuperclass:Fraction
- SmallInteger commonSuperclass:Fraction
- View commonSuperclass:Form
- View commonSuperclass:Image
- View commonSuperclass:View
- Integer commonSuperclass:Autoload
- Integer commonSuperclass:Object
+ Integer commonSuperclass:Fraction
+ SmallInteger commonSuperclass:Fraction
+ View commonSuperclass:Form
+ View commonSuperclass:Image
+ View commonSuperclass:View
+ Integer commonSuperclass:Autoload
+ Integer commonSuperclass:Object
"
"Modified (comment): / 17-03-2012 / 19:56:28 / cg"
@@ -3597,7 +3614,7 @@
coll := OrderedCollection new.
self withAllSuperclassesDo:[:cls |
- coll add:cls
+ coll add:cls
].
^ coll
@@ -4268,8 +4285,8 @@
dict := self methodDictionary.
dict isNil ifTrue:[
- ('Behavior [warning]: nil methodDictionary in ' , self name printString) errorPrintCR.
- ^ exceptionValue value
+ ('Behavior [warning]: nil methodDictionary in ' , self name printString) errorPrintCR.
+ ^ exceptionValue value
].
"Quick check: look into method dictionary"
mth := dict at: name asSymbol ifAbsent:nil.
@@ -4277,8 +4294,8 @@
"Slow search..."
dict do: [:each|
- (each isSynthetic not and:[each name = name])
- ifTrue:[^each]
+ (each isSynthetic not and:[each name = name])
+ ifTrue:[^each]
].
^exceptionValue value
@@ -4685,8 +4702,8 @@
!
whichSelectorsRead: instVarName
- "Answer a set of selectors whose methods read the argument, instVarName,
- as a named instance variable."
+ "Answer a set of selectors whose methods read the argument, instVarName,
+ as a named instance variable."
"/ | instVarIndex methodDict|
"/ instVarIndex := self allInstVarNames indexOf: instVarName ifAbsent: [^Set new].
@@ -4694,10 +4711,10 @@
"/ ^methodDict keys select: [:sel | (methodDict at: sel)
"/ readsField: instVarIndex]
- | methodDict |
- methodDict := self methodDictionary.
- ^ methodDict keys
- select: [:sel | (methodDict at: sel) readsInstVar: instVarName]
+ | methodDict |
+ methodDict := self methodDictionary.
+ ^ methodDict keys
+ select: [:sel | (methodDict at: sel) readsInstVar: instVarName]
"Modified: / 23-07-2012 / 11:22:04 / cg"
!
@@ -4755,18 +4772,18 @@
!
whichSelectorsWrite: instVarName
- "Answer a set of selectors whose methods write the argument, instVarName,
- as a named instance variable."
+ "Answer a set of selectors whose methods write the argument, instVarName,
+ as a named instance variable."
"/ | instVarIndex methodDict |
"/ instVarIndex := self allInstVarNames indexOf: instVarName ifAbsent: [^Set new].
"/ methodDict := self methodDictionary.
"/ ^methodDict keys select: [:sel | (methodDict at: sel)
"/ writesField: instVarIndex]
- | methodDict |
- methodDict := self methodDictionary.
- ^ methodDict keys
- select: [:sel | (methodDict at: sel) writesInstVar: instVarName]
+ | methodDict |
+ methodDict := self methodDictionary.
+ ^ methodDict keys
+ select: [:sel | (methodDict at: sel) writesInstVar: instVarName]
"Modified: / 23-07-2012 / 11:21:17 / cg"
! !
@@ -4809,9 +4826,9 @@
!Behavior class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.329 2012-12-11 17:26:07 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.330 2013-01-23 18:00:00 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.329 2012-12-11 17:26:07 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.330 2013-01-23 18:00:00 cg Exp $'
! !