[Pkg] The Trunk: System-nice.243.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Feb 4 19:11:33 UTC 2010
Nicolas Cellier uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-nice.243.mcz
==================== Summary ====================
Name: System-nice.243
Author: nice
Time: 4 February 2010, 8:10:49.069 pm
UUID: fb2af05d-ab4c-44d9-98a9-9593e9d559c2
Ancestors: System-ar.242
1) move some temp assignments outside blocks
2) move some temps declaration inside blocks
3) remove some now useless fixTemps
=============== Diff against System-ar.242 ===============
Item was changed:
----- Method: MessageTally>>spyEvery:onProcess:forMilliseconds: (in category 'initialize-release') -----
spyEvery: millisecs onProcess: aProcess forMilliseconds: msecDuration
"Create a spy and spy on the given process at the specified rate."
+ | myDelay time0 endTime observedProcess sem |
- | myDelay startTime time0 endTime observedProcess sem |
(aProcess isKindOf: Process)
ifFalse: [self error: 'spy needs a Process here'].
self class: aProcess suspendedContext receiver class method: aProcess suspendedContext method.
"set up the probe"
observedProcess := aProcess.
myDelay := Delay forMilliseconds: millisecs.
time0 := Time millisecondClockValue.
endTime := time0 + msecDuration.
sem := Semaphore new.
gcStats := SmalltalkImage current getVMParameters.
Timer ifNotNil: [ Timer terminate ].
Timer := [
[
+ | startTime |
startTime := Time millisecondClockValue.
myDelay wait.
self
tally: Processor preemptedProcess suspendedContext
in: (observedProcess == Processor preemptedProcess ifTrue: [observedProcess] ifFalse: [nil])
"tally can be > 1 if ran a long primitive"
by: (Time millisecondClockValue - startTime) // millisecs.
startTime < endTime
] whileTrue.
sem signal.
] newProcess.
Timer priority: Processor timingPriority-1.
"activate the probe and evaluate the block"
Timer resume.
"activate the probe and wait for it to finish"
sem wait.
"Collect gc statistics"
SmalltalkImage current getVMParameters keysAndValuesDo: [ :idx :gcVal |
gcStats at: idx put: (gcVal - gcStats at: idx)].
time := Time millisecondClockValue - time0!
Item was changed:
----- Method: MessageTally>>rootPrintOn:total:totalTime:threshold: (in category 'printing') -----
rootPrintOn: aStream total: total totalTime: totalTime threshold: threshold
+ | groups sons |
- | sons groups p |
sons := self sonsOver: threshold.
groups := sons groupBy: [ :aTally | aTally process] having: [ :g | true].
groups do:[:g|
+ | p |
- sons := g asSortedCollection.
p := g anyOne process.
(reportOtherProcesses or: [ p notNil ]) ifTrue: [
aStream nextPutAll: '--------------------------------'; cr.
aStream nextPutAll: 'Process: ', (p ifNil: [ 'other processes'] ifNotNil: [ p browserPrintString]); cr.
aStream nextPutAll: '--------------------------------'; cr.
+ g asSortedCollection do:[:aSon |
+ aSon
- (1 to: sons size) do:[:i |
- (sons at: i)
treePrintOn: aStream
tabs: OrderedCollection new
thisTab: ''
total: total
totalTime: totalTime
tallyExact: false
orThreshold: threshold]].
]!
Item was changed:
----- Method: MessageTally>>spyAllEvery:on: (in category 'initialize-release') -----
spyAllEvery: millisecs on: aBlock
"Create a spy and spy on the given block at the specified rate."
"Spy all the system processes"
+ | myDelay time0 |
- | myDelay startTime time0 observedProcess |
(aBlock isMemberOf: BlockClosure)
ifFalse: [self error: 'spy needs a block here'].
self class: aBlock receiver class method: aBlock method.
"set up the probe"
myDelay := Delay forMilliseconds: millisecs.
time0 := Time millisecondClockValue.
gcStats := SmalltalkImage current getVMParameters.
Timer ifNotNil: [ Timer terminate ].
Timer := [
[true] whileTrue: [
+ | observedProcess startTime |
startTime := Time millisecondClockValue.
myDelay wait.
observedProcess := Processor preemptedProcess.
self
tally: observedProcess suspendedContext
in: observedProcess
"tally can be > 1 if ran a long primitive"
by: (Time millisecondClockValue - startTime) // millisecs].
nil] newProcess.
Timer priority: Processor timingPriority-1.
"activate the probe and evaluate the block"
Timer resume.
^ aBlock ensure: [
"Collect gc statistics"
SmalltalkImage current getVMParameters keysAndValuesDo: [ :idx :gcVal |
gcStats at: idx put: (gcVal - (gcStats at: idx))].
"cancel the probe and return the value"
Timer terminate.
Timer := nil.
time := Time millisecondClockValue - time0]!
Item was changed:
----- Method: MessageTally>>printSenderCountsOn: (in category 'printing') -----
printSenderCountsOn: aStream
+ | mergedSenders |
- | mergedSenders mergedNode |
mergedSenders := IdentityDictionary new.
senders do:
[:node |
+ | mergedNode |
mergedNode := mergedSenders at: node method ifAbsent: [nil].
mergedNode == nil
ifTrue: [mergedSenders at: node method put: node]
ifFalse: [mergedNode bump: node tally]].
mergedSenders asSortedCollection do:
[:node |
10 to: node tally printString size by: -1 do: [:i | aStream space].
node printOn: aStream total: tally totalTime: nil tallyExact: true]!
Item was changed:
----- Method: MessageTally>>spyEvery:on: (in category 'initialize-release') -----
spyEvery: millisecs on: aBlock
"Create a spy and spy on the given block at the specified rate."
"Spy only on the active process (in which aBlock is run)"
+ | myDelay time0 observedProcess |
- | myDelay startTime time0 observedProcess |
(aBlock isMemberOf: BlockClosure)
ifFalse: [self error: 'spy needs a block here'].
self class: aBlock receiver class method: aBlock method.
"set up the probe"
observedProcess := Processor activeProcess.
myDelay := Delay forMilliseconds: millisecs.
time0 := Time millisecondClockValue.
gcStats := SmalltalkImage current getVMParameters.
Timer ifNotNil: [ Timer terminate ].
+ Timer := [
- Timer := [
[true] whileTrue: [
+ | startTime |
startTime := Time millisecondClockValue.
myDelay wait.
self
tally: Processor preemptedProcess suspendedContext
in: (observedProcess == Processor preemptedProcess ifTrue: [observedProcess] ifFalse: [nil])
"tally can be > 1 if ran a long primitive"
by: (Time millisecondClockValue - startTime) // millisecs].
nil] newProcess.
Timer priority: Processor timingPriority-1.
"activate the probe and evaluate the block"
Timer resume.
^ aBlock ensure: [
"Collect gc statistics"
SmalltalkImage current getVMParameters keysAndValuesDo: [ :idx :gcVal |
gcStats at: idx put: (gcVal - (gcStats at: idx))].
"cancel the probe and return the value"
Timer terminate.
Timer := nil.
time := Time millisecondClockValue - time0]!
Item was changed:
----- Method: MessageTally>>treePrintOn:tabs:thisTab:total:totalTime:tallyExact:orThreshold: (in category 'printing') -----
treePrintOn: aStream tabs: tabs thisTab: myTab total: total totalTime: totalTime tallyExact: isExact orThreshold: threshold
+ | sons |
- | sons sonTab |
tabs do: [:tab | aStream nextPutAll: tab].
tabs size > 0
ifTrue:
[self
printOn: aStream
total: total
totalTime: totalTime
tallyExact: isExact].
sons := isExact ifTrue: [receivers] ifFalse: [self sonsOver: threshold].
sons isEmpty
ifFalse:
[tabs addLast: myTab.
sons := sons asSortedCollection.
(1 to: sons size) do:
+ [:i | | sonTab |
- [:i |
sonTab := i < sons size ifTrue: [' |'] ifFalse: [' '].
(sons at: i)
treePrintOn: aStream
tabs: (tabs size < self maxTabs
ifTrue: [tabs]
ifFalse: [(tabs select: [:x | x = '[']) copyWith: '['])
thisTab: sonTab
total: total
totalTime: totalTime
tallyExact: isExact
orThreshold: threshold].
tabs removeLast]!
Item was changed:
----- Method: Utilities class>>objectStrmFromUpdates: (in category 'fetching updates') -----
objectStrmFromUpdates: fileName
"Go to the known servers and look for this file in the updates folder. It is an auxillery file, like .morph or a .gif. Return a RWBinaryOrTextStream on it. Meant to be called from during the getting of updates from the server. That assures that (Utilities serverUrls) returns the right group of servers."
-
-
Cursor wait showWhile:
+ [ | urls |
+ urls := Utilities serverUrls collect: [:url | url, 'updates/', fileName].
- [ | urls |urls := Utilities serverUrls collect: [:url | url, 'updates/', fileName].
urls do: [:aUrl | | doc |
doc := HTTPSocket httpGet: aUrl accept: 'application/octet-stream'.
"test here for server being up"
doc class == RWBinaryOrTextStream ifTrue: [^ doc reset]]].
self inform: 'All update servers are unavailable, or bad file name'.
^ nil!
Item was changed:
----- Method: ImageSegment>>copyFromRoots:sizeHint:areUnique: (in category 'read/write segment') -----
copyFromRoots: aRootArray sizeHint: segSizeHint areUnique: areUnique
"Copy a tree of objects into a WordArray segment. The copied objects in the segment are not in the normal Squeak space.
[1] For exporting a project. Objects were enumerated by ReferenceStream and aRootArray has them all.
[2] For exporting some classes. See copyFromRootsForExport:. (Caller must hold Symbols, or they will not get registered in the target system.)
[3] For 'local segments'. outPointers are kept in the image.
If this method yields a very small segment, it is because objects just below the roots are pointed at from the outside. (See findRogueRootsImSeg: for a *destructive* diagnostic of who is pointing in.)"
| segmentWordArray outPointerArray segSize rootSet uniqueRoots |
aRootArray ifNil: [self errorWrongState].
uniqueRoots := areUnique
ifTrue: [aRootArray]
ifFalse: [rootSet := IdentitySet new: aRootArray size * 3.
uniqueRoots := OrderedCollection new.
1 to: aRootArray size do: [:ii | "Don't include any roots twice"
(rootSet includes: (aRootArray at: ii))
ifFalse: [
uniqueRoots addLast: (aRootArray at: ii).
rootSet add: (aRootArray at: ii)]
ifTrue: [userRootCnt ifNotNil: ["adjust the count"
ii <= userRootCnt ifTrue: [userRootCnt := userRootCnt - 1]]]].
uniqueRoots].
arrayOfRoots := uniqueRoots asArray.
rootSet := uniqueRoots := nil. "be clean"
userRootCnt ifNil: [userRootCnt := arrayOfRoots size].
arrayOfRoots do: [:aRoot |
aRoot indexIfCompact > 0 ifTrue: [
self error: 'Compact class ', aRoot name, ' cannot be a root']].
outPointers := nil. "may have used this instance before"
segSize := segSizeHint > 0 ifTrue: [segSizeHint *3 //2] ifFalse: [50000].
["Guess a reasonable segment size"
segmentWordArray := WordArrayForSegment new: segSize.
+ outPointerArray := [Array new: segSize // 20] ifError: [
- [outPointerArray := Array new: segSize // 20] ifError: [
state := #tooBig. ^ self].
"Smalltalk garbageCollect."
(self storeSegmentFor: arrayOfRoots
into: segmentWordArray
outPointers: outPointerArray) == nil]
whileTrue:
["Double the segment size and try again"
segmentWordArray := outPointerArray := nil.
segSize := segSize * 2].
segment := segmentWordArray.
outPointers := outPointerArray.
state := #activeCopy.
endMarker := segment nextObject. "for enumeration of objects"
endMarker == 0 ifTrue: [endMarker := 'End' clone].
!
Item was changed:
----- Method: Project>>storeOnServerShowProgressOn:forgetURL: (in category 'file in/out') -----
storeOnServerShowProgressOn: aMorphOrNil forgetURL: forget
"Save to disk as an Export Segment. Then put that file on the server I came from, as a new version. Version is literal piece of file name. Mime encoded and http encoded."
world setProperty: #optimumExtentFromAuthor toValue: world extent.
self validateProjectNameIfOK: [
self isCurrentProject ifTrue: ["exit, then do the command"
forget
ifTrue: [self forgetExistingURL]
ifFalse: [urlList isEmptyOrNil ifTrue: [urlList := parentProject urlList copy]].
^self
armsLengthCommand: #storeOnServerAssumingNameValid
withDescription: 'Publishing' translated
].
self storeOnServerWithProgressInfoOn: aMorphOrNil.
+ ].
- ] fixTemps.
!
Item was changed:
----- Method: Project>>validateProjectNameIfOK: (in category 'menu messages') -----
validateProjectNameIfOK: aBlock
| details |
details := world valueOfProperty: #ProjectDetails.
details ifNotNil: ["ensure project info matches real project name"
details at: 'projectname' put: self name.
].
self doWeWantToRename ifFalse: [^aBlock value].
(Smalltalk at: #EToyProjectDetailsMorph) ifNotNil: [:etpdm |
etpdm
getFullInfoFor: self
ifValid: [
World displayWorldSafely.
aBlock value.
+ ]
- ] fixTemps
expandedFormat: false]
!
Item was changed:
----- Method: ChangeSet>>mailOut (in category 'fileIn/Out') -----
mailOut
"Email a compressed version of this changeset to the squeak-dev list, so that it can be shared with everyone. (You will be able to edit the email before it is sent.)"
| userName message slips |
userName := MailSender userName.
self checkForConversionMethods.
+ message := Cursor write showWhile: [self buildMessageForMailOutWithUser: userName].
- Cursor write showWhile: [message := self buildMessageForMailOutWithUser: userName].
MailSender sendMessage: message.
Preferences suppressCheckForSlips ifTrue: [^ self].
slips := self checkForSlips.
(slips size > 0 and: [self confirm: 'Methods in this fileOut have halts
or references to the Transcript
or other ''slips'' in them.
Would you like to browse them?'])
ifTrue: [self systemNavigation browseMessageList: slips name: 'Possible slips in ' , name]
!
More information about the Packages
mailing list