The Trunk: System-nice.243.mcz

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]
  !