The Trunk: System-cmm.1067.mcz

Chris Muller uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-cmm.1067.mcz

==================== Summary ====================

Name: System-cmm.1067
Author: cmm
Time: 19 June 2019, 3:38:18.528122 pm
UUID: fbdc8d8a-ce74-4117-9eb3-30bd8d21cc36
Ancestors: System-fn.1066, System-ek.1062

- Exception>>#printVerboseOn: belongs in this package.
- Merged System-ek.1062.

=============== Diff against System-fn.1066 ===============

Item was added:
+ ----- Method: Exception>>printVerboseOn: (in category '*system') -----
+ printVerboseOn: aStream
+ aStream
+ nextPutAll: 'vvvvvvvvvvvvvvvvvv ' , self description , ' vvvvvvvvvvvvvvvvvv' ;
+ cr ;
+ nextPutAll: 'The time is ', DateAndTime now asString ;
+ cr.
+ "Allow applications to optionally print extra details without overriding a base package."
+ self printDetailsOn: aStream.
+ aStream
+ nextPutAll: self signalerContext longStack ;
+ cr ;
+ nextPutAll: '^^^^^^^^^^^^^^^^^^ ' , self description , ' ^^^^^^^^^^^^^^^^^^' ;
+ cr ;
+ flush!

Item was added:
+ ----- Method: MessageTally>>childrenOver: (in category 'comparing') -----
+ childrenOver: threshold
+
+ | hereTally last children |
+ receivers basicSize = 0 ifTrue: [^#()].
+ hereTally := tally.
+ children := receivers select:  "subtract subNode tallies for primitive hits here"
+ [:child |
+ hereTally := hereTally - child tally.
+ child tally > threshold].
+ hereTally > threshold ifTrue:
+ [last := MessageTally new class: class method: method nesting: blockNesting.
+ last process: process.
+ last reportOtherProcesses: reportOtherProcesses.
+ ^children copyWith: (last primitives: hereTally)].
+ ^children!

Item was changed:
  ----- Method: MessageTally>>leavesInto:fromSender: (in category 'collecting leaves') -----
  leavesInto: leafDict fromSender: senderTally
 
  | rcvrs |
+ rcvrs := self childrenOver: 0.
- rcvrs := self sonsOver: 0.
  rcvrs size = 0
  ifTrue: [ self into: leafDict fromSender: senderTally ]
  ifFalse: [
 
  (reportOtherProcesses not and: [ rcvrs anyOne process isNil ]) ifTrue: [
  ^self].
 
  rcvrs do: [ :node |
  node isPrimitives
  ifTrue: [ node leavesInto: leafDict fromSender: senderTally ]
  ifFalse: [ node leavesInto: leafDict fromSender: self ]]]!

Item was changed:
  ----- Method: MessageTally>>rootPrintOn:total:totalTime:threshold: (in category 'printing') -----
  rootPrintOn: aStream total: total totalTime: totalTime threshold: threshold
 
+ | groups children |
+ children := self childrenOver: threshold.
+ groups := children groupBy: [ :aTally | aTally process ].
- | groups sons |
- sons := self sonsOver: threshold.
- groups := sons groupBy: [ :aTally | aTally process ].
  groups keysAndValuesDo: [ :p :g |
  (reportOtherProcesses or: [ p notNil ]) ifTrue: [
  aStream nextPutAll: '--------------------------------'; cr.
  aStream nextPutAll: 'Process: ',  (p ifNil: [ 'other processes'] ifNotNil: [ p browserPrintString]); cr.
  aStream nextPutAll: '--------------------------------'; cr.
+ g sort do:[:aChild |
+ aChild
- g sort do:[:aSon |
- aSon
  treePrintOn: aStream
  tabs: OrderedCollection new
  thisTab: ''
  total: total
  totalTime: totalTime
  tallyExact: false
  orThreshold: threshold]].
  ]!

Item was removed:
- ----- Method: MessageTally>>sonsOver: (in category 'comparing') -----
- sonsOver: threshold
-
- | hereTally last sons |
- receivers basicSize = 0 ifTrue: [^#()].
- hereTally := tally.
- sons := receivers select:  "subtract subNode tallies for primitive hits here"
- [:son |
- hereTally := hereTally - son tally.
- son tally > threshold].
- hereTally > threshold ifTrue:
- [last := MessageTally new class: class method: method nesting: blockNesting.
- last process: process.
- last reportOtherProcesses: reportOtherProcesses.
- ^sons copyWith: (last primitives: hereTally)].
- ^sons!

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
+ | children |
- | sons |
  tabs do: [:tab | aStream nextPutAll: tab].
  tabs size > 0
  ifTrue:
  [self
  printOn: aStream
  total: total
  totalTime: totalTime
  tallyExact: isExact].
+ children := isExact ifTrue: [receivers] ifFalse: [self childrenOver: threshold].
+ children isEmpty
- sons := isExact ifTrue: [receivers] ifFalse: [self sonsOver: threshold].
- sons isEmpty
  ifFalse:
  [tabs addLast: myTab.
+ children sort.
+ 1 to: children size do: [ :i |
+ | childTab |
+ childTab := i < children size ifTrue: ['  |'] ifFalse: ['  '].
+ (children at: i)
- sons sort.
- 1 to: sons size do: [ :i |
- | sonTab |
- 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: childTab
- thisTab: sonTab
  total: total
  totalTime: totalTime
  tallyExact: isExact
  orThreshold: threshold].
  tabs removeLast]!