VM Maker: CogTools-sk.81.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

VM Maker: CogTools-sk.81.mcz

commits-2
 
Sophie Kaleba uploaded a new version of CogTools to project VM Maker:
http://source.squeak.org/VMMaker/CogTools-sk.81.mcz

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

Name: CogTools-sk.81
Author: sk
Time: 6 July 2017, 4:43:21.854769 pm
UUID: 935fdb8e-4d7f-4d2c-a60c-a3ec94260d69
Ancestors: CogTools-sk.80

* Refactor (cleaner structure when initializing to get either a SqueakVMProfiler or PharoVMProfiler instance)
* added the detailed profiling features (at last!) - still need to work on the display
* Fixed rounded percentages in the report
* Display of the profiled expression in headless mode
* cleaning / renaming classes and methods for consistency

=============== Diff against CogTools-sk.80 ===============

Item was added:
+ ----- Method: PharoVMFileSystem>>round:downTo: (in category 'as yet unclassified') -----
+ round: anInteger downTo: decimalPlaces
+
+ ^ anInteger printShowingDecimalPlaces: decimalPlaces!

Item was added:
+ VMMethodConverter subclass: #PharoVMMethodConverter
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'CogTools-VMProfiler'!

Item was added:
+ ----- Method: PharoVMMethodConverter>>convertAsString: (in category 'as yet unclassified') -----
+ convertAsString: aBlock
+
+ ^ aBlock asString!

Item was added:
+ ----- Method: PharoVMMethodConverter>>deleteContentsOf: (in category 'as yet unclassified') -----
+ deleteContentsOf: aDirectory
+
+ aDirectory deleteAll.
+ !

Item was added:
+ ----- Method: PharoVMMethodConverter>>ensureExistenceOfDirectory: (in category 'public') -----
+ ensureExistenceOfDirectory: aDirName
+ ^ aDirName ensureCreateDirectory !

Item was added:
+ ----- Method: PharoVMMethodConverter>>exists: (in category 'public') -----
+ exists: aFilename
+
+ ^ aFilename asFileReference exists!

Item was added:
+ ----- Method: PharoVMMethodConverter>>nameFordirPath:plus: (in category 'as yet unclassified') -----
+ nameFordirPath: aDirPath plus: aProcessId
+
+ ^ (aDirPath, aProcessId) asFileReference   !

Item was added:
+ ----- Method: PharoVMMethodConverter>>nameOfFile:in: (in category 'as yet unclassified') -----
+ nameOfFile: aFilename in: aDirectory
+
+ ^ aFilename asFileReference basename !

Item was added:
+ ----- Method: PharoVMMethodConverter>>parentPathOfFile: (in category 'as yet unclassified') -----
+ parentPathOfFile: aFilename
+
+ ^ (aFilename asFileReference) parent pathString  !

Item was added:
+ ----- Method: PharoVMMethodConverter>>print:showingDecimalPlaces: (in category 'as yet unclassified') -----
+ print: anInteger showingDecimalPlaces: decimalPlaces
+
+ ^ anInteger printShowingDecimalPlaces: decimalPlaces!

Item was added:
+ ----- Method: PharoVMProfiler>>initialize (in category 'initialization') -----
+ initialize
+
+ super initializeMost.
+ self withDetails: false.
+ CompatibilityClass := PharoVMMethodConverter new.
+ expressionTextMorph := PluggableTextMorph new.
+ self initializeSymbols.!

Item was added:
+ ----- Method: SqueakVMFileSystem>>round:downTo: (in category 'as yet unclassified') -----
+ round: anInteger downTo: decimalPlaces
+
+ ^ anInteger printShowingMaxDecimalPlaces: decimalPlaces!

Item was added:
+ VMMethodConverter subclass: #SqueakVMMethodConverter
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'CogTools-VMProfiler'!

Item was added:
+ ----- Method: SqueakVMMethodConverter>>convertAsString: (in category 'as yet unclassified') -----
+ convertAsString: aBlock
+
+ ^ aBlock sourceString!

Item was added:
+ ----- Method: SqueakVMMethodConverter>>deleteContentsOf: (in category 'as yet unclassified') -----
+ deleteContentsOf: aDirectory
+
+ aDirectory recursiveDelete!

Item was added:
+ ----- Method: SqueakVMMethodConverter>>ensureExistenceOfDirectory: (in category 'public') -----
+ ensureExistenceOfDirectory: aDirName
+
+ ^ aDirName assureExistence!

Item was added:
+ ----- Method: SqueakVMMethodConverter>>exists: (in category 'public') -----
+ exists: aFilename
+
+ ^FileDirectory default fileExists: aFilename !

Item was added:
+ ----- Method: SqueakVMMethodConverter>>nameFordirPath:plus: (in category 'as yet unclassified') -----
+ nameFordirPath: aDirPath plus: aProcessId
+
+ ^ FileDirectory on: aDirPath, aProcessId!

Item was added:
+ ----- Method: SqueakVMMethodConverter>>nameOfFile:in: (in category 'as yet unclassified') -----
+ nameOfFile: aFilename in: aDirectory
+
+ ^ aDirectory localNameFor: aFilename !

Item was added:
+ ----- Method: SqueakVMMethodConverter>>parentPathOfFile: (in category 'as yet unclassified') -----
+ parentPathOfFile: aFilename
+
+ ^ FileDirectory dirPathFor: aFilename !

Item was added:
+ ----- Method: SqueakVMMethodConverter>>print:showingDecimalPlaces: (in category 'as yet unclassified') -----
+ print: anInteger showingDecimalPlaces: decimalPlaces
+
+ ^ anInteger printShowingMaxDecimalPlaces: decimalPlaces!

Item was added:
+ ----- Method: SqueakVMProfiler>>initialize (in category 'initialization') -----
+ initialize
+ super initializeMost.
+ self withDetails: false.
+ CompatibilityClass := SqueakVMMethodConverter new.
+ expressionTextMorph := PluggableTextMorph new.
+ super initializeSymbols.
+ self toggleShowing: #module.!

