--- a/Object.st Fri Aug 12 13:58:52 2011 +0100
+++ b/Object.st Thu Aug 18 10:37:43 2011 +0100
@@ -526,9 +526,6 @@
! !
-
-
-
!Object methodsFor:'Compatibility-Dolphin'!
stbFixup: anSTBInFiler at: newObjectIndex
@@ -690,8 +687,6 @@
"
! !
-
-
!Object methodsFor:'accessing'!
_at:index
@@ -1891,7 +1886,6 @@
^ self
! !
-
!Object methodsFor:'comparing'!
= anObject
@@ -4889,7 +4883,8 @@
action title screen|
thisContext isRecursive ifTrue:[
- 'severe error: signalInterrupt while processing a signalInterrupt. Terminate this process' errorPrintCR.
+ 'Severe error: signalInterrupt while processing a signalInterrupt.' errorPrintCR.
+ 'Terminating process ' errorPrint. Processor activeProcess errorPrintCR.
GenericException handle:[:ex |
"/ ignore any error during termination
] do:[
@@ -5046,7 +5041,7 @@
"action == #ignore"
].
- "Modified: / 31-01-2011 / 13:04:46 / cg"
+ "Modified: / 10-08-2011 / 19:58:20 / cg"
!
spyInterrupt
@@ -7041,13 +7036,16 @@
"helper for error messages - evaluate alock, passing it a stream on which to put
error messages."
- |s|
-
- s := Processor activeProcess isSystemProcess
+ |stream|
+
+ stream := Processor activeProcess isSystemProcess
ifTrue:[Stderr]
ifFalse:[Transcript].
StreamError catch:[
- aBlock value:s.
+ aBlock value:stream.
+ ].
+ stream == Stderr ifFalse:[
+ aBlock value:Stderr.
].
"Created: / 21-04-2011 / 12:46:21 / cg"
@@ -7241,7 +7239,6 @@
^ self
! !
-
!Object methodsFor:'secure message sending'!
?: selector
@@ -7844,7 +7841,6 @@
"
! !
-
!Object methodsFor:'synchronized evaluation'!
freeSynchronizationSemaphore
@@ -9434,7 +9430,7 @@
!Object class methodsFor:'documentation'!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Object.st,v 1.672 2011/08/08 09:35:16 sr Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Object.st,v 1.673 2011/08/10 17:59:30 cg Exp §'
!
version_SVN
@@ -9444,3 +9440,4 @@
Object initialize!
+
--- a/ObjectMemory.st Fri Aug 12 13:58:52 2011 +0100
+++ b/ObjectMemory.st Thu Aug 18 10:37:43 2011 +0100
@@ -970,12 +970,12 @@
!ObjectMemory class methodsFor:'cache management'!
debugBreakPoint3
-
+
%{
#ifndef WIN32
/*extern void __debugBreakPoint3__();*/
__debugBreakPoint3__();
-#endif
+#endif
%}.
^ 0
@@ -1073,11 +1073,11 @@
!
ilcMisses: newValue
-
+
newValue class == SmallInteger ifFalse:[^self error:'Not an integer value'].
%{ /* NOCONTEXT */
/*extern int __ilcMisses(int);*/
-#ifdef ILC_PROFILING
+#ifdef ILC_PROFILING
RETURN ( __MKSMALLINT ( __ilcMisses ( __intVal ( newValue ) ) ) );
#endif
%}.
@@ -1086,10 +1086,10 @@
!
ilcMissesTrace: bool
-
+
%{
/*extern int __ilcMissesTrace(int);*/
-#ifdef ILC_PROFILING
+#ifdef ILC_PROFILING
RETURN ( __ilcMissesTrace ( bool == true ) ? true : false );
#endif
%}.
@@ -1275,29 +1275,29 @@
lbl origin:(0.0@0.0) corner:(1.0@0.0).
h := lbl preferredHeight.
lbl
- topInset:5;
- bottomInset:(h+5) negated;
- leftInset:5;
- rightInset:5.
+ topInset:5;
+ bottomInset:(h+5) negated;
+ leftInset:5;
+ rightInset:5.
progress := ProgressIndicator in:top.
progress origin:(0.0@45) corner:(1.0@45).
progress level:-1.
h := progress preferredHeight.
progress
- topInset:(h // 2) negated;
- bottomInset:(h // 2) negated;
- leftInset:5;
- rightInset:5.
+ topInset:(h // 2) negated;
+ bottomInset:(h // 2) negated;
+ leftInset:5;
+ rightInset:5.
progress beInvisible.
listV := HVScrollableView for:SelectionInListView in:top.
listV origin:(0.0@55) corner:(1.0@1.0).
listV
- topInset:(h // 2);
- bottomInset:40;
- leftInset:5;
- rightInset:5.
+ topInset:(h // 2);
+ bottomInset:40;
+ leftInset:5;
+ rightInset:5.
listV beInvisible.
panel := HorizontalPanelView in:top.
@@ -1336,247 +1336,247 @@
firstRound := true.
[done] whileFalse:[
- anyShown := false.
-
- progress percentage:0.
- firstRound ifTrue:[
- firstRound := false.
- ] ifFalse:[
- lbl label:'compressing garbage ...'.
- self garbageCollect.
- ].
-
- lbl label:('searching level '
- , levels size printString
- , ' (' , objects size printString , ' refs) ...').
- nAll := objects size.
- nDone := 0.
-
- objectArray := objects asArray.
-
- owners := "Weak"IdentitySet new.
-
- numObjectsDone := 0.
- found := false.
-
- AbortSignal handle:[]
- do:[
- [self allObjectsDo:[:o |
- |inPrevLevel isOwner|
-
- stop ifTrue:[AbortSignal raise].
- stop ifFalse:[
- isOwner := false.
- (o referencesAny:objectArray) ifTrue:[
- o isBehavior ifTrue:[
- o == Smalltalk ifTrue:[
- found := true.
- ] ifFalse:[
- "/ only add it if it has classInstVars
- o instSize ~~ Class instSize ifTrue:[
- isOwner := true.
- ]
- ]
- ] ifFalse:[
- o class ~~ WeakArray ifTrue:[
- isOwner := true.
- ]
- ].
- ].
-
- isOwner ifTrue:[
- (objects includesIdentical:o) ifFalse:[
- inPrevLevel := false.
- levels do:[:lColl |
- lColl == o ifTrue:[
- inPrevLevel := true
- ] ifFalse:[
- (lColl includesIdentical:o) ifTrue:[inPrevLevel := true].
- ]
- ].
- inPrevLevel ifFalse:[
- owners add:o.
- (limitOrNil notNil and:[owners size >= limitOrNil]) ifTrue:[
- AbortSignal raise
- ].
- ]
- ]
- ].
-
- numObjectsDone := numObjectsDone + 1.
- numObjects notNil ifTrue:[
- numObjectsDone \\ 1000 == 0 ifTrue:[
- progress percentage:(numObjectsDone / numObjects * 100).
- Processor yield.
- ]
- ]
- ]
- ]] whileFalse.
- ].
- progress percentage:100.
-
- numObjects isNil ifTrue:[
- numObjects := numObjectsDone.
- ].
-
- owners remove:aCollection ifAbsent:nil.
- owners remove:thisContext ifAbsent:nil.
- owners remove:objectArray ifAbsent:nil.
- owners remove:objects keyArray ifAbsent:nil.
- owners remove:owners keyArray ifAbsent:nil.
+ anyShown := false.
+
+ progress percentage:0.
+ firstRound ifTrue:[
+ firstRound := false.
+ ] ifFalse:[
+ lbl label:'compressing garbage ...'.
+ self garbageCollect.
+ ].
+
+ lbl label:('searching level '
+ , levels size printString
+ , ' (' , objects size printString , ' refs) ...').
+ nAll := objects size.
+ nDone := 0.
+
+ objectArray := objects asArray.
+
+ owners := "Weak"IdentitySet new.
+
+ numObjectsDone := 0.
+ found := false.
+
+ AbortSignal handle:[]
+ do:[
+ [self allObjectsDo:[:o |
+ |inPrevLevel isOwner|
+
+ stop ifTrue:[AbortSignal raise].
+ stop ifFalse:[
+ isOwner := false.
+ (o referencesAny:objectArray) ifTrue:[
+ o isBehavior ifTrue:[
+ o == Smalltalk ifTrue:[
+ found := true.
+ ] ifFalse:[
+ "/ only add it if it has classInstVars
+ o instSize ~~ Class instSize ifTrue:[
+ isOwner := true.
+ ]
+ ]
+ ] ifFalse:[
+ o class ~~ WeakArray ifTrue:[
+ isOwner := true.
+ ]
+ ].
+ ].
+
+ isOwner ifTrue:[
+ (objects includesIdentical:o) ifFalse:[
+ inPrevLevel := false.
+ levels do:[:lColl |
+ lColl == o ifTrue:[
+ inPrevLevel := true
+ ] ifFalse:[
+ (lColl includesIdentical:o) ifTrue:[inPrevLevel := true].
+ ]
+ ].
+ inPrevLevel ifFalse:[
+ owners add:o.
+ (limitOrNil notNil and:[owners size >= limitOrNil]) ifTrue:[
+ AbortSignal raise
+ ].
+ ]
+ ]
+ ].
+
+ numObjectsDone := numObjectsDone + 1.
+ numObjects notNil ifTrue:[
+ numObjectsDone \\ 1000 == 0 ifTrue:[
+ progress percentage:(numObjectsDone / numObjects * 100).
+ Processor yield.
+ ]
+ ]
+ ]
+ ]] whileFalse.
+ ].
+ progress percentage:100.
+
+ numObjects isNil ifTrue:[
+ numObjects := numObjectsDone.
+ ].
+
+ owners remove:aCollection ifAbsent:nil.
+ owners remove:thisContext ifAbsent:nil.
+ owners remove:objectArray ifAbsent:nil.
+ owners remove:objects keyArray ifAbsent:nil.
+ owners remove:owners keyArray ifAbsent:nil.
"/ 'done with level: ' print. levels size print. ' found ' print. owners size print. ' refs' printCR.
- owners isEmpty ifTrue:[
- found ifFalse:[
- stop := true.
- ]
- ].
-
- stop ifFalse:[
- done := found or:[(owners includesIdentical:Smalltalk)].
- done ifTrue:[
- moreChainsOnThisLevel := true.
- temporaryRemoved := IdentitySet new.
-
- levels size > 0 ifTrue:[
- "/ show what we found so far.
- levels last add:Smalltalk.
- levels reverse.
- ].
-
- chains := OrderedCollection new.
-
- tLevels := levels collect:[:lColl | lColl copy].
-
- lbl label:('building refchains ...').
-
- nAll := aCollection size.
- nDone := 0.
- aCollection do:[:anObject | |theseChains|
- stop ifFalse:[
- theseChains := self
- refChainsFrom:Smalltalk
- to:anObject
- inRefSets:tLevels
- startingAt:1.
-
- theseChains size > 0 ifTrue:[
- chains addAll:theseChains
- ].
- nDone := nDone + 1.
- progress percentage:(nDone / nAll * 100).
- ]
- ].
-
- tLevels := nil.
-
- levels size > 0 ifTrue:[
- levels reverse.
- levels last remove:Smalltalk.
- ].
-
- [stop not
- and:[chains size > 0]] whileTrue:[
- chain := chains first.
- chains removeFirst.
-
- lbl label:('found a reference chain.').
- progress beInvisible.
-
- chain addFirst:Smalltalk.
- list := OrderedCollection withSize:chain size.
- 1 to:chain size-1 do:[:i |
- list
- at:i
- put:(self refNameFor:(chain at:i+1) in:(chain at:i))
- ].
- list at:list size put:(chain last classNameWithArticle).
-
- "/ hide the VMProcesses stuff from the user ...
- (list at:1) string = 'Smalltalk:__VMProcesses__' ifTrue:[
- list at:1 put:'__VMProcesses__ (a hidden VM reference)'.
- list removeIndex:2.
- chain at:1 put:nil.
- chain removeIndex:2.
- ].
-
- listV list:list.
-
- listV beVisible.
- listV doubleClickAction:[:idx | |o|
- (o := chain at:idx) notNil ifTrue:[
- o inspect.
- ]
- ].
- moreButton beVisible.
- anyShown := anyShownInAnyLevel := true.
- showMore := false.
-
- "/ kludge - wait for some user action
-
- [showMore or:[stop or:[top realized not]]] whileFalse:[
- Delay waitForSeconds:0.1
- ].
-
- chain := nil.
-
- top realized ifFalse:[
- stop := true
- ] ifTrue:[
- listV doubleClickAction:nil.
- showMore ifFalse:[
- stop := true.
- ].
- ].
- done := false.
-
- stop ifFalse:[
- progress beVisible.
- listV beInvisible.
- moreButton beInvisible.
-
- chain := nil.
- ]
- ].
- levels size > 0 ifTrue:[
- levels last addAll:temporaryRemoved.
- ]
- ].
- ].
-
- owners remove:Smalltalk ifAbsent:nil.
- owners remove:(owners keyArray) ifAbsent:nil.
- owners remove:objectArray ifAbsent:nil.
- levels do:[:lColl |
- owners remove:lColl ifAbsent:nil
- ].
-
- levels add:owners.
-
- objects := owners.
-
- objects size == 0 ifTrue:[
- stop := true
- ].
-
- stop ifTrue:[
- Smalltalk at:#'__VMProcesses__' put:nil.
- top destroy.
- anyShown ifFalse:[
- userStop ifFalse:[
- self information:(anyShownInAnyLevel ifTrue:['no more references'] ifFalse:['no references']).
- ]
- ].
- ^ self.
- ].
+ owners isEmpty ifTrue:[
+ found ifFalse:[
+ stop := true.
+ ]
+ ].
+
+ stop ifFalse:[
+ done := found or:[(owners includesIdentical:Smalltalk)].
+ done ifTrue:[
+ moreChainsOnThisLevel := true.
+ temporaryRemoved := IdentitySet new.
+
+ levels size > 0 ifTrue:[
+ "/ show what we found so far.
+ levels last add:Smalltalk.
+ levels reverse.
+ ].
+
+ chains := OrderedCollection new.
+
+ tLevels := levels collect:[:lColl | lColl copy].
+
+ lbl label:('building refchains ...').
+
+ nAll := aCollection size.
+ nDone := 0.
+ aCollection do:[:anObject | |theseChains|
+ stop ifFalse:[
+ theseChains := self
+ refChainsFrom:Smalltalk
+ to:anObject
+ inRefSets:tLevels
+ startingAt:1.
+
+ theseChains size > 0 ifTrue:[
+ chains addAll:theseChains
+ ].
+ nDone := nDone + 1.
+ progress percentage:(nDone / nAll * 100).
+ ]
+ ].
+
+ tLevels := nil.
+
+ levels size > 0 ifTrue:[
+ levels reverse.
+ levels last remove:Smalltalk.
+ ].
+
+ [stop not
+ and:[chains size > 0]] whileTrue:[
+ chain := chains first.
+ chains removeFirst.
+
+ lbl label:('found a reference chain.').
+ progress beInvisible.
+
+ chain addFirst:Smalltalk.
+ list := OrderedCollection withSize:chain size.
+ 1 to:chain size-1 do:[:i |
+ list
+ at:i
+ put:(self refNameFor:(chain at:i+1) in:(chain at:i))
+ ].
+ list at:list size put:(chain last classNameWithArticle).
+
+ "/ hide the VMProcesses stuff from the user ...
+ (list at:1) string = 'Smalltalk:__VMProcesses__' ifTrue:[
+ list at:1 put:'__VMProcesses__ (a hidden VM reference)'.
+ list removeIndex:2.
+ chain at:1 put:nil.
+ chain removeIndex:2.
+ ].
+
+ listV list:list.
+
+ listV beVisible.
+ listV doubleClickAction:[:idx | |o|
+ (o := chain at:idx) notNil ifTrue:[
+ o inspect.
+ ]
+ ].
+ moreButton beVisible.
+ anyShown := anyShownInAnyLevel := true.
+ showMore := false.
+
+ "/ kludge - wait for some user action
+
+ [showMore or:[stop or:[top realized not]]] whileFalse:[
+ Delay waitForSeconds:0.1
+ ].
+
+ chain := nil.
+
+ top realized ifFalse:[
+ stop := true
+ ] ifTrue:[
+ listV doubleClickAction:nil.
+ showMore ifFalse:[
+ stop := true.
+ ].
+ ].
+ done := false.
+
+ stop ifFalse:[
+ progress beVisible.
+ listV beInvisible.
+ moreButton beInvisible.
+
+ chain := nil.
+ ]
+ ].
+ levels size > 0 ifTrue:[
+ levels last addAll:temporaryRemoved.
+ ]
+ ].
+ ].
+
+ owners remove:Smalltalk ifAbsent:nil.
+ owners remove:(owners keyArray) ifAbsent:nil.
+ owners remove:objectArray ifAbsent:nil.
+ levels do:[:lColl |
+ owners remove:lColl ifAbsent:nil
+ ].
+
+ levels add:owners.
+
+ objects := owners.
+
+ objects size == 0 ifTrue:[
+ stop := true
+ ].
+
+ stop ifTrue:[
+ Smalltalk at:#'__VMProcesses__' put:nil.
+ top destroy.
+ anyShown ifFalse:[
+ userStop ifFalse:[
+ self information:(anyShownInAnyLevel ifTrue:['no more references'] ifFalse:['no references']).
+ ]
+ ].
+ ^ self.
+ ].
].
anyShown ifTrue:[
- userStop ifFalse:[
- self information:'no more references'.
- ]
+ userStop ifFalse:[
+ self information:'no more references'.
+ ]
].
Smalltalk at:#'__VMProcesses__' put:nil.
^ self
@@ -1810,37 +1810,37 @@
|names oClass|
referent == Smalltalk ifTrue:[
- referent keysAndValuesDo:[:key :val |
- |idx|
-
- (anObject == val) ifTrue:[
- "/ for our convenience - if its a nameSpace, cut off Smalltalk.
- idx := key string indexOf:$:.
- (idx ~~ 0
- and:[idx < key string size
- and:[(key string at:(idx+1)) == $:]]) ifTrue:[
- ^ key allBold "/ (key copyFrom:(idx+2)) allBold
- ].
- ^ 'Smalltalk:' , (key allBold).
- ]
- ].
+ referent keysAndValuesDo:[:key :val |
+ |idx|
+
+ (anObject == val) ifTrue:[
+ "/ for our convenience - if its a nameSpace, cut off Smalltalk.
+ idx := key string indexOf:$:.
+ (idx ~~ 0
+ and:[idx < key string size
+ and:[(key string at:(idx+1)) == $:]]) ifTrue:[
+ ^ key allBold "/ (key copyFrom:(idx+2)) allBold
+ ].
+ ^ 'Smalltalk:' , (key allBold).
+ ]
+ ].
] ifFalse:[
- names := referent class allInstVarNames.
- oClass := referent class.
- 1 to:oClass instSize do:[:i |
- ((referent instVarAt:i) == anObject) ifTrue:[
- ^ '%1 [%2]' bindWith:referent classNameWithArticle with:(names at:i) allBold.
- ].
- ].
- oClass isVariable ifTrue:[
- oClass isPointers ifTrue:[
- 1 to:referent basicSize do:[:i |
- ((referent basicAt:i) == anObject) ifTrue:[
- ^ '%1 [%2] (sz=%2)' bindWith:referent classNameWithArticle with:i printString allBold with:referent basicSize printString
- ]
- ]
- ]
- ].
+ names := referent class allInstVarNames.
+ oClass := referent class.
+ 1 to:oClass instSize do:[:i |
+ ((referent instVarAt:i) == anObject) ifTrue:[
+ ^ '%1 [%2]' bindWith:referent classNameWithArticle with:(names at:i) allBold.
+ ].
+ ].
+ oClass isVariable ifTrue:[
+ oClass isPointers ifTrue:[
+ 1 to:referent basicSize do:[:i |
+ ((referent basicAt:i) == anObject) ifTrue:[
+ ^ '%1 [%2] (sz=%2)' bindWith:referent classNameWithArticle with:i printString allBold with:referent basicSize printString
+ ]
+ ]
+ ]
+ ].
].
self error:'no reference' mayProceed:true.
^ nil.
@@ -2368,7 +2368,7 @@
"resume the background collector process"
BackgroundCollectProcess notNil ifTrue:[
- BackgroundCollectProcess resume.
+ BackgroundCollectProcess resume.
]
"
@@ -2504,9 +2504,9 @@
backgroundCollectorWasRunning := false.
BackgroundCollectProcess notNil ifTrue:[
- "suspend doesn't work due to interrupt processing"
- backgroundCollectorWasRunning := BackgroundCollectProcess isStopped not.
- BackgroundCollectProcess stop.
+ "suspend doesn't work due to interrupt processing"
+ backgroundCollectorWasRunning := BackgroundCollectProcess isStopped not.
+ BackgroundCollectProcess stop.
].
^ backgroundCollectorWasRunning
@@ -2787,7 +2787,7 @@
|result|
-%{
+%{
extern int __fastMoreOldSpaceAllocation();
result = __fastMoreOldSpaceAllocation(aBoolean == true ? 1 : 0) ? true : false;
@@ -2801,11 +2801,11 @@
previousSetting := ObjectMemory fastMoreOldSpaceAllocation:true.
[
- ...
- allocate your huge data
- ...
+ ...
+ allocate your huge data
+ ...
] ensure:[
- ObjectMemory fastMoreOldSpaceAllocation:previousSetting
+ ObjectMemory fastMoreOldSpaceAllocation:previousSetting
]
"
@@ -2831,15 +2831,15 @@
|result|
-%{
+%{
extern unsigned int __fastMoreOldSpaceLimit();
if (__isInteger(aNumber)) {
- result = __MKUINT( __fastMoreOldSpaceLimit(__unsignedLongIntVal(aNumber)));
+ result = __MKUINT( __fastMoreOldSpaceLimit(__unsignedLongIntVal(aNumber)));
}
%}.
result isNil ifTrue:[
- ^ 0.
+ ^ 0.
].
self saveGarbageCollectorSetting:#fastMoreOldSpaceLimit: value:aNumber.
^ result.
@@ -3000,7 +3000,7 @@
%{
if (flag == true) {
- __tenure(__context);
+ __tenure(__context);
}
__lockTenure(flag == true ? 1 : 0);
%}.
@@ -3043,29 +3043,29 @@
If zero, it will allocate forever (until the OS wont hand out more).
The default is zero.
WARNING:
- an oldSpace limit may lead to trashing due to exorbitant GC activity;
- its usually better to let it allocate more and page in/page out.
- Usually, the background GC will catch up sooner or later and reclaim
- the memory without blocking the system"
-
+ an oldSpace limit may lead to trashing due to exorbitant GC activity;
+ its usually better to let it allocate more and page in/page out.
+ Usually, the background GC will catch up sooner or later and reclaim
+ the memory without blocking the system"
+
|result|
-%{
+%{
extern unsigned __maxOldSpace();
if (__isInteger(amount)) {
- result = __MKUINT( __maxOldSpace(__unsignedLongIntVal(amount)));
+ result = __MKUINT( __maxOldSpace(__unsignedLongIntVal(amount)));
}
%}.
result notNil ifTrue:[
- self saveGarbageCollectorSetting:#maxOldSpace: value:amount.
- ^ result.
+ self saveGarbageCollectorSetting:#maxOldSpace: value:amount.
+ ^ result.
].
^ 0
"
to change maximum to 1GByte:
- ObjectMemory maxOldSpace:1024*1024*1024
+ ObjectMemory maxOldSpace:1024*1024*1024
"
!
@@ -3129,9 +3129,9 @@
Experimental: this interface may valish without notice.
DANGER ALERT:
- be careful too big of a size may lead to longer scavenge pauses.
- Too small of a newSpace may lead to more CPU overhead, due to
- excessive scavenges. You have been warned."
+ be careful too big of a size may lead to longer scavenge pauses.
+ Too small of a newSpace may lead to more CPU overhead, due to
+ excessive scavenges. You have been warned."
|result|
@@ -3139,14 +3139,14 @@
extern int __setNewSpaceSize();
if (__isSmallInteger(newSize)) {
- result = __setNewSpaceSize(__intVal(newSize)) ? true : false;
+ result = __setNewSpaceSize(__intVal(newSize)) ? true : false;
}
%}.
result isNil ifTrue:[
- self primitiveFailed.
+ self primitiveFailed.
].
result ifTrue:[
- self saveGarbageCollectorSetting:#newSpaceSize: value:newSize.
+ self saveGarbageCollectorSetting:#newSpaceSize: value:newSize.
].
^ result.
@@ -3196,15 +3196,15 @@
|result|
-%{
+%{
extern unsigned __compressingGCLimit();
if (__isInteger(amount)) {
- result = __MKUINT( __compressingGCLimit(__unsignedLongIntVal(amount)) );
+ result = __MKUINT( __compressingGCLimit(__unsignedLongIntVal(amount)) );
}
%}.
result isNil ifTrue:[
- ^ 0.
+ ^ 0.
].
self saveGarbageCollectorSetting:#oldSpaceCompressLimit: value:amount.
^ result.
@@ -3238,18 +3238,18 @@
In normal situations, the default value used in the VM is fine
and there is no need to change it. This method returns the
previous increment value."
-
+
|result|
-%{
+%{
extern unsigned __oldSpaceIncrement();
if (__isInteger(amount)) {
- result = __MKUINT( __oldSpaceIncrement(__unsignedLongIntVal(amount)) );
+ result = __MKUINT( __oldSpaceIncrement(__unsignedLongIntVal(amount)) );
}
%}.
result isNil ifTrue:[
- ^ 0.
+ ^ 0.
].
self saveGarbageCollectorSetting:#oldSpaceIncrement: value:amount.
^ result.
@@ -3322,14 +3322,14 @@
"restore the saved garbage collector settings"
SavedGarbageCollectorSettings isEmptyOrNil ifTrue:[
- ^ self.
+ ^ self.
].
SavedGarbageCollectorSettings keysAndValuesDo:[:eachKey :eachValue|
- eachKey numArgs == 1 ifTrue:[
- self perform:eachKey with:eachValue.
- ] ifFalse:[
- self perform:eachKey.
- ].
+ eachKey numArgs == 1 ifTrue:[
+ self perform:eachKey with:eachValue.
+ ] ifFalse:[
+ self perform:eachKey.
+ ].
].
!
@@ -3338,7 +3338,7 @@
to be restored on snapshot return"
SavedGarbageCollectorSettings isNil ifTrue:[
- SavedGarbageCollectorSettings := IdentityDictionary new.
+ SavedGarbageCollectorSettings := IdentityDictionary new.
].
SavedGarbageCollectorSettings at:aSymbol put:something.
! !
@@ -4029,7 +4029,7 @@
lots of data kept somewhere (usually, cached data).
- this may or may not help."
- self changed:#memoryLow.
+ self changed:#memoryLow.
self performLowSpaceCleanup.
"/ self error:'almost out of memory'
'ObjectMemory [warning]: almost out of memory' errorPrintCR.
@@ -4050,9 +4050,9 @@
which allocates an IdentitySet"
Smalltalk do:[:eachGlobal|
- eachGlobal isBehavior ifTrue:[
- eachGlobal lowSpaceCleanup
- ].
+ eachGlobal isBehavior ifTrue:[
+ eachGlobal lowSpaceCleanup
+ ].
].
"
@@ -4312,7 +4312,7 @@
%}
"
- self collectedOldSpaceAddress
+ self collectedOldSpaceAddress
"
!
@@ -4480,6 +4480,72 @@
"
!
+mallocAllocated
+ "return the number of bytes allocated (and used) by malloc."
+
+%{ /* NOCONTEXT */
+ extern int __stx_malloc_stats();
+ long statsArray[3];
+ int filled;
+
+ filled = __stx_malloc_stats(statsArray, sizeof(statsArray));
+ if (filled < 1) {
+ RETURN(__mkSmallInteger(0));
+ }
+ RETURN ( __MKUINT(statsArray[0]));
+%}
+ "
+ ObjectMemory mallocAllocated
+ "
+!
+
+mallocStatsArray
+ "return the number of bytes allocated (and used) by malloc."
+
+ |allStats|
+
+%{
+ extern int __stx_malloc_stats();
+ long statsArray[30];
+ int filled, i;
+ OBJ temp;
+
+ filled = __stx_malloc_stats(statsArray, sizeof(statsArray));
+ if (filled < 1) {
+ RETURN(nil);
+ }
+ allStats = __ARRAY_NEW_INT(filled);
+ for (i = 0; i < filled; i++) {
+ __arrayVal(allStats)[i] = temp = __MKUINT(statsArray[i]);
+ __STORE(allStats, temp);
+ }
+
+ RETURN ( allStats );
+%}
+ "
+ ObjectMemory mallocStatsArray
+ "
+!
+
+mallocTotal
+ "return the number of bytes reserved by malloc (may not have been used yet)."
+
+%{ /* NOCONTEXT */
+ extern int __stx_malloc_stats();
+ long statsArray[3];
+ int filled;
+
+ filled = __stx_malloc_stats(statsArray, sizeof(statsArray));
+ if (filled < 2) {
+ RETURN(__mkSmallInteger(0));
+ }
+ RETURN ( __MKUINT(statsArray[1]));
+%}
+ "
+ ObjectMemory mallocTotal
+ "
+!
+
markAndSweepCount
"return the number of mark&sweep collects that occurred since startup"
@@ -4582,7 +4648,7 @@
%}
"
- self oldSpaceAddress
+ self oldSpaceAddress
"
!
@@ -4858,6 +4924,22 @@
]
"
+!
+
+mallocStatistics
+ "for ST/X developers only:
+ dump statistics on malloc memory allocation (used, for example for ExternalBytes) on
+ the standard output. Dummy on some architectures, where the standard malloc is used (win32, for example).
+ This method may be removed without notice"
+
+%{ /* NOCONTEXT */
+ void __malloc_print_stats();
+
+ __malloc_print_stats();
+%}
+ "
+ ObjectMemory mallocStatistics
+ "
! !
!ObjectMemory class methodsFor:'system configuration queries'!
@@ -4882,66 +4964,66 @@
modules := IdentityDictionary new.
self allBinaryModulesDo:[:idArg :nameArg :flagsArg :libName :timeStamp |
- |type subModuleName module dynamic infoRec handle pathName
- typeName name nameString|
-
- nameArg class == String ifFalse:[
- 'Error in binaryModuleInfo - skip entry' errorPrintCR.
- ] ifTrue:[
- name := nameArg.
- subModuleName := name asSymbol.
-
- idArg > 0 ifTrue:[
- dynamic := true.
- typeName := 'dynamic '.
- handle := ObjectFileLoader handleFromID:idArg.
- (handle isNil or:[(pathName := handle pathName) isNil]) ifTrue:[
- name := '?'
- ] ifFalse:[
- name := pathName asFilename baseName
- ]
- ] ifFalse:[
- dynamic := false.
- typeName := 'builtIn '.
- pathName := nil.
- libName isNil ifTrue:[
- name := subModuleName
- ] ifFalse:[
- name := libName
- ].
- ].
- nameString := typeName.
- libName isNil ifTrue:[
- nameString := nameString, 'module '
- ] ifFalse:[
- nameString := nameString, 'classLib '
- ].
- nameString := nameString , name.
-
- libName isNil ifTrue:[
- type := #classObject
- ] ifFalse:[
- type := #classLibrary
- ].
-
- infoRec := modules at:idArg ifAbsent:nil.
- infoRec notNil ifTrue:[
- infoRec classNames add:subModuleName.
- ] ifFalse:[
- infoRec := BinaryModuleDescriptor
- name:nameString
- type:type
- id:idArg
- dynamic:dynamic
- classNames:( (OrderedSet ? Set) with:subModuleName)
- handle:handle
- pathName:pathName
- libraryName:libName
- timeStamp:nil.
-
- modules at:idArg put:infoRec.
- ].
- ].
+ |type subModuleName module dynamic infoRec handle pathName
+ typeName name nameString|
+
+ nameArg class == String ifFalse:[
+ 'Error in binaryModuleInfo - skip entry' errorPrintCR.
+ ] ifTrue:[
+ name := nameArg.
+ subModuleName := name asSymbol.
+
+ idArg > 0 ifTrue:[
+ dynamic := true.
+ typeName := 'dynamic '.
+ handle := ObjectFileLoader handleFromID:idArg.
+ (handle isNil or:[(pathName := handle pathName) isNil]) ifTrue:[
+ name := '?'
+ ] ifFalse:[
+ name := pathName asFilename baseName
+ ]
+ ] ifFalse:[
+ dynamic := false.
+ typeName := 'builtIn '.
+ pathName := nil.
+ libName isNil ifTrue:[
+ name := subModuleName
+ ] ifFalse:[
+ name := libName
+ ].
+ ].
+ nameString := typeName.
+ libName isNil ifTrue:[
+ nameString := nameString, 'module '
+ ] ifFalse:[
+ nameString := nameString, 'classLib '
+ ].
+ nameString := nameString , name.
+
+ libName isNil ifTrue:[
+ type := #classObject
+ ] ifFalse:[
+ type := #classLibrary
+ ].
+
+ infoRec := modules at:idArg ifAbsent:nil.
+ infoRec notNil ifTrue:[
+ infoRec classNames add:subModuleName.
+ ] ifFalse:[
+ infoRec := BinaryModuleDescriptor
+ name:nameString
+ type:type
+ id:idArg
+ dynamic:dynamic
+ classNames:( (OrderedSet ? Set) with:subModuleName)
+ handle:handle
+ pathName:pathName
+ libraryName:libName
+ timeStamp:nil.
+
+ modules at:idArg put:infoRec.
+ ].
+ ].
].
^ modules
@@ -5031,13 +5113,13 @@
nm := ImageName.
(nm isEmptyOrNil or:[nm isBlank]) ifTrue:[
- ^ 'st'
+ ^ 'st'
].
filename := nm asFilename.
suffix := filename suffix.
(suffix = 'sav' or:[suffix = self suffixForSnapshot]) ifTrue:[
- ^ filename nameWithoutSuffix.
+ ^ filename nameWithoutSuffix.
].
^ nm
@@ -5210,7 +5292,7 @@
Return true if the snapshot worked, false if it failed for some reason.
Notify dependents before and after the snapshot operation.
- If setImageName is true, the name of the current image is set and
+ If setImageName is true, the name of the current image is set and
a copy of the change file is created."
|ok snapshotFilename tempFilename oldChangeFile|
@@ -5225,7 +5307,7 @@
ST-80 compatibility; send #preSnapshot to all classes
"
Smalltalk allClassesDo:[:aClass |
- aClass preSnapshot
+ aClass preSnapshot
].
"
@@ -5238,48 +5320,48 @@
ok := self primSnapShotOn:tempFilename.
ok ifTrue:[
- "keep history of one snapshot file"
- snapshotFilename exists ifTrue:[
- tempFilename symbolicAccessRights:snapshotFilename symbolicAccessRights.
- snapshotFilename renameTo:(snapshotFilename withSuffix:'sav').
- ] ifFalse:[
- "image file hat stx as interpreter and can be executed"
- tempFilename makeExecutable.
- ].
- tempFilename renameTo:snapshotFilename.
-
- Class addChangeRecordForSnapshot:aFileName.
-
- setImageName ifTrue:[
- oldChangeFile := self nameForChanges.
- ImageName := snapshotFilename asAbsoluteFilename asString.
- self refreshChangesFrom:oldChangeFile.
- ].
+ "keep history of one snapshot file"
+ snapshotFilename exists ifTrue:[
+ tempFilename symbolicAccessRights:snapshotFilename symbolicAccessRights.
+ snapshotFilename renameTo:(snapshotFilename withSuffix:'sav').
+ ] ifFalse:[
+ "image file hat stx as interpreter and can be executed"
+ tempFilename makeExecutable.
+ ].
+ tempFilename renameTo:snapshotFilename.
+
+ Class addChangeRecordForSnapshot:aFileName.
+
+ setImageName ifTrue:[
+ oldChangeFile := self nameForChanges.
+ ImageName := snapshotFilename asAbsoluteFilename asString.
+ self refreshChangesFrom:oldChangeFile.
+ ].
] ifFalse:[
- tempFilename remove.
+ tempFilename remove.
].
"
ST-80 compatibility; send #postSnapshot to all classes
"
Smalltalk allClassesDo:[:aClass |
- aClass postSnapshot
+ aClass postSnapshot
].
self changed:#finishedSnapshot. "/ ST-80 compatibility
ok ifFalse:[
- SnapshotError raise.
- "not reached"
+ SnapshotError raise.
+ "not reached"
].
Transcript
- show:'Snapshot ';
- show:snapshotFilename baseName allBold;
- show:' saved ';
- show:Timestamp now;
- show:' in ';
- show:snapshotFilename asAbsoluteFilename directoryName;
- showCR:'.'.
+ show:'Snapshot ';
+ show:snapshotFilename baseName allBold;
+ show:' saved ';
+ show:Timestamp now;
+ show:' in ';
+ show:snapshotFilename asAbsoluteFilename directoryName;
+ showCR:'.'.
^ ok
@@ -5350,7 +5432,7 @@
!
isSingleMethod
- ^ type == #classObject and:[ libraryName isNil ]
+ ^ type == #classObject and:[ libraryName isNil ]
!
libraryName
@@ -5417,9 +5499,9 @@
!ObjectMemory::BinaryModuleDescriptor methodsFor:'printing & storing'!
printOn:aStream
- aStream
- nextPutAll:self class name;
- nextPut:$(.
+ aStream
+ nextPutAll:self class name;
+ nextPut:$(.
name printOn:aStream.
aStream nextPut:$).
@@ -5442,7 +5524,7 @@
!ObjectMemory class methodsFor:'documentation'!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.252 2011/08/08 17:20:22 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.258 2011/08/17 19:29:47 stefan Exp §'
!
version_SVN
@@ -5451,3 +5533,4 @@
ObjectMemory initialize!
+
--- a/ProcessorScheduler.st Fri Aug 12 13:58:52 2011 +0100
+++ b/ProcessorScheduler.st Thu Aug 18 10:37:43 2011 +0100
@@ -1983,7 +1983,7 @@
terminateNoSignal:aProcess
"hard terminate aProcess without sending the terminate signal, thus
no unwind blocks or exitAction are performed in the process..
- If its not the current process, it is simply removed from its list
+ If it's not the current process, it is simply removed from its list
and physically destroyed. Otherwise (since we can't take away the chair
we are sitting on), a switch is forced and the process
will be physically destroyed by the next running process.
@@ -2021,7 +2021,7 @@
aProcess == activeProcess ifTrue:[
"
- hard case - its the currently running process
+ hard case - it's the currently running process
we must have the next active process destroy this one
(we cannot destroy the chair we are sitting on ... :-)
"
@@ -2044,8 +2044,9 @@
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- "Modified: 23.9.1996 / 13:50:24 / stefan"
- "Modified: 20.3.1997 / 16:03:39 / cg"
+ "Modified: / 23-09-1996 / 13:50:24 / stefan"
+ "Modified: / 20-03-1997 / 16:03:39 / cg"
+ "Modified (comment): / 10-08-2011 / 19:57:08 / cg"
!
yield
@@ -3379,12 +3380,13 @@
!ProcessorScheduler class methodsFor:'documentation'!
version
- ^ '$Id: ProcessorScheduler.st 10665 2011-08-10 14:59:08Z vranyj1 $'
+ ^ '$Id: ProcessorScheduler.st 10669 2011-08-18 09:37:43Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.258 2011/08/05 07:54:52 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/ProcessorScheduler.st,v 1.259 2011/08/10 17:57:35 cg Exp §'
! !
ProcessorScheduler initialize!
+
--- a/Semaphore.st Fri Aug 12 13:58:52 2011 +0100
+++ b/Semaphore.st Thu Aug 18 10:37:43 2011 +0100
@@ -12,7 +12,7 @@
"{ Package: 'stx:libbasic' }"
Object subclass:#Semaphore
- instanceVariableNames:'count waitingProcesses lastOwnerID name'
+ instanceVariableNames:'count waitingProcesses lastOwner name'
classVariableNames:''
poolDictionaries:''
category:'Kernel-Processes'
@@ -473,14 +473,27 @@
"Created: 23.1.1997 / 02:55:58 / cg"
!
+lastOwner
+ "return the last owning process or nil
+ (the one which counted to zero).
+ May be very useful in debugging deadLock situations"
+
+ ^ lastOwner
+
+ "Created: / 11-08-2011 / 14:35:36 / cg"
+!
+
lastOwnerId
"return the processId of the last owning process
(the one which counted to zero).
May be very useful in debugging deadLock situations"
- ^ lastOwnerID
+ lastOwner notNil ifTrue:[
+ ^ lastOwner id
+ ].
+ ^ nil
- "Created: 24.1.1997 / 23:09:33 / cg"
+ "Created: / 24-01-1997 / 23:09:33 / cg"
!
numberOfWaitingProcesses
@@ -512,7 +525,7 @@
count > 0 ifTrue:[
count := count - 1.
count == 0 ifTrue:[
- lastOwnerID := Processor activeProcessId.
+ lastOwner := Processor activeProcess.
].
^ true
].
@@ -521,8 +534,8 @@
].
^ false
- "Modified: 14.12.1995 / 10:32:17 / stefan"
- "Modified: 10.1.1997 / 21:42:18 / cg"
+ "Modified: / 14-12-1995 / 10:32:17 / stefan"
+ "Modified: / 11-08-2011 / 14:36:20 / cg"
! !
!Semaphore methodsFor:'signaling'!
@@ -681,7 +694,7 @@
count > 0 ifTrue:[
count := count - 1.
count == 0 ifTrue:[
- lastOwnerID := Processor activeProcessId.
+ lastOwner := Processor activeProcess.
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
@@ -741,8 +754,8 @@
] forkAt:4.
"
- "Modified: / 16.4.1996 / 10:00:46 / stefan"
- "Modified: / 21.7.1998 / 17:45:26 / cg"
+ "Modified: / 16-04-1996 / 10:00:46 / stefan"
+ "Modified: / 11-08-2011 / 14:36:30 / cg"
!
wait
@@ -781,12 +794,12 @@
count := count - 1.
count == 0 ifTrue:[
- lastOwnerID := Processor activeProcessId.
+ lastOwner := Processor activeProcess.
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
- "Modified: / 13.12.1995 / 13:26:33 / stefan"
- "Modified: / 17.6.1998 / 15:26:27 / cg"
+ "Modified: / 13-12-1995 / 13:26:33 / stefan"
+ "Modified: / 11-08-2011 / 14:36:43 / cg"
!
waitUncounted
@@ -923,21 +936,22 @@
"if we come here, we have accquired the semaphore"
count := count - 1.
count == 0 ifTrue:[
- lastOwnerID := Processor activeProcessId.
+ lastOwner := Processor activeProcess.
].
wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
^ self
- "Modified: 13.12.1995 / 13:27:24 / stefan"
- "Modified: 16.6.1997 / 21:54:38 / cg"
+ "Modified: / 13-12-1995 / 13:27:24 / stefan"
+ "Modified: / 11-08-2011 / 14:37:00 / cg"
! !
!Semaphore class methodsFor:'documentation'!
version
- ^ '$Id: Semaphore.st 10660 2011-07-18 15:22:09Z vranyj1 $'
+ ^ '$Id: Semaphore.st 10669 2011-08-18 09:37:43Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Semaphore.st,v 1.85 2011/04/27 15:03:57 stefan Exp §'
+ ^ 'Header: /cvs/stx/stx/libbasic/Semaphore.st,v 1.86 2011/08/11 12:38:01 cg Exp '
! !
+
--- a/Smalltalk.st Fri Aug 12 13:58:52 2011 +0100
+++ b/Smalltalk.st Thu Aug 18 10:37:43 2011 +0100
@@ -2126,21 +2126,22 @@
!
addStartBlock:aBlock
- "{ Pragma: +optSpace }"
-
- "add a blocks to be executed in a separate process after
+ "add a block to be executed in a separate process after
everything has been initialized. These blocks will
- be deleted after execution and therefore not be
- executed after an image restart.
- Initial processes are usually started here (see smalltalk.rc / private.rc)."
+ be executed only once and not be executed after an image restart.
+ Initial processes such as the launcher are usually started here
+ (see smalltalk.rc / private.rc)."
+
+ "{ Pragma: +optSpace }"
StartBlocks isNil ifTrue:[
- StartBlocks := OrderedCollection with:aBlock
+ StartBlocks := OrderedCollection with:aBlock
] ifFalse:[
- StartBlocks add:aBlock
+ StartBlocks add:aBlock
]
- "Created: 9.9.1996 / 16:46:53 / stefan"
+ "Created: / 09-09-1996 / 16:46:53 / stefan"
+ "Modified (comment): / 18-08-2011 / 09:18:42 / cg"
!
exit
@@ -7640,11 +7641,11 @@
!Smalltalk class methodsFor:'documentation'!
version
- ^ '$Id: Smalltalk.st 10665 2011-08-10 14:59:08Z vranyj1 $'
+ ^ '$Id: Smalltalk.st 10669 2011-08-18 09:37:43Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.970 2011/08/07 14:55:41 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.972 2011/08/18 07:19:06 cg Exp §'
!
version_SVN
@@ -7652,3 +7653,4 @@
! !
+
--- a/StandaloneStartup.st Fri Aug 12 13:58:52 2011 +0100
+++ b/StandaloneStartup.st Thu Aug 18 10:37:43 2011 +0100
@@ -865,7 +865,7 @@
dllFile exists ifTrue:[
"/ self verboseInfo:('loading: ', basename).
- Smalltalk showSplashMessage:('loading ', basename).
+"/ Smalltalk showSplashMessage:('loading ', basename).
dlls add:dllFile.
] ifFalse:[
self verboseInfo:( '**** cannot resolve: ', basename).
@@ -883,6 +883,8 @@
SimpleView readStyleSheetAndUpdateAllStyleCaches.
].
].
+
+ "Modified: / 11-08-2011 / 17:23:55 / cg"
!
setupSmalltalkFromArguments:argv
@@ -1131,11 +1133,12 @@
!StandaloneStartup class methodsFor:'documentation'!
version
- ^ '$Id: StandaloneStartup.st 10660 2011-07-18 15:22:09Z vranyj1 $'
+ ^ '$Id: StandaloneStartup.st 10669 2011-08-18 09:37:43Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/StandaloneStartup.st,v 1.64 2011/05/24 22:21:26 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/StandaloneStartup.st,v 1.65 2011/08/11 15:26:10 cg Exp §'
! !
StandaloneStartup initialize!
+
--- a/UndefinedObject.st Fri Aug 12 13:58:52 2011 +0100
+++ b/UndefinedObject.st Thu Aug 18 10:37:43 2011 +0100
@@ -230,7 +230,6 @@
"ignored here - nil has no dependents"
! !
-
!UndefinedObject methodsFor:'error catching'!
basicAt:index
@@ -617,13 +616,13 @@
!
isEmptyOrNil
- "return true if I am nil or an empty collection - since I am nil, return true.
- (from Sqeak)"
+ "return true if I am nil or an empty collection
+ - since I am nil, return true. (from Sqeak)"
^ true
- "Created: / 13.11.2001 / 13:16:40 / cg"
- "Modified: / 13.11.2001 / 13:28:47 / cg"
+ "Created: / 13-11-2001 / 13:16:40 / cg"
+ "Modified (comment): / 17-08-2011 / 09:29:30 / cg"
!
isLiteral
@@ -691,11 +690,12 @@
!UndefinedObject class methodsFor:'documentation'!
version
- ^ '$Id: UndefinedObject.st 10660 2011-07-18 15:22:09Z vranyj1 $'
+ ^ '$Id: UndefinedObject.st 10669 2011-08-18 09:37:43Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/UndefinedObject.st,v 1.71 2010/07/28 17:20:51 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/UndefinedObject.st,v 1.72 2011/08/18 00:35:45 cg Exp §'
! !
UndefinedObject initialize!
+
--- a/Win32OperatingSystem.st Fri Aug 12 13:58:52 2011 +0100
+++ b/Win32OperatingSystem.st Thu Aug 18 10:37:43 2011 +0100
@@ -3928,6 +3928,14 @@
^ self primitiveFailed.
!
+closeHandle: handle
+ "low level handle close"
+
+ <apicall: ulongReturn "CloseHandle" ( handle ) module: "kernel32.dll" >
+
+ "Modified (comment): / 12-08-2011 / 16:37:35 / cg"
+!
+
createDirectory:aPathName
"create a new directory with name 'aPathName', which may be an absolute
path, or relative to the current directory.
@@ -7071,6 +7079,24 @@
"
!
+multiByteToWideCharCp: cp flags: flags lpstr: lpstr cchstr: cchstr lpwstr: lpwstr cchwstr: cchwstr
+ "Convert the multi-byte string encoding in <lpstr> to a Unicode encoding in <lpwstr>."
+
+ " int MultiByteToWideChar(
+ UINT CodePage, // code page
+ DWORD dwFlags, // character-type options
+ LPCSTR lpMultiByteStr, // address of string to map
+ int cchMultiByte, // number of characters in string
+ LPWSTR lpWideCharStr, // address of wide-character buffer
+ int cchWideChar // size of buffer
+ );"
+
+ <apicall: ulongReturn "MultiByteToWideChar" ( uint32 uint32 structIn int32 structOut int32) module: "kernel32.dll" >
+ ^self primitiveFailed
+
+ "Modified (comment): / 12-08-2011 / 16:37:06 / cg"
+!
+
playSound:fileName
self playSound:fileName mode:1
@@ -7152,6 +7178,34 @@
"Created: / 18-12-2006 / 13:01:41 / User"
!
+wideCharToMultiByteCp: codePage
+ flags: dwFlags
+ lpwstr: lpWideCharStr
+ cchwstr: cchwstr
+ lpstr: lpstr
+ cchlpstr: cchlpstr
+ default: default
+ defaultUsed: defaultUsed
+
+ "Convert the Unicode encoding in <lpWideCharStr> to a multi-byte string encoding in <lpstr>."
+
+ "int WideCharToMultiByte(
+ UINT CodePage, // code page
+ DWORD dwFlags, // performance and mapping flags
+ LPCWSTR lpWideCharStr, // address of wide-character string
+ int cchWideChar, // number of characters in string
+ LPSTR lpMultiByteStr, // address of buffer for new string
+ int cchMultiByte, // size of buffer
+ LPCSTR lpDefaultChar, // address of default for unmappable characters
+ LPBOOL lpUsedDefaultChar // address of flag set when default char. used
+ );"
+
+ <apicall: ulongReturn "MultiByteToWideChar" ( uint32 uint32 structIn int32 structOut int32 structIn structOut) module: "kernel32.dll" >
+ ^self primitiveFailed
+
+ "Modified (comment): / 12-08-2011 / 16:37:14 / cg"
+!
+
writePrivateProfileString: appName keyName: keyName profileString: profString fileName: aString
^self primWritePrivateProfileString: appName keyName: keyName profileString: profString fileName: aString
@@ -16345,14 +16399,15 @@
!Win32OperatingSystem class methodsFor:'documentation'!
version
- ^ '$Id: Win32OperatingSystem.st 10665 2011-08-10 14:59:08Z vranyj1 $'
+ ^ '$Id: Win32OperatingSystem.st 10669 2011-08-18 09:37:43Z vranyj1 $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Win32OperatingSystem.st,v 1.423 2011/07/30 16:37:37 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Win32OperatingSystem.st,v 1.424 2011/08/12 14:38:11 cg Exp §'
! !
Win32OperatingSystem initialize!
Win32OperatingSystem::PerformanceData initialize!
Win32OperatingSystem::RegistryEntry initialize!
+
--- a/stx_libbasic.st Fri Aug 12 13:58:52 2011 +0100
+++ b/stx_libbasic.st Thu Aug 18 10:37:43 2011 +0100
@@ -541,7 +541,7 @@
"Return a SVN revision number of myself.
This number is updated after a commit"
- ^ "$SVN-Revision:"'10664M'"$"
+ ^ "$SVN-Revision:"'10667M'"$"
! !
!stx_libbasic class methodsFor:'documentation'!