Item was changed:
+ ----- Method: SqueakVMProfiler>>stopProfiling (in category 'profiling') -----
- ----- Method: SqueakVMProfiler>>stopProfiling (in category 'as yet unclassified') -----
  stopProfiling
 
  super stopProfiling.
  self updateButtons!

Item was added:
+ ----- Method: VMFileSystem>>round:downTo: (in category 'as yet unclassified') -----
+ round: anInteger downTo: decimalPlaces
+
+ self subclassResponsability!

Item was added:
+ Object subclass: #VMMcpcBcpcMap
+ instanceVariableNames: 'map'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'CogTools-VMProfiler'!
+
+ !VMMcpcBcpcMap commentStamp: 'ClementBera 6/13/2017 15:56' prior: 0!
+ My instances represent the mapping between mcpc (machine code program counter) to bcpc (bytecode program counter) for a given compiled code.
+
+ map is an orderedCollection, each element being an association, the key being the range in the bytecode, the value the number of samples within that range.!

Item was added:
+ ----- Method: VMMcpcBcpcMap>>addRange:numSamples: (in category 'accessing') -----
+ addRange: range numSamples: numSamples
+ map add: (range key + 1 -> (range value + 1)) -> numSamples!

Item was added:
+ ----- Method: VMMcpcBcpcMap>>bcRangeAndNumSamplesDo: (in category 'iterating') -----
+ bcRangeAndNumSamplesDo: binaryBlock
+ map do: [ :assoc |
+ binaryBlock
+ value: assoc key
+ value: assoc value ]!

Item was added:
+ ----- Method: VMMcpcBcpcMap>>initialize (in category 'initialization') -----
+ initialize
+
+ super initialize.
+
+ map := OrderedCollection new.!

Item was added:
+ ----- Method: VMMcpcBcpcMap>>printOn: (in category 'printing') -----
+ printOn: s
+ s << 'McpcBcpcMap ('.
+ map do:
+ [ :assoc |
+ s
+ << '['
+ << assoc key key printString
+ << ';'
+ << assoc key value printString
+ << ']>'
+ << assoc value printString
+ << ' ' ].
+ s << ')'!

Item was added:
+ Object subclass: #VMMethodConverter
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'CogTools-VMProfiler'!
+
+ !VMMethodConverter commentStamp: 'sk 7/6/2017 11:10' prior: 0!
+ I make a link between the methods that are implemented differently between Squeak and Pharo.
+
+ !

Item was added:
+ ----- Method: VMMethodConverter>>convertAsString: (in category 'as yet unclassified') -----
+ convertAsString: aBlock
+
+ self subclassResponsability.!

Item was added:
+ ----- Method: VMMethodConverter>>deleteContentsOf: (in category 'as yet unclassified') -----
+ deleteContentsOf: aDirectory
+ self subclassResponsability!

Item was added:
+ ----- Method: VMMethodConverter>>ensureExistenceOfDirectory: (in category 'public') -----
+ ensureExistenceOfDirectory: aDirName
+ "if the directory doesn't exist, create it"
+
+ self subclassResponsibility !

Item was added:
+ ----- Method: VMMethodConverter>>exists: (in category 'public') -----
+ exists: aFilename
+ "checks if a given file exists"
+
+ self subclassResponsibility !

Item was added:
+ ----- Method: VMMethodConverter>>nameFordirPath:plus: (in category 'as yet unclassified') -----
+ nameFordirPath: aDirPath plus: aProcessId
+ "answers a FileSystem/Directory object representing a directory. The name of this directory is its path+the name of a process id"
+
+ self subclassResponsibility !

Item was added:
+ ----- Method: VMMethodConverter>>nameOfFile:in: (in category 'as yet unclassified') -----
+ nameOfFile: aFilename in: aDirectory
+
+ self subclassResponsibility !

Item was added:
+ ----- Method: VMMethodConverter>>parentPathOfFile: (in category 'as yet unclassified') -----
+ parentPathOfFile: aFilename
+
+ self subclassResponsibility !

Item was added:
+ ----- Method: VMMethodConverter>>print:showingDecimalPlaces: (in category 'as yet unclassified') -----
+ print: anInteger showingDecimalPlaces: decimalPlaces
+
+ self subclassResponsability!

Item was changed:
  VMPSymbol subclass: #VMPFunctionSymbol
+ instanceVariableNames: 'mcpcbcpcmap'
- instanceVariableNames: ''
  classVariableNames: ''
  poolDictionaries: ''
  category: 'CogTools-VMProfiler'!
 
  !VMPFunctionSymbol commentStamp: '<historical>' prior: 0!
  A symbol for a function or procedure (see subclasses)!

Item was added:
+ ----- Method: VMPFunctionSymbol>>mcpcbcpcmap (in category 'accessing') -----
+ mcpcbcpcmap
+ ^ mcpcbcpcmap!

Item was added:
+ ----- Method: VMPFunctionSymbol>>mcpcbcpcmap: (in category 'accessing') -----
+ mcpcbcpcmap: anObject
+ mcpcbcpcmap := anObject!

Item was added:
+ ----- Method: VMPFunctionSymbol>>mcpcbcpcmapDo: (in category 'iterating') -----
+ mcpcbcpcmapDo: binaryBlock
+ 2 to: mcpcbcpcmap size by: 2 do:
+ [ :index |
+ "value at index is mcpc and index + 1 bcpc"
+ binaryBlock
+ value: (mcpcbcpcmap at: index)
+ value: (mcpcbcpcmap at: index + 1) ]!

Item was changed:
  Model subclass: #VMProfiler
+ instanceVariableNames: 'sampleBuffer sampleBag sortedSamples sortedSymbols sortedSymbolsBeforeCogCode sortedSymbolsAfterCogCode symbolsMode symbolTypes symbolManager symbolList selections minSelectionIndex maxSelectionIndex total rangeTotal highAddress lowAddress history historyIndex expressionTextMorph previousPattern graph aboutToProfile startTime elapsedTime startStats elapsedStats clearPriorToProfile gcPriorToProfile forkProfile cogCodeConstituents withDetails'
+ classVariableNames: 'CannedBenchmarkStrings CompatibilityClass'
- instanceVariableNames: 'sampleBuffer sampleBag sortedSamples sortedSymbols sortedSymbolsBeforeCogCode sortedSymbolsAfterCogCode symbolsMode symbolTypes symbolManager symbolList selections minSelectionIndex maxSelectionIndex total rangeTotal highAddress lowAddress history historyIndex expressionTextMorph previousPattern graph aboutToProfile startTime elapsedTime startStats elapsedStats clearPriorToProfile gcPriorToProfile forkProfile cogCodeConstituents version fileSystem'
- classVariableNames: 'CannedBenchmarkStrings'
  poolDictionaries: ''
  category: 'CogTools-VMProfiler'!
 
  !VMProfiler commentStamp: 'eem 7/9/2013 14:08' prior: 0!
  This tool is a pc-sampling profiler for the VM.  It presents the profile data graphically.
 
  Copyright© 2011-2013, 3D ICC Immersive Collaboration. All rights reserved.
 
  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
 
  The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
 
  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
  THE SOFTWARE.
 
  Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at
 
    http://www.apache.org/licenses/LICENSE-2.0
 
  Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License.!

Item was changed:
  ----- Method: VMProfiler class>>headlessSpyOn:reportOn: (in category 'as yet unclassified') -----
  headlessSpyOn: aBlock reportOn: aStream
  "initialize the profiler version (squeak or pharo) and profile headless, writing the results on a given stream"
 
+ VMProfiler new
+ selectBenchmark: (CompatibilityClass convertAsString: aBlock);
- (VMProfiler new) version new
  headlessSpyOn: aBlock;
  report: aStream.
  !

Item was added:
+ ----- Method: VMProfiler class>>headlessSpyOn:reportOn:withDetails: (in category 'as yet unclassified') -----
+ headlessSpyOn: aBlock reportOn: aStream withDetails: aBoolean
+ "initialize the profiler version (squeak or pharo) and profile headless, writing the results on a given stream"
+
+ VMProfiler new
+ withDetails: aBoolean;
+ selectBenchmark: (CompatibilityClass convertAsString: aBlock);
+ headlessSpyOn: aBlock;
+ report: aStream.
+ !

Item was changed:
  ----- Method: VMProfiler class>>reportGCStats:upTime:on: (in category 'reports') -----
  reportGCStats: gcStatsArray upTime: elapsedMilliseconds on: str
  | oldSpaceEnd youngSpaceEnd memoryEnd fullGCs fullGCTime incrGCs incrGCTime tenureCount rootOverflows |
  gcStatsArray ifNil: [^self].
 
  oldSpaceEnd := gcStatsArray at: 2. "a.k.a. oldSpace size on Spur"
  fullGCs := gcStatsArray at: 7.
  fullGCTime := gcStatsArray at: 8.
  incrGCs := gcStatsArray at: 9.
  incrGCTime := gcStatsArray at: 10.
  tenureCount := gcStatsArray at: 11.
  rootOverflows := gcStatsArray at: 22.
 
  str cr.
  str nextPutAll: '**Memory**'; cr.
  str nextPutAll: ' old ';
  nextPutAll: oldSpaceEnd asStringWithCommasSigned; nextPutAll: ' bytes'; cr.
  self amOnSpur
  ifTrue:
  [(gcStatsArray at: 54) ifNotNil:
  [:freeSpace|
  str nextPutAll: ' free ';
  nextPutAll: freeSpace asStringWithCommasSigned; nextPutAll: ' bytes'; cr]]
  ifFalse:
  [youngSpaceEnd := gcStatsArray at: 1.
  memoryEnd := gcStatsArray at: 3.
  str nextPutAll: ' young ';
  nextPutAll: (youngSpaceEnd - oldSpaceEnd) asStringWithCommasSigned; nextPutAll: ' bytes'; cr.
  str nextPutAll: ' used ';
  nextPutAll: youngSpaceEnd asStringWithCommasSigned; nextPutAll: ' bytes'; cr.
  str nextPutAll: ' free ';
  nextPutAll: (memoryEnd - youngSpaceEnd) asStringWithCommasSigned; nextPutAll: ' bytes'; cr].
 
  str cr.
  str nextPutAll: '**GCs**'; cr.
  str nextPutAll: ' full ';
  print: fullGCs; nextPutAll: ' totalling '; nextPutAll: fullGCTime asStringWithCommas; nextPutAll: 'ms (';
+ nextPutAll: (CompatibilityClass print:(fullGCTime / elapsedMilliseconds * 100) showingDecimalPlaces: 3 );
- print: ((fullGCTime / elapsedMilliseconds * 100) roundTo: 0.001);
  nextPutAll: '% elapsed time)'.
  fullGCs = 0 ifFalse:
+ [str nextPutAll: ', avg '; nextPutAll: (CompatibilityClass print:(fullGCTime / fullGCs) showingDecimalPlaces: 3); nextPutAll: 'ms'].
- [str nextPutAll: ', avg '; print: (fullGCTime / fullGCs roundTo: 0.001); nextPutAll: 'ms'].
  str cr.
  str nextPutAll: (self amOnSpur ifTrue: [' scavenges '] ifFalse: [' incr ']);
  print: incrGCs; nextPutAll: ' totalling '; nextPutAll: incrGCTime asStringWithCommas; nextPutAll: 'ms (';
+ nextPutAll: (CompatibilityClass print:incrGCTime / elapsedMilliseconds * 100 showingDecimalPlaces: 3);
- print: ((incrGCTime / elapsedMilliseconds * 100) roundTo: 0.001);
  nextPutAll: '% elapsed time)'.
  incrGCs = 0 ifFalse:
+ [str nextPutAll:', avg '; nextPutAll: (CompatibilityClass print:incrGCTime / incrGCs showingDecimalPlaces:3); nextPutAll: 'ms'].
- [str nextPutAll:', avg '; print: (incrGCTime / incrGCs roundTo: 0.001); nextPutAll: 'ms'].
  str cr.
  str nextPutAll: ' tenures ';
  nextPutAll: tenureCount asStringWithCommas.
  tenureCount = 0 ifFalse:
  [str nextPutAll: ' (avg '; print: (incrGCs / tenureCount) asInteger; nextPutAll: ' GCs/tenure)'].
  str cr.
  str nextPutAll: ' root table ';
  nextPutAll: rootOverflows asStringWithCommas; nextPutAll:' overflows'.
  str cr.
 
  (gcStatsArray size >= 63 and: [(gcStatsArray at: 63) isInteger]) ifTrue:
  [| numCompactions compactionMsecs |
  str cr; nextPutAll: '**Compiled Code Compactions**'; cr.
  numCompactions := gcStatsArray at: 62.
  compactionMsecs := gcStatsArray at: 63.
  str tab;
  print: numCompactions; nextPutAll: ' totalling ';
  nextPutAll: compactionMsecs asStringWithCommas; nextPutAll: 'ms (';
+ nextPutAll: (CompatibilityClass print:compactionMsecs / elapsedMilliseconds * 100 showingDecimalPlaces: 3);
- print: ((compactionMsecs / elapsedMilliseconds * 100) roundTo: 0.001);
  nextPutAll: '% elapsed time)'.
  numCompactions = 0 ifFalse:
+ [str nextPutAll: ', avg '; nextPutAll: (CompatibilityClass print:compactionMsecs / numCompactions showingDecimalPlaces:3); nextPutAll: 'ms'].
- [str nextPutAll: ', avg '; print: (compactionMsecs / numCompactions roundTo: 0.001); nextPutAll: 'ms'].
  str cr].
 
  gcStatsArray size >= 61 ifTrue:
  [str cr; nextPutAll: '**Events**'; cr.
  (56 to: 61)
  with: #('Process switches' 'ioProcessEvents calls' 'Interrupt checks' 'Event checks' 'Stack overflows' 'Stack page divorces')
  do: [:index :eventName| | value n |
  value := gcStatsArray at: index.
  n := 22 - eventName size // 4 + 1.
  str nextPutAll: eventName; tab: n; print: value; nextPutAll: ' (';
  print: (value * 1000 / elapsedMilliseconds) rounded; nextPutAll: ' per second)'; cr]]!

Item was added:
+ ----- Method: VMProfiler>>countSymbols:totals: (in category 'reports') -----
+ countSymbols: symbols totals: totals
+ | totalSamples |
+ totalSamples := 0.
+ symbols do:
+ [:sym| | samples |
+ ((#(publicFunction privateFunction) includes: sym type)
+ and: [(samples := self samplesForSymbol: sym) > 0]) ifTrue:
+ [totals at: sym put: samples.
+ totalSamples := totalSamples + samples]].
+ ^ totalSamples
+ !

Item was added:
+ ----- Method: VMProfiler>>createMcpcBcpcMapFor: (in category 'Cog compiled code') -----
+ createMcpcBcpcMapFor: functionSymbol
+ | map minBCRange minMCRange |
+ map := VMMcpcBcpcMap new.
+ functionSymbol mcpcbcpcmap isArray ifFalse:
+ [ map addRange: (0->6666) numSamples: (self samplesForSymbol: functionSymbol).
+ ^ map ].
+ minBCRange := 0.
+ minMCRange := functionSymbol address.
+ functionSymbol mcpcbcpcmapDo: [ :mcpc :bcpc |
+ map addRange: (minBCRange -> bcpc) numSamples: (self samplesForRange: minMCRange to: mcpc).
+ minBCRange := bcpc.
+ minMCRange := mcpc ].
+ map addRange: (minBCRange -> 6666) numSamples: (self samplesForRange: minMCRange to: functionSymbol limit).
+ ^ map!

Item was changed:
  ----- Method: VMProfiler>>initialize (in category 'initialization') -----
  initialize
+
+ ('Pharo*' match: Smalltalk version) ifTrue: [ ^PharoVMProfiler new].
+ ('Squeak*' match: Smalltalk version) ifTrue: [ ^SqueakVMProfiler new].
+
+ !
- self initializeSamples.
- self initializeVersion.
- self initializeSymbols.
- self clearHistory.
- symbolsMode := #byAddress.
- symbolTypes := IdentitySet new.
- selections := ByteArray new.
- highAddress := lowAddress := minSelectionIndex := maxSelectionIndex := 0.
- self toggleShowing: #module.
- aboutToProfile := false.
- total := rangeTotal := startTime := elapsedTime := 0.
- gcPriorToProfile := clearPriorToProfile := true.
- forkProfile := false!

Item was added:
+ ----- Method: VMProfiler>>initializeInstance (in category 'initialization') -----
+ initializeInstance
+ self initializeSamples.
+ self clearHistory.
+ symbolsMode := #byAddress.
+ symbolTypes := IdentitySet new.
+ selections := ByteArray new.
+ highAddress := lowAddress := minSelectionIndex := maxSelectionIndex := 0.
+ aboutToProfile := false.
+ total := rangeTotal := startTime := elapsedTime := 0.
+ gcPriorToProfile := clearPriorToProfile := true.
+ forkProfile := false!

Item was added:
+ ----- Method: VMProfiler>>initializeMost (in category 'initialization') -----
+ initializeMost
+ self initializeSamples.
+ self clearHistory.
+ symbolsMode := #byAddress.
+ symbolTypes := IdentitySet new.
+ selections := ByteArray new.
+ highAddress := lowAddress := minSelectionIndex := maxSelectionIndex := 0.
+ aboutToProfile := false.
+ total := rangeTotal := startTime := elapsedTime := 0.
+ gcPriorToProfile := clearPriorToProfile := true.
+ forkProfile := false!

Item was changed:
  ----- Method: VMProfiler>>initializeSymbols (in category 'initialization') -----
  initializeSymbols
  Smalltalk platformName
  caseOf: {
  ['Mac OS'] -> [Cursor wait showWhile:
+ [ symbolManager := VMProfilerMacSymbolsManager using: CompatibilityClass ]].
- [ symbolManager := VMProfilerMacSymbolsManager using: fileSystem ]].
  ['unix'] -> [Cursor wait showWhile:
+ [symbolManager := VMProfilerLinuxSymbolsManager using: CompatibilityClass ]] }
- [symbolManager := VMProfilerLinuxSymbolsManager using: fileSystem]] }
  otherwise: [self error: 'not yet supported on ', Smalltalk platformName]!

Item was removed:
- ----- Method: VMProfiler>>initializeVersion (in category 'initialization') -----
- initializeVersion
-
- ('Pharo*' match: Smalltalk version) ifTrue: [ version := PharoVMProfiler.
- fileSystem := PharoVMFileSystem new].
- ('Squeak*' match: Smalltalk version) ifTrue: [ version := SqueakVMProfiler.
-   fileSystem := SqueakVMFileSystem new].
-
- !

Item was changed:
  ----- Method: VMProfiler>>primitiveCollectCogCodeConstituents (in category 'primitives') -----
  primitiveCollectCogCodeConstituents
+ ^ self primitiveCollectCogCodeConstituents: self withDetails!
- "Answer the contents of the code zone as an array of pair-wise element, address
- in ascending address order.  Answer a string for a runtime routine or abstract label
- (beginning, end, etc), a CompiledMethod for a cog machine-code method,
- or a selector (presumably a Symbol) for a cog machine-code open or closed PIC.
- Fail if this isn't a Cog VM or if out of memory.  If this isn't a Cog VM answer nil."
- <primitive: 253 error: ec>
- ^ec ifNotNil: [self primitiveFailed]
-
- "self basicNew primitiveCollectCogCodeConstituents"!

Item was added:
+ ----- Method: VMProfiler>>primitiveCollectCogCodeConstituents: (in category 'primitives') -----
+ primitiveCollectCogCodeConstituents: withDetails
+ "Answer the contents of the code zone as an array of pair-wise element, address
+ in ascending address order.  Answer a string for a runtime routine or abstract label
+ (beginning, end, etc), a CompiledMethod for a cog machine-code method,
+ or a selector (presumably a Symbol) for a cog machine-code open or closed PIC.
+ Fail if this isn't a Cog VM or if out of memory.  If this isn't a Cog VM answer nil.
+
+ If the parameter is true, answers the mapping between machine code pc and
+ bytecode pc in relevant methods instead of just the start address.
+ "
+ <primitive: 253 error: ec>
+ ^ec ifNotNil: [self primitiveFailed]
+
+ "self basicNew primitiveCollectCogCodeConstituents"!

Item was added:
+ ----- Method: VMProfiler>>printInnerDetails:with:on: (in category 'reports') -----
+ printInnerDetails: assoc with: cogMethodMaps on: aStream
+ | functionSymbol totalSamples map cumulative n |
+ functionSymbol := assoc key.
+ totalSamples := assoc value.
+ cumulative := 0.
+ map := cogMethodMaps at: functionSymbol.
+ map bcRangeAndNumSamplesDo: [ :bcRange :numSamples |
+ numSamples > 0 ifTrue:
+ [ aStream tab.
+  self printPercentage: numSamples total: totalSamples on: aStream.
+  aStream tab:2.
+  aStream << bcRange printString.
+  n := 10 - bcRange printString size // 4 + 1.
+  aStream tab:n.
+  aStream nextPut: $(; print: numSamples; nextPut: $); tab: (numSamples < 100 ifTrue: [1] ifFalse: [1]); nextPut: $(.
+  cumulative := cumulative + numSamples.
+  self printPercentage: cumulative total: totalSamples on: aStream.
+  aStream nextPut: $); cr. ]]
+
+ !

Item was changed:
  ----- Method: VMProfiler>>printSymbolTotals:labelled:on:sumTotal: (in category 'reports') -----
  printSymbolTotals: totals labelled: label on: aStream sumTotal: sumTotal
+ ^ self
+ printSymbolTotals: totals
+ labelled: label
+ on: aStream
+ sumTotal: sumTotal
+ cogMethodMaps: Dictionary new!
- "Print sorted totals for all symbols with a total greater than 0.01% of the grand total."
- | substantial insubstantial cut cumulative heading percentageWidth compositionWidth tabWidth labelWidthCut labelledInFull |
- cut := total / 10000.0.
- substantial := totals associations select: [:assoc| assoc value > cut].
- labelWidthCut := total / 1000.0.
- labelledInFull := totals associations select: [:assoc| assoc value > labelWidthCut].
- insubstantial := totals associations
- inject: 0
- into: [:sum :assoc|
-  (assoc value <= cut ifTrue: [assoc value] ifFalse: [0]) + sum].
- substantial := substantial asSortedCollection:
- [:a1 :a2|
- a1 value > a2 value
- or: [a1 value = a2 value and: [a1 name < a2 name]]].
- insubstantial > 0 ifTrue:
- [substantial := substantial asArray, {'...others...'->insubstantial}].
- cumulative := 0.
- heading := '% of ', label, ' (% of total)'.
- tabWidth := self widthInDefaultFontOf: (String with: Character tab).
- percentageWidth := self widthInDefaultFontOf: '99.99%    (99.99%) '.
- compositionWidth := (self longestWidthIn: labelledInFull) + tabWidth
- max: (self widthInDefaultFontOf: heading) + tabWidth - percentageWidth.
- self put: heading paddedTo: compositionWidth + percentageWidth tabWidth: tabWidth on: aStream.
- aStream nextPutAll: '(samples) (cumulative)'; cr.
- substantial do:
- [:assoc|
- self printPercentage: assoc value total: sumTotal on: aStream.
- aStream space; space; space; space; nextPut: $(.
- self printPercentage: assoc value total: total on: aStream.
- aStream nextPut: $); tab.
- self put: (assoc key isString ifTrue: [assoc key] ifFalse: [assoc key name])
- paddedTo: compositionWidth
- tabWidth: tabWidth
- on: aStream.
- aStream nextPut: $(; print: assoc value; nextPut: $); tab: (assoc value < 100 ifTrue: [2] ifFalse: [1]); nextPut: $(.
- cumulative := cumulative + assoc value.
- self printPercentage: cumulative total: sumTotal on: aStream.
- aStream nextPut: $); cr].
- aStream cr; cr!

Item was added:
+ ----- Method: VMProfiler>>printSymbolTotals:labelled:on:sumTotal:cogMethodMaps: (in category 'reports') -----
+ printSymbolTotals: totals labelled: label on: aStream sumTotal: sumTotal cogMethodMaps: cogMethodMaps
+ "Print sorted totals for all symbols with a total greater than 0.01% of the grand total."
+ | substantial insubstantial cut cumulative heading percentageWidth compositionWidth tabWidth labelWidthCut labelledInFull |
+ cut := total / 10000.0.
+ substantial := totals associations select: [:assoc| assoc value > cut].
+ labelWidthCut := total / 1000.0.
+ labelledInFull := totals associations select: [:assoc| assoc value > labelWidthCut].
+ insubstantial := totals associations
+ inject: 0
+ into: [:sum :assoc|
+  (assoc value <= cut ifTrue: [assoc value] ifFalse: [0]) + sum].
+ substantial := substantial asSortedCollection:
+ [:a1 :a2|
+ a1 value > a2 value
+ or: [a1 value = a2 value and: [a1 name < a2 name]]].
+ insubstantial > 0 ifTrue:
+ [substantial := substantial asArray, {'...others...'->insubstantial}].
+ cumulative := 0.
+ heading := '% of ', label, ' (% of total)'.
+ tabWidth := self widthInDefaultFontOf: (String with: Character tab).
+ percentageWidth := self widthInDefaultFontOf: '99.99%    (99.99%) '.
+ compositionWidth := (self longestWidthIn: labelledInFull) + tabWidth
+ max: (self widthInDefaultFontOf: heading) + tabWidth - percentageWidth.
+ self put: heading paddedTo: compositionWidth + percentageWidth tabWidth: tabWidth on: aStream.
+ aStream nextPutAll: '(samples) (cumulative)'; cr.
+ substantial do:
+ [:assoc|
+ self printPercentage: assoc value total: sumTotal on: aStream.
+ aStream space; space; space; space; nextPut: $(.
+ self printPercentage: assoc value total: total on: aStream.
+ aStream nextPut: $); tab.
+ self put: (assoc key isString ifTrue: [assoc key] ifFalse: [assoc key name])
+ paddedTo: compositionWidth
+ tabWidth: tabWidth
+ on: aStream.
+ aStream nextPut: $(; print: assoc value; nextPut: $); tab: (assoc value < 100 ifTrue: [2] ifFalse: [1]); nextPut: $(.
+ cumulative := cumulative + assoc value.
+ self printPercentage: cumulative total: sumTotal on: aStream.
+ aStream nextPut: $); cr.
+ self withDetails ifTrue: [cogMethodMaps at: assoc key ifPresent: [ :i | self printInnerDetails: assoc with: cogMethodMaps on: aStream ]. ].].
+ aStream cr; cr!

Item was changed:
  ----- Method: VMProfiler>>report: (in category 'reports') -----
  report: s
  self totalsDo:
  [:vmTotals :cogTotals :nonVMTotals
+ :samplesInVM :samplesInCog :samplesInNonVMModules :samplesInNonVM
+ :cogMethodMaps |
- :samplesInVM :samplesInCog :samplesInNonVMModules :samplesInNonVM |
  self putReportPreambleOn: s.
  s print: samplesInVM + samplesInCog; nextPutAll: ' samples in the VM'; tab; nextPut: $(;
    print: total; nextPutAll: ' samples in the entire program)  '.
  self printPercentage: samplesInVM + samplesInCog total: total on: s.
  s nextPutAll: ' of total'; cr; cr.
  cogTotals isEmpty ifFalse:
  [s print: samplesInCog; nextPutAll: ' samples in generated vm code '.
  self printPercentage: samplesInCog total: samplesInVM + samplesInCog on: s.
  s nextPutAll: ' of entire vm ('.
  self printPercentage: samplesInCog total: total on: s.
  s nextPutAll: ' of total)'; cr.
  s print: samplesInVM; nextPutAll: ' samples in vanilla vm code '.
  self printPercentage: samplesInVM total: samplesInVM + samplesInCog on: s.
  s nextPutAll: ' of entire vm ('.
  self printPercentage: samplesInVM total: total on: s.
  s nextPutAll: ' of total)'; cr; cr.
+ self printSymbolTotals: cogTotals labelled: 'generated vm code' on: s sumTotal: samplesInCog cogMethodMaps: cogMethodMaps].
- self printSymbolTotals: cogTotals labelled: 'generated vm code' on: s sumTotal: samplesInCog].
  vmTotals isEmpty ifFalse:
  [self printSymbolTotals: vmTotals labelled: 'vanilla vm code' on: s sumTotal: samplesInVM].
  (samplesInNonVM * 100 >= total
  and: [nonVMTotals notEmpty]) ifTrue:
  [s print: samplesInNonVM; nextPutAll: ' samples in the rest  '.
  self printPercentage: samplesInNonVM total: total on: s.
  s nextPutAll: ' of total'; cr; cr.
  self printSymbolTotals: nonVMTotals labelled: 'rest' on: s sumTotal: samplesInNonVM].
  self class reportGCStats: elapsedStats upTime: elapsedTime on: s]!

Item was added:
+ ----- Method: VMProfiler>>symbolsInNonVMModule (in category 'reports') -----
+ symbolsInNonVMModule
+ ^ (symbolManager modules
+ copyWithout: symbolManager vmModule)
+ copyWithout: symbolManager cogModule!

Item was changed:
  ----- Method: VMProfiler>>totalsDo: (in category 'reports') -----
+ totalsDo: octuaryBlock
- totalsDo: septuaryBlock
  "Evaluate aBlock with
  a Dictionary of symbol -> total for the functions in the VM (excluding generated code)
  a Dictionary of symbol -> total for the generated code in the VM
  a Dictionary of symbol -> total for the functions in other code
  total number of samples in functions in the VM (excluding generated code)
  total number of samples in generated code in the VM
  total number of samples in generated code in the VM
  total number of samples in functions in other code
  total number of samples not in VM or VM-generated code (incudes code not in any function)"
  | vmTotals cogTotals nonVMTotals
+  samplesInVM samplesInCog samplesInNonVMModules samplesInNonVM cogMethodMaps |
-  samplesInVM samplesInCog samplesInNonVMModules samplesInNonVM |
  vmTotals := Dictionary new.
  cogTotals := Dictionary new.
  nonVMTotals := Dictionary new.
+ cogMethodMaps := Dictionary new.
+ samplesInVM := self countSymbols: (symbolManager symbolsInModule: symbolManager vmModule) totals: vmTotals.
+ samplesInCog := self countSymbols: (symbolManager symbolsInModule: symbolManager cogModule) totals: cogTotals.
+ samplesInNonVMModules := self countSymbols: self symbolsInNonVMModule totals: nonVMTotals.
- samplesInVM := samplesInCog := samplesInNonVMModules := 0.
- (symbolManager symbolsInModule: symbolManager vmModule) do:
- [:sym| | samples |
- ((#(publicFunction privateFunction) includes: sym type)
- and: [(samples := self samplesForSymbol: sym) > 0]) ifTrue:
- [vmTotals at: sym put: samples.
- samplesInVM := samplesInVM + samples]].
- (symbolManager symbolsInModule: symbolManager cogModule) do:
- [:sym| | samples |
- ((#(publicFunction privateFunction) includes: sym type)
- and: [(samples := self samplesForSymbol: sym) > 0]) ifTrue:
- [cogTotals at: sym put: samples.
- samplesInCog := samplesInCog + samples]].
- ((symbolManager modules
- copyWithout: symbolManager vmModule)
- copyWithout: symbolManager cogModule) do:
- [:module|
- (symbolManager symbolsInModule: module) do:
- [:sym| | samples |
- ((#(publicFunction privateFunction) includes: sym type)
- and: [(samples := self samplesForSymbol: sym) > 0]) ifTrue:
- [nonVMTotals at: sym put: samples.
- samplesInNonVMModules := samplesInNonVMModules + samples]]].
  samplesInNonVM := total - samplesInVM - samplesInCog.
+ cogTotals keysAndValuesDo:
+ [ :key :value |
+ value > 10 ifTrue: [ cogMethodMaps at: key put: (self createMcpcBcpcMapFor: key) ] ].
  nonVMTotals
  at: 'Samples Not In Any Function'
  put: samplesInNonVM - samplesInNonVMModules.
+ octuaryBlock valueWithArguments:
- septuaryBlock valueWithArguments:
  {vmTotals.
  cogTotals.
  nonVMTotals.
  samplesInVM.
  samplesInCog.
  samplesInNonVMModules.
+ samplesInNonVM.
+ cogMethodMaps}!
- samplesInNonVM}!

Item was changed:
  ----- Method: VMProfiler>>trimmedExpressionText (in category 'menus') -----
  trimmedExpressionText
  | expression |
- expressionTextMorph ifNil: [expressionTextMorph := PluggableTextMorph new
- setText: '' asText].
  ^((expression := expressionTextMorph text asString) notEmpty
    and: [expression first = $[
    and: [expression last = $] ]])
  ifTrue: [expression copyFrom: 2 to: expression size - 1]
  ifFalse: [expression]!

Item was added:
+ ----- Method: VMProfiler>>withDetails (in category 'as yet unclassified') -----
+ withDetails
+
+ ^ withDetails!

Item was added:
+ ----- Method: VMProfiler>>withDetails: (in category 'as yet unclassified') -----
+ withDetails: aBoolean
+ "is the boolean is set to true, then the profiler will provide a detailed report (with bytecode ranges within a function)"
+
+ withDetails:= aBoolean!

Item was added:
+ ----- Method: VMProfilerLinuxSymbolsManager class>>tempDirectory (in category 'accessing') -----
+ tempDirectory
+
+ ^ VMFileSystem ifNotNil: [VMFileSystem nameFordirPath:'/tmp/vmsyms'  plus:OSProcess thisOSProcess pid printString]
+ !

Item was changed:
  ----- Method: VMProfilerLinuxSymbolsManager>>initializeMost (in category 'initialize-release') -----
  initializeMost
  | shortNames |
  initialized := false.
  maxAddressMask := (2 raisedToInteger: 32) - 1.
  modulesByName := Dictionary new.
  symbolsByModule := Dictionary new.
  shortNames := Set new.
  tempDir := self class tempDirectory.
+ VMFileSystem ensureExistenceOfDirectory:  tempDir.
- self fileSystem ensureExistenceOfDirectory:  tempDir.
  modules := self primitiveExecutableModules.
  modules := (1 to: modules size by: 2) collect:
  [:i| | fileName shortName counter longName |
  fileName := modules at: i.
  (fileName beginsWith: '/dgagent') ifTrue:
  [fileName := fileName allButFirst: 8].
  shortName := VMFileSystem nameOfFile: fileName in: tempDir.  
  counter := 0.
  [shortNames includes: shortName] whileTrue:
  [counter := counter + 1.
  shortName := (VMFileSystem nameOfFile: fileName  in: tempDir), counter printString].
  shortNames add: shortName.
  longName := (modules at: i + 1)
  ifNil: [fileName]
  ifNotNil:
  [:symlink|
  symlink first = $/
  ifTrue: [symlink]
  ifFalse: [( VMFileSystem parentPathOfFile: fileName ), '/', symlink]].
  "some files are off limits (e.g. /dgagent/lib/preload.so)"
  (VMFileSystem exists: longName) ifTrue:
  [(modulesByName
  at: longName
  put: VMPExecutableModuleSymbol new)
  name: longName;
  shortName: shortName]].
  "The primitive always answers the VM info in the first entry."
  vmModule := modules first.
  "now filter out the files we can't read..."
+ modules := modules select: [:m| m notNil and: [modulesByName includesKey: m name]]!
- modules := modules select: [:m| modulesByName includesKey: m name]!

Item was added:
+ ----- Method: VMProfilerMacSymbolsManager class>>tempDirectory (in category 'accessing') -----
+ tempDirectory
+
+ ^ VMFileSystem ifNotNil: [VMFileSystem nameFordirPath:'private/tmp/vmsyms'  plus:OSProcess thisOSProcess pid printString]
+ !

Item was changed:
  ----- Method: VMProfilerMacSymbolsManager>>initializeMost (in category 'initialize-release') -----
  initializeMost
  | shortNames |
  initialized := false.
  maxAddressMask := (2 raisedToInteger: Smalltalk wordSize * 8) - 1.
  modulesByName := Dictionary new.
  symbolsByModule := Dictionary new.
  shortNames := Set new.
  modules := self primitiveExecutableModulesAndOffsets.
  tempDir := self class tempDirectory.
+ VMFileSystem ensureExistenceOfDirectory:  tempDir.
- self fileSystem ensureExistenceOfDirectory:  tempDir.
  modules := (1 to: modules size by: 4) collect:
  [:i| | shortName counter |
  shortName := VMFileSystem nameOfFile: (modules at: i) in: tempDir.
  counter := 0.
  [shortNames includes: shortName] whileTrue:
  [counter := counter + 1.
  shortName := (VMFileSystem nameOfFile: (modules at: i) in: tempDir), counter printString].  
  shortNames add: shortName.
  (modulesByName
  at: (modules at: i)
  put: VMPExecutableModuleSymbol new)
  name: (modules at: i);
  shortName: shortName;
  vmshift: (modules at: i + 1);
  address: (maxAddressMask bitAnd: (modules at: i + 2) + (modules at: i + 1));
  size: (modules at: i + 3)].
  modules := self filter: modules.
  "The primitive always answers the VM info in the first entry."
  vmModule := modules first.
  modules := modules asSortedCollection: [:m1 :m2| m1 address <= m2 address]!

Item was changed:
  ----- Method: VMProfilerSymbolsManager>>addCogModuleSymbols: (in category 'Cog compiled code') -----
  addCogModuleSymbols: symbols
  self initialized ifFalse:
+ [Cursor wait showWhile:
+ [[self initialized] whileFalse:
+ [(Delay forMilliseconds: 100) wait]]].
- [(Delay forMilliseconds: 1000) wait].
  modules
  removeAllSuchThat: [:existingModule| cogModule name = existingModule name];
  add: cogModule.
  modulesByName at: cogModule name put: cogModule.
  symbolsByModule at: cogModule put: symbols!

Item was changed:
  ----- Method: VMProfilerSymbolsManager>>computeCogCodeModule: (in category 'Cog compiled code') -----
  computeCogCodeModule: cogCodeConstituents
  | symbols |
  (cogModule := VMPExecutableModuleSymbol new)
  name: vmModule shortName, '.', cogCodeConstituents first;
  shortName: cogCodeConstituents first;
  vmshift: 0;
  address: cogCodeConstituents second;
  size: cogCodeConstituents last - cogCodeConstituents second.
  symbols := (3 to: cogCodeConstituents size - 2 by: 2) collect:
  [:i| "Declare methods as public; PICs and entries as private"
  | thing |
  ((thing := cogCodeConstituents at: i) isCompiledMethod
  ifTrue: [VMPPublicFunctionSymbol]
  ifFalse: [VMPPrivateFunctionSymbol]) new
  name: (thing isCompiledMethod
  ifTrue: [thing methodClass name, '>>', thing selector]
  ifFalse: [thing class == cogCodeConstituents first class
  ifTrue: [thing]
  ifFalse: ['PIC ', (thing isString
  ifTrue: [thing]
  ifFalse: [thing printString])]]);
+ address: (self extractAddress: (cogCodeConstituents at: i + 1));
+ mcpcbcpcmap: (cogCodeConstituents at: i + 1);
+ limit: (self extractAddress: (cogCodeConstituents at: i + 3 ifAbsent: [cogCodeConstituents last]))].
- address: (cogCodeConstituents at: i + 1);
- limit: (cogCodeConstituents at: i + 3 ifAbsent: [cogCodeConstituents last])].
  self addCogModuleSymbols: symbols!

Item was added:
+ ----- Method: VMProfilerSymbolsManager>>extractAddress: (in category 'Cog compiled code') -----
+ extractAddress: thing
+ ^ thing isArray ifTrue: [ thing first ] ifFalse: [ thing ]!

Item was removed:
- ----- Method: VMProfilerSymbolsManager>>fileSystem (in category 'accessing') -----
- fileSystem
-
- ^VMFileSystem !

Item was removed:
- ----- Method: VMProfilerSymbolsManager>>fileSystem: (in category 'accessing') -----
- fileSystem: aVMFileSystem
-
- VMFileSystem := aVMFileSystem. !


Loading...