[Vm-dev] missed commit mails

Tobias Pape Das.Linux at gmx.de
Wed Oct 26 11:37:01 UTC 2016


Begin forwarded message:

> Date: Tue, 25 Oct 2016 19:21:17 0000
> From: commits at source.squeak.org
> To: vm-dev at lists.squeakfoundation.org
> Reply-To: vm-dev at lists.squeakfoundation.org
> Subject: VM Maker: CogTools-eem.77.mcz
> Message-Id: <E1bz7Hi-0004fa-M7 at andreas>
> 
> Eliot Miranda uploaded a new version of CogTools to project VM Maker:
> http://source.squeak.org/VMMaker/CogTools-eem.77.mcz
> 
> ==================== Summary ====================
> 
> Name: CogTools-eem.77
> Author: eem
> Time: 25 October 2016, 12:21:11.173725 pm
> UUID: ac5fa14d-b742-4c40-a032-21101aa49c45
> Ancestors: CogTools-eem.76
> 
> Rewrite VMProfiler to maintain sortedSamples instead of low and high-resolution histograms, and hence to scale to 64-bits.  Still need to test the 64-bit version in situ.
> 
> =============== Diff against CogTools-eem.76 ===============
> 
> Item was added:
> + Object subclass: #VMGraphPlotter
> + 	instanceVariableNames: 'histogramSeries integralSeries startAddress integral plotAsBars'
> + 	classVariableNames: ''
> + 	poolDictionaries: ''
> + 	category: 'CogTools-VMProfiler'!
> + 
> + !VMGraphPlotter commentStamp: 'eem 10/25/2016 11:33' prior: 0!
> + A VMGraphPlotter manages the details of adding points to the histogram and integral graphs in VMProfiler>>plotSamplesFrom:to:intoHistogram:andIntegral:!
> 
> Item was added:
> + ----- Method: VMGraphPlotter>>addPlotFor:at: (in category 'plotting') -----
> + addPlotFor: sum at: address
> + 	sum = 0 ifTrue:
> + 		[(histogramSeries points notEmpty
> + 		  and: [histogramSeries points last y > 0]) ifTrue:
> + 			[plotAsBars ifTrue:
> + 				[histogramSeries addPoint: address @ histogramSeries points last y].
> + 			 histogramSeries addPoint: address @ 0].
> + 		 ^self].
> + 
> + 	histogramSeries points isEmpty
> + 		ifTrue:
> + 			[histogramSeries addPoint: startAddress @ 0.
> + 			 address > startAddress ifTrue:
> + 				[histogramSeries addPoint: address @ 0]]
> + 		ifFalse:
> + 			[histogramSeries points last y = 0 ifTrue:
> + 				[histogramSeries addPoint: address @ 0]].
> + 	plotAsBars ifTrue:
> + 		[histogramSeries addPoint: address @ histogramSeries points last y].
> + 	histogramSeries addPoint: address @ sum.
> + 
> + 	integralSeries points isEmpty ifTrue:
> + 		[integralSeries addPoint: startAddress @ 0.
> + 		 address > startAddress ifTrue:
> + 			[integralSeries addPoint: address @ 0]].
> + 		 
> + 	integral := integral + sum.
> + 	integralSeries addPoint: address @ integral!
> 
> Item was added:
> + ----- Method: VMGraphPlotter>>histogram:integral:startAddress: (in category 'initialize-release') -----
> + histogram: histogramPlotSeries integral: integralPlotSeries startAddress: start
> + 	histogramSeries := histogramPlotSeries.
> + 	integralSeries := integralPlotSeries.
> + 	startAddress := start.
> + 	integral := 0.
> + 	plotAsBars := false!
> 
> Item was added:
> + ----- Method: VMGraphPlotter>>plotAsBars (in category 'accessing') -----
> + plotAsBars
> + 	^plotAsBars!
> 
> Item was added:
> + ----- Method: VMGraphPlotter>>plotAsBars: (in category 'accessing') -----
> + plotAsBars: aBoolean
> + 	plotAsBars := aBoolean!
> 
> Item was added:
> + ----- Method: VMPExecutableModuleSymbol>>importance (in category 'comparing') -----
> + importance
> + 	^0!
> 
> Item was added:
> + ----- Method: VMPLabelSymbol>>importance (in category 'comparing') -----
> + importance
> + 	^4!
> 
> Item was removed:
> - VMPSymbol subclass: #VMPObjectFileSymbol
> - 	instanceVariableNames: ''
> - 	classVariableNames: ''
> - 	poolDictionaries: ''
> - 	category: 'CogTools-VMProfiler'!
> - 
> - !VMPObjectFileSymbol commentStamp: '<historical>' prior: 0!
> - A symbol for an object file which has been linked into a module!
> 
> Item was removed:
> - ----- Method: VMPObjectFileSymbol class>>LICENSE (in category 'LICENSE') -----
> - LICENSE
> - 	^'Project Squeak
> - 
> - 	Copyright (c) 2005-2013, 3D Immersive Collaboration Consulting, LLC., All Rights Reserved
> - 
> - 	Redistributions in source code form must reproduce the above copyright and this condition.
> - 
> - Licensed under MIT License (MIT)
> - 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.'!
> 
> Item was removed:
> - ----- Method: VMPObjectFileSymbol>>type (in category 'accessing') -----
> - type
> - 	^#objectFile!
> 
> Item was added:
> + ----- Method: VMPPrivateFunctionSymbol>>importance (in category 'comparing') -----
> + importance
> + 	^2!
> 
> Item was added:
> + ----- Method: VMPPublicFunctionSymbol>>importance (in category 'comparing') -----
> + importance
> + 	^1!
> 
> Item was added:
> + ----- Method: VMPSymbol>>importance (in category 'comparing') -----
> + importance
> + 	^self subclassResponsibility!
> 
> Item was changed:
>  ----- Method: VMProfileGraphLabelMorph>>initialize (in category 'initialization') -----
>  initialize
>  	super initialize.
> + 	color := Color lightBlue lighter lighter.
>  	positionedLabels := Dictionary new.
>  	font := TextStyle default defaultFont.
>  	getLabelsSelector := #positionedLabels!
> 
> 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'
> - 	instanceVariableNames: 'sampleBuffer lowResolution highResSamples lowResSamples 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'
>  	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>>clearProfile (in category 'profiling') -----
>  clearProfile
>  	self stopVMProfile.
>  	self clearVMProfile.
>  	self stopVMProfile.
>  	
> + 	self initializeSamples.
> - 	highResSamples atAllPut: 0.
> - 	lowResSamples atAllPut: 0.
> - 	total := 0.
>  	elapsedTime := 0.
>  	elapsedStats := nil.
> 
>  	self clearHistory.
>  	self updateButtons!
> 
> Item was changed:
>  ----- Method: VMProfiler>>computeHistograms: (in category 'profiling') -----
>  computeHistograms: numSamples
> + 	sampleBuffer ifNil:
> - 	sampleBuffer isNil ifTrue:
>  		[sampleBuffer := Bitmap new: self profileSize].
>  	self getVMProfileSamplesInto: sampleBuffer.
>  	Cursor wait showWhile:
>  		[1 to: numSamples do:
> + 			[:i|
> + 			sampleBag add: (sampleBuffer at: i)].
> + 		 sortedSamples := sampleBag sortedElements].
> - 			[:i| | pc |
> - 			pc := sampleBuffer at: i.
> - 			highResSamples noCheckAt: pc put: (highResSamples noCheckAt: pc) + 1.
> - 			lowResSamples at: pc // lowResolution + 1 put: (lowResSamples at: pc // lowResolution + 1) + 1]].
>  	total := total + numSamples!
> 
> Item was added:
> + ----- Method: VMProfiler>>computeSortedSymbols (in category 'sorting') -----
> + computeSortedSymbols
> + 	sortedSymbols := cogCodeConstituents
> + 						ifNil: [self sortSymbols: symbolManager modules]
> + 						ifNotNil:
> + 							[self sortedSymbolsBeforeCogCode,
> + 							 (self sortSymbols: {symbolManager cogModule}),
> + 							 self sortedSymbolsAfterCogCode]!
> 
> Item was changed:
>  ----- Method: VMProfiler>>highAddressText: (in category 'accessing') -----
>  highAddressText: aText
> + 	highAddress := ((Integer readFrom: aText asString asUppercase readStream base: 16) max: 0) min: self highestAddress.
> - 	highAddress := ((Integer readFrom: aText asString asUppercase readStream base: 16) max: 0) min: 16rFFFFFFFF.
>  	self selectSymbolsInRange!
> 
> Item was removed:
> - ----- Method: VMProfiler>>highResSamplesFor: (in category 'accessing') -----
> - highResSamplesFor: sym
> - 	| samples |
> - 	samples := 0.
> - 	sym address to: sym limit - 1 do:
> - 			[:a| samples := samples + (highResSamples at: a)].
> - 	^samples!
> 
> Item was added:
> + ----- Method: VMProfiler>>highestAddress (in category 'sorting') -----
> + highestAddress
> + 	^(sortedSamples isEmpty
> + 		ifTrue: [symbolManager modules last limit]
> + 		ifFalse: [symbolManager modules last limit max: sortedSamples last key]) asPowerOfTwo - 1!
> 
> Item was changed:
>  ----- Method: VMProfiler>>initialize (in category 'initialization') -----
>  initialize
> + 	self initializeSamples.
> - 	"Use a SparseLargeArray so we can apparently have a sample per pc in the entire address space"
> - 	highResSamples := SparseLargeArray
> - 							new: (2 raisedToInteger: 32)
> - 							chunkSize: 32 * 1024
> - 							arrayClass: Array
> - 							base: 0
> - 							defaultValue: 0.
> - 	lowResolution := 16 * 1024.
> - 	lowResSamples := Array new: (2 raisedToInteger: 32) / lowResolution withAll: 0.
>  	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>>initializeSamples (in category 'initialization') -----
> + initializeSamples
> + 	sampleBag := Bag new. sortedSamples := sampleBag sortedElements.
> + 	total := 0.!
> 
> Item was changed:
>  ----- Method: VMProfiler>>interpReport: (in category 'reports') -----
>  interpReport: s
>  	| totals samplesInInterp |
>  	totals := Dictionary new.
>  	samplesInInterp := 0.
>  	Cursor execute showWhile:
>  		[| interp labels|
>  		interp := (symbolManager symbolsInModule: symbolManager vmModule) detect:
>  					[:sym| sym name endsWith: 'interpret'].
>  		labels := (symbolManager symbolsInModule: symbolManager vmModule) select:
>  					[:sym|
>  					sym type == #label
>  					and: [sym address between: interp address and: interp limit]].
>  		symbolList := {interp}, labels.
>  		symbolList withIndexDo:
>  			[:sym :index| | samples |
> + 			samples := self samplesForRange: sym address
> + 							to: (index < symbolList size
> + 									ifTrue: [(symbolList at: index + 1) address]
> + 									ifFalse: [interp limit]).
> - 			samples := 0.
> - 			sym address
> - 				to: (index < symbolList size
> - 						ifTrue: [(symbolList at: index + 1) address]
> - 						ifFalse: [interp limit]) - 1
> - 				do:
> - 					[:a| samples := samples + (highResSamples at: a)].
>  			samples > 0 ifTrue:
>  				[totals at: sym put: samples.
>  				 samplesInInterp := samplesInInterp + samples]]].
>  	self putReportPreambleOn: s.
>  	s print: samplesInInterp; nextPutAll: ' samples in the Interpreter'; tab; nextPut: $(;
>  	   print: total; nextPutAll: ' samples in the entire program)  '.
>  	self printPercentage: samplesInInterp total: total on: s.
>  	s nextPutAll: ' of total'; cr; cr.
>  	totals isEmpty ifFalse:
>  		[self printSymbolTotals: totals labelled: 'interpret' on: s sumTotal: samplesInInterp].
>  	self class reportGCStats: elapsedStats upTime: elapsedTime on: s!
> 
> Item was removed:
> - ----- Method: VMProfiler>>plot:from:to:addressRange:to: (in category 'graph') -----
> - plot: data from: start to: end addressRange: startAddress to: limitAddress
> - 	| histSeries intSeries resolution prevX prevY prevI sum integral bin binsPerPoint fillInIntegral |
> - 	graph clear.
> - 	histSeries := graph series: #histogram.
> - 	intSeries := graph alternateSeries: #integral.
> - 	fillInIntegral := Preferences vmProfilerFillInIntegral.
> - 	intSeries color: Color magenta; type: #stepped; drawArea: fillInIntegral.
> - 	resolution := graph drawBounds width.
> - 	binsPerPoint := end - start + 1 >= resolution
> - 					ifTrue: [(end - start + 1 / resolution) ceiling]
> - 					ifFalse: [1].
> - 	prevY := prevI := integral := 0.
> - 	prevX := bin := start.
> - 	[bin <= end] whileTrue:
> - 		[binsPerPoint > 1
> - 			ifTrue:
> - 				[sum := 0.
> - 				 bin to: (bin + binsPerPoint - 1 min: end) do:
> - 					[:i| sum := sum + (data at: i)]]
> - 			ifFalse:
> - 				[sum := data at: bin].
> - 		sum = 0
> - 			ifTrue:
> - 				[(bin = start or: [prevY ~= 0]) ifTrue:
> - 					[histSeries addPoint: bin @ sum.
> - 					 intSeries addPoint: bin @ integral]]
> - 			ifFalse:
> - 				[prevY = 0 ifTrue:
> - 					[histSeries addPoint: prevX @ prevY.
> - 					 intSeries addPoint: prevX @ prevI].
> - 				 histSeries addPoint: bin @ sum.
> - 				 intSeries addPoint: bin @ (integral := integral + sum)].
> - 		prevX := bin.
> - 		prevY := sum.
> - 		prevI := integral.
> - 		bin := bin + binsPerPoint].
> - 	histSeries addPoint: end @ 0.
> - 	intSeries addPoint: end @ integral.
> - 	(fillInIntegral and: [integral ~= 0]) ifTrue:
> - 		[intSeries addPoint: end @ 0].
> - 	rangeTotal := integral.
> - 	graph xAxisFormatter:
> - 		[:n| | address |
> - 		address := [startAddress + ((n asFloat - start) * (limitAddress - startAddress) / (end - start))]
> - 					on: ZeroDivide
> - 					do: [:ex| 0].
> - 		(address rounded asInteger printStringRadix: 16) allButFirst: 3].
> - 	graph yAxisFormatter:
> - 		[:n|
> - 		(n rounded = n
> - 			ifTrue: [n]
> - 			ifFalse:
> - 				[n >= 100
> - 					ifTrue: [n rounded]
> - 					ifFalse: [(n * 10) rounded / 10]]) printString].
> - 	graph limitMinX: start limitMaxX: end.
> - 	self changed: #positionedLabels; changed: #totalText!
> 
> Item was changed:
>  ----- Method: VMProfiler>>plotGraph (in category 'graph') -----
>  plotGraph
> + 	sortedSamples isEmpty ifTrue: [^self].
> + 	highAddress = 0 ifTrue:
> + 		[highAddress := self highestAddress.
> - 	lowResSamples first ifNil: [^self].
> - 	(lowAddress = 0 and: [highAddress = 0]) ifTrue:
> - 		[highAddress := (1 << 32) - 1.
>  		 self updateAddressDependents].
> + 	self plotSamplesFrom: lowAddress to: highAddress.
> - 	highAddress - lowAddress / lowResolution > 100
> - 		ifTrue:
> - 			[self plot: lowResSamples
> - 				from: lowAddress // lowResolution + 1
> - 				to: (highAddress + lowResolution - 1 // lowResolution + 1
> - 						min: lowResSamples size)
> - 				addressRange: lowAddress
> - 				to: highAddress]
> - 		ifFalse:
> - 			[self plot: highResSamples
> - 				from: lowAddress
> - 				to: highAddress
> - 				addressRange: lowAddress
> - 				to: highAddress].
>  	graph fullDrawOn: Display getCanvas!
> 
> Item was added:
> + ----- Method: VMProfiler>>plotSamplesFrom:to: (in category 'graph') -----
> + plotSamplesFrom: startAddress to: endAddress
> + 	| histSeries intSeries integral range |
> + 	graph clear.
> + 	histSeries := graph series: #histogram.
> + 	intSeries := graph alternateSeries: #integral.
> + 	intSeries color: Color magenta; type: #stepped; drawArea: Preferences vmProfilerFillInIntegral.
> + 	range := self plotSamplesFrom: startAddress to: endAddress intoHistogram: histSeries andIntegral: intSeries.
> + 	histSeries addPoint: range last @ 0.
> + 	intSeries addPoint: range last @ (integral := intSeries points isEmpty ifTrue: [0] ifFalse: [intSeries points last y]).
> + 	(integral ~= 0 and: [Preferences vmProfilerFillInIntegral]) ifTrue:
> + 		[intSeries addPoint: range last @ 0].
> + 	self assert: histSeries points isEmpty = intSeries points isEmpty.
> + 	histSeries points notEmpty ifTrue:
> + 		[self assert: histSeries points first x = intSeries points first x.
> + 		 self assert: histSeries points last x = intSeries points last x].
> + 	rangeTotal := integral.
> + 	graph xAxisFormatter:
> + 		[:n|
> + 		((range first + (n asFloat - range first)) rounded asInteger printStringRadix: 16) allButFirst: 3].
> + 	graph yAxisFormatter:
> + 		[:n|
> + 		(n rounded = n
> + 			ifTrue: [n]
> + 			ifFalse:
> + 				[n >= 100
> + 					ifTrue: [n rounded]
> + 					ifFalse: [(n * 10) rounded / 10]]) printString].
> + 	graph limitMinX: range first limitMaxX: range last.
> + 	self changed: #positionedLabels; changed: #totalText!
> 
> Item was added:
> + ----- Method: VMProfiler>>plotSamplesFrom:to:intoHistogram:andIntegral: (in category 'graph') -----
> + plotSamplesFrom: startAddress to: endAddress intoHistogram: histogramSeries andIntegral: integralSeries
> + 	"Plot the samples in the range startAddress to: endAddress, inclusive.  Answer the range actually
> + 	 plotted, which may be larger due to rounding when putting multiple addresses in the same bin."
> + 	| resolution sampleIndex numSamples nextSample plotter |
> + 	resolution := graph drawBounds width.
> + 	numSamples := sortedSamples size.
> + 	sampleIndex := sortedSamples findBinaryIndex: [:sample| startAddress - sample key] ifNone: [:lowIdx :highIdx| highIdx].
> + 	sampleIndex > numSamples ifTrue:
> + 		[^startAddress to: endAddress].
> + 	plotter := VMGraphPlotter new histogram: histogramSeries integral: integralSeries startAddress: startAddress.
> + 	nextSample := sortedSamples at: sampleIndex.
> + 	endAddress - startAddress + 1 > (resolution * 1.5) ifTrue:
> + 		[| binsPerPoint range sum |
> + 		 binsPerPoint := (endAddress - startAddress + 1 / resolution) ceiling.
> + 		 range := startAddress to: endAddress + binsPerPoint - 1 by: binsPerPoint.
> + 		 range do:
> + 			[:address| | next |
> + 			 next := address + binsPerPoint.
> + 			 sum := 0.
> + 			 [nextSample key < next] whileTrue:
> + 				[self assert: nextSample key >= address.
> + 				 sum := sum + nextSample value.
> + 				 (sampleIndex := sampleIndex + 1) > numSamples ifTrue:
> + 					[plotter addPlotFor: sum at: address.
> + 					 ^range].
> + 				nextSample := sortedSamples at: sampleIndex].
> + 			 plotter addPlotFor: sum at: address].
> + 			 ^range].
> + 		plotter plotAsBars: true.
> + 	startAddress to: endAddress do:
> + 		[:address|
> + 		 nextSample key <= address
> + 			ifTrue:
> + 				[self assert: nextSample key >= address.
> + 				 plotter addPlotFor: nextSample value at: address.
> + 				 (sampleIndex := sampleIndex + 1) > numSamples ifTrue:
> + 					[^startAddress to: endAddress].
> + 				 nextSample := sortedSamples at: sampleIndex]
> + 			ifFalse:
> + 				[plotter addPlotFor: 0 at: address]].
> + 	^startAddress to: endAddress!
> 
> Item was changed:
>  ----- Method: VMProfiler>>positionedLabels (in category 'accessing') -----
>  positionedLabels
>  	"Compute the set of labels to be displayed for the given address range.
>  	 Try and display no more than maxLabels labels.  The result is a dictionary
>  	 of fractional position in the range to string.  If there are lots of labels, try
>  	 and favour those that have samples."
>  	| maxLabels counts types symbolsInRange positionedLabels index count range significantSymbolsInRange |
>  	maxLabels := 50.
>  	minSelectionIndex isZero ifTrue:
>  		[^Dictionary new].
>  	"count how many labels of each type there are in the range."
>  	counts := Dictionary new.
>  	(types := #(module objectFile publicFunction privateFunction label)) do:
>  		[:type| counts at: type put: 0].
>  	types := types select: [:type| symbolTypes includes: type].
>  	symbolsInRange := symbolManager symbolsSelect: [:sym| sym address <= highAddress and: [sym limit >= lowAddress and: [(symbolTypes includes: sym type)]]].
> + 	"If there are lots of labels then choose to display only those with samples"
> - 	"If there are kots if klabels then choose to display only those with samples"
>  	symbolsInRange size > (maxLabels / 2) ifTrue:
> + 		[significantSymbolsInRange := symbolsInRange select: [:s| (self samplesForSymbol: s) > 0]].
> - 		[significantSymbolsInRange := symbolsInRange select: [:s| (self symHasLowResSamples: s) and: [(self highResSamplesFor: s) > 0]]].
>  	(symbolsInRange size > maxLabels
>  	 and: [significantSymbolsInRange size >= (maxLabels / 2)]) ifTrue:
>  		[symbolsInRange := significantSymbolsInRange].
>  	symbolsInRange do:
>  		[:s| counts at: s type put: (counts at: s type) + 1].
>  	"Find out what types give us at least one label but no more
>  	 than maxLabels unless necessary to have at least one."
>  	index := 1.
>  	count := counts at: (types at: index).
>  	[index <= types size
>  	 and: [count + (counts at: (types at: index)) < maxLabels]] whileTrue:
>  		[count := count + (counts at: (types at: index)).
>  		 index := index + 1].
>  	"add labels to positionedLabels indexed by their fractional position in the range, filtering by type."
>  	types := types copyFrom: 1 to: (index min: types size).
>  	positionedLabels := Dictionary new: count.
>  	range := (highAddress - lowAddress) asFloat.
>  	symbolsInRange do:
>  		[:s |
>  		(types includes: s type) ifTrue:
>  			[positionedLabels
>  				at: ([s address - lowAddress / range]
>  						on: ZeroDivide
>  						do: [:ex| 0])
>  				put: s displayText]].
>  	^positionedLabels!
> 
> Item was added:
> + ----- Method: VMProfiler>>samplesForRange:to: (in category 'accessing') -----
> + samplesForRange: address to: limit
> + 	| numSamples sampleIndex size nextSample |
> + 	numSamples := 0.
> + 	sampleIndex := sortedSamples findBinaryIndex: [:sample| address - sample key] ifNone: [:lowIdx :highIdx| highIdx].
> + 	size := sortedSamples size.
> + 	[sampleIndex <= size
> + 	 and: [(nextSample := sortedSamples at: sampleIndex) key < limit]] whileTrue:
> + 		[numSamples := numSamples + nextSample value.
> + 		 sampleIndex := sampleIndex + 1].
> + 	^numSamples!
> 
> Item was added:
> + ----- Method: VMProfiler>>samplesForSymbol: (in category 'accessing') -----
> + samplesForSymbol: sym
> + 	^self samplesForRange: sym address to: sym limit!
> 
> Item was added:
> + ----- Method: VMProfiler>>sortSymbols: (in category 'sorting') -----
> + sortSymbols: modules
> + 	"Answer an Array of all the symbols in each of modules, which is assumed to be sorted."
> + 	^Array streamContents:
> + 		[:s| | prev |
> + 		 modules do:
> + 			[:m|
> + 			prev
> + 				ifNil: [prev := m]
> + 				ifNotNil: [m address > prev address ifFalse: [self error: 'modules not sorted']].
> + 			s nextPut: m;
> + 			  nextPutAll: ((symbolManager symbolsInModule: m) sorted:
> + 								[:s1 :s2|
> + 								 s1 address = s2 address
> + 									ifTrue: [s1 importance > s2 importance]
> + 									ifFalse: [s1 address < s2 address]])]]!
> 
> Item was added:
> + ----- Method: VMProfiler>>sortedSymbolsAfterCogCode (in category 'sorting') -----
> + sortedSymbolsAfterCogCode
> + 	^sortedSymbolsAfterCogCode ifNil:
> + 		[sortedSymbolsAfterCogCode := self sortSymbols: (symbolManager modules select: [:m| m address > cogCodeConstituents last])]!
> 
> Item was added:
> + ----- Method: VMProfiler>>sortedSymbolsBeforeCogCode (in category 'sorting') -----
> + sortedSymbolsBeforeCogCode
> + 	^sortedSymbolsBeforeCogCode ifNil:
> + 		[sortedSymbolsBeforeCogCode := self sortSymbols: (symbolManager modules select: [:m| m address < cogCodeConstituents second])]!
> 
> Item was changed:
>  ----- Method: VMProfiler>>stopProfiling (in category 'profiling') -----
>  stopProfiling
>  	| numSamples now vmParameters |
>  	numSamples := self stopVMProfile.
>  	now := Time millisecondClockValue.
>  	vmParameters := Smalltalk getVMParameters.
>  	cogCodeConstituents := self primitiveCollectCogCodeConstituents.
>  	elapsedTime := now - startTime + elapsedTime.
>  	self computeStats: vmParameters.
>  	self computeHistograms: numSamples.
>  	self computeCogCodeModule.
> + 	self computeSortedSymbols.
>  	self clearHistory.
>  	self updateButtons!
> 
> Item was removed:
> - ----- Method: VMProfiler>>symHasLowResSamples: (in category 'accessing') -----
> - symHasLowResSamples: sym
> - 	^(sym address // lowResolution to: sym limit // lowResolution)
> - 		anySatisfy:
> - 			[:pc| (lowResSamples at: pc + 1) > 0]!
> 
> Item was changed:
>  ----- Method: VMProfiler>>totalsDo: (in category 'reports') -----
>  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 |
>  	vmTotals := Dictionary new.
>  	cogTotals := Dictionary new.
>  	nonVMTotals := Dictionary new.
>  	samplesInVM := samplesInCog := samplesInNonVMModules := 0.
>  	(symbolManager symbolsInModule: symbolManager vmModule) do:
>  		[:sym| | samples |
>  		((#(publicFunction privateFunction) includes: sym type)
> + 		 and: [(samples := self samplesForSymbol: sym) > 0]) ifTrue:
> - 		 and: [(samples := self highResSamplesFor: 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:
> - 		 and: [(samples := self highResSamplesFor: 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:
> - 			and: [(self symHasLowResSamples: sym)
> - 			and: [(samples := self highResSamplesFor: sym) > 0]]) ifTrue:
>  				[nonVMTotals at: sym put: samples.
>  				 samplesInNonVMModules := samplesInNonVMModules + samples]]].
>  	samplesInNonVM := total - samplesInVM - samplesInCog.
>  	nonVMTotals
>  		at: 'Samples Not In Any Function'
>  		put: samplesInNonVM - samplesInNonVMModules.
>  	septuaryBlock valueWithArguments:
>  		{vmTotals.
>  		 cogTotals.
>  		 nonVMTotals.
>  		 samplesInVM.
>  		 samplesInCog.
>  		 samplesInNonVMModules.
>  		 samplesInNonVM}!
> 
> Item was changed:
>  ----- Method: VMProfiler>>updateAddressSelection (in category 'accessing') -----
>  updateAddressSelection
>  	| min max |
>  	1 to: selections size do:
>  		[:i|
>  		(selections at: i) > 0 ifTrue:
>  			[min ifNil: [min :=i].
>  			 max := i]].
>  	min
>  		ifNil: [lowAddress := 0.
> + 			   highAddress := self highestAddress.
> - 			   highAddress := highAddress := (1 << 32) - 1.
>  			   minSelectionIndex := maxSelectionIndex := 0]
>  		ifNotNil:
>  			[minSelectionIndex := min. maxSelectionIndex := max.
>  			 minSelectionIndex + 1 to: maxSelectionIndex - 1 do:
>  				[:i| selections at: i put: 1].
>  			 lowAddress := (symbolList at: minSelectionIndex) address.
>  			 highAddress := (symbolList at: maxSelectionIndex) limit].
>  	self updateAddressDependents!
> 
> Item was added:
> + ----- Method: VMProfilerMacSymbolsManager>>archName (in category 'parsing') -----
> + archName
> + 	"Answer the architecture name for use with nm, size et al."
> + 	^(Smalltalk image getSystemAttribute: 1003) caseOf: {
> + 		['intel']	->	['i386'].
> + 		['x64']	->	['x86_64'] }!
> 
> Item was added:
> + ----- Method: VMProfilerMacSymbolsManager>>computeLimitFor:initialShift: (in category 'parsing') -----
> + computeLimitFor: module initialShift: initialShift
> + 	"If we can't find a non-text symbol following the last text symbol, compute the ernd of text using the size command."
> + 	| sizeFileName proc text size |
> + 	(tempDir fileExists: (sizeFileName := module shortName, '.size')) ifFalse:
> + 		["N.B. Don't use the -f option (which meant flat symbols) as in El Capitan it is misinterpreted to mean -format."
> + 		 proc := OSProcess thisOSProcess command:
> + 						'cd ', tempDir fullName,
> + 						';size -arch ', self archName, " -f" ' "', module name, '" >"', sizeFileName, '"'.
> + 		 [proc isComplete] whileFalse: [(Delay forMilliseconds: 25) wait]].
> + 	text := (StandardFileStream readOnlyFileNamed: (tempDir fullNameFor: sizeFileName)) contentsOfEntireFile.
> + 	size := Integer readFrom: (text copyAfter: Character lf) readStream.
> + 	^size + initialShift!
> 
> Item was changed:
>  ----- Method: VMProfilerMacSymbolsManager>>initializeMost (in category 'initialize-release') -----
>  initializeMost
>  	| shortNames |
>  	initialized := false.
> + 	maxAddressMask := (2 raisedToInteger: Smalltalk wordSize * 8) - 1.
> - 	maxAddressMask := (2 raisedToInteger: 32) - 1.
>  	modulesByName := Dictionary new.
>  	symbolsByModule := Dictionary new.
>  	shortNames := Set new.
>  	modules := self primitiveExecutableModulesAndOffsets.
>  	(tempDir := self class tempDirectory) assureExistence.
>  	modules := (1 to: modules size by: 4) collect:
>  					[:i| | shortName counter |
>  					shortName := tempDir localNameFor: (modules at: i).
>  					counter := 0.
>  					[shortNames includes: shortName] whileTrue:
>  						[counter := counter + 1.
>  						 shortName := (tempDir localNameFor: (modules at: i)), 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: VMProfilerMacSymbolsManager>>parseAsynchronously (in category 'parsing') -----
>  parseAsynchronously
>  	"Parse the symbols in the background for faster startup."
>  	"Parse only the VM module.  The profiler needs this initialized early."
>  	symbolsByModule at: vmModule put: { vmModule }.
>  	self parseSymbolsFor: vmModule.
>  	"Kick-off a process to compute the symbol list for each module.  Parsing symbols
>  	 can take a few seconds so we parse in the background."
>  	[modules allButFirst do:
>  		[:module|
>  		symbolsByModule at: module put: { module }.
> + 		(self parseSymbolsFor: module) ifNil:
> + 			[symbolsByModule removeKey: module]].
> - 		self parseSymbolsFor: module].
>  	 initialized := true] forkAt: Processor userBackgroundPriority!
> 
> Item was changed:
>  ----- Method: VMProfilerMacSymbolsManager>>parseSymbolsFor: (in category 'parsing') -----
>  parseSymbolsFor: module
> + 	| proc symtab symStream |
> - 	| arch proc symtab symStream |
>  	(tempDir fileExists: module shortName) ifFalse:
> + 		["N.B. Don't use the -f option (which meant flat symbols) as in El Capitan it is misinterpreted to mean -format."
> - 		[arch := (Smalltalk image getSystemAttribute: 1003) caseOf: {
> - 					['intel']	->	['i386'].
> - 					['x64']	->	['x86_64'] }.
> - 		 "N.B. Don't use the -f option (which meant flat symbols) as in El Capitan it is misinterpreted to mean -format."
>  		 proc := OSProcess thisOSProcess command:
>  						'cd ', tempDir fullName,
> + 						';nm -n -arch ', self archName, " -f" ' "', module name, '" | grep -v " [aAU] " >"', module shortName, '"'].
> - 						';nm -n -arch ', arch, " -f" ' "', module name, '" | grep -v " [aAU] " >"', module shortName, '"'].
>  	symStream := (Array new: 1000) writeStream.
>  	symStream nextPut: module.
>  	proc ifNotNil:
>  		[[proc isComplete] whileFalse: [(Delay forMilliseconds: 25) wait]].
>  	symtab := [StandardFileStream readOnlyFileNamed: (tempDir fullNameFor: module shortName)]
>  					on: Error
>  					do: [:ex| "Handle flaky OSProcess stuff by reporting error and failing to parse"
>  						Transcript print: ex; flush.
>  						^nil].
> + 	"Have caller eliminate modules with no text."
> + 	symtab size = 0 ifTrue:
> + 		[^nil].
>  	module shortName = 'HIToolbox' ifTrue: [self halt].
>  	[| prev |
>  	 prev := self parseSymbolsFrom: symtab to: symStream.
>  	"CoreAUC has a huge chunk of data at the end of its text segment that causes the profiler to spend ages
>  	 counting zeros.  Hack fix by setting the end of the last symbol in the text segment to a little less than 1Mb." 
>  	"00000000000f1922    retq" "Mavericks 13.4"
>  	"00000000000f3b21    retq" "Yosemite 14.5"
>  	module shortName = 'CoreAUC' ifTrue: [prev limit: 16rf8000].
>  	 symbolsByModule
>  		at: module
>  		put: (self relocateSymbols: symStream contents allButFirst inModule: module).
>  	 (prev notNil
>  	  and: [prev limit isNil]) ifTrue: [prev limit: module limit]]
>  		ensure: [symtab close]!
> 
> Item was changed:
>  ----- Method: VMProfilerMacSymbolsManager>>parseSymbolsFrom:to: (in category 'parsing') -----
>  parseSymbolsFrom: symtab "<ReadStream>" to: symStream "<WriteStream> ^<VMPSymbol>"
>  	"Parse the text symbols on the stream symtab (in nm format) to symStream.
>  	 Answer the last text symbol."
>  	| space lf prev |
>  	space := Character space.
>  	lf := Character lf.
>  	[symtab atEnd] whileFalse:
>  		[| line ch address |
>  		 line := (symtab upTo: lf) readStream.
>  		 line skipSeparators.
>  		 ((ch := line peek) notNil
>  		   and: [ch ~= space
>  		   and: [(address := self hexFromStream: line) ~= maxAddressMask
>  		   and: [address ~= 0 "on 10.6 this eliminates initial mh_dylib_header entries"]]]) ifTrue:
>  			[| symbol |
> + 			 prev ifNotNil:
> - 			 prev notNil ifTrue:
>  				[prev limit: address].
>  			 ('Tt' includes: line peek)
>  				ifTrue:
>  					[| public |
>  					 public := line next == $T.
>  					 line skipTo: space.
>  					 symbol := (line peek == $L
>  								ifTrue: [VMPLabelSymbol]
>  								ifFalse:
>  									[public
>  										ifTrue: [VMPPublicFunctionSymbol]
>  										ifFalse: [VMPPrivateFunctionSymbol]]) new.
>  					 line peek = $_ ifTrue:	"Get rid of initial underscore."
>  						[line next].			"N.B. relied upon by primitiveDLSym: below"
>  					 symbol
>  						name: line upToEnd;
>  						address: address.
>  					 symStream nextPut: symbol.
>  					 symbol type ~~ #label ifTrue:
>  						[prev := symbol]]
>  				ifFalse: "first non-text symbol marks the end of the text segment"
>  					[symtab setToEnd]]].
>  	^prev!
> 
> Item was changed:
>  ----- Method: VMProfilerMacSymbolsManager>>relocateAndFilter:in:initialShift: (in category 'parsing') -----
>  relocateAndFilter: symbols in: module initialShift: initialShift
>  	"We can't trust the shift that comes from the dyld_get_image_header call in
>  	 primitiveExecutableModulesAndOffsets.  So use dlsym to find out the actual
>  	 address of the first real symbol and use that to compute the real shift.
>  	 At least some libraries (e.g. /usr/lib/libSystem.B.dylib) don't have a single shift (!!!!).
>  	 For these we have to call dlsym on each symbol."
>  	| shift prev lastSize |
>  	prev := nil.
>  	shift := initialShift.
> + 	symbols last limit ifNil:
> + 		[symbols last limit: (self computeLimitFor: module initialShift: initialShift)].
> - 	symbols last limit isNil ifTrue: [self halt].
>  	symbols do:
>  		[:s| | address |
>  		lastSize := s limit ifNotNil: [:limit| limit - s address].
>  		s type == #publicFunction
>  			ifTrue:
>  				[(address := self primitiveDLSym: s name)
>  					ifNil: [s address: nil]
>  					ifNotNil:
>  						[(address between: module address and: module limit)
>  							ifTrue:
>  								[prev notNil ifTrue:
>  									[prev limit: address].
>  								shift := address - s address.
>  								s address: address]
>  							ifFalse: "duplicate symbol from some other library"
>  								[address := maxAddressMask bitAnd: s address + shift.
>  								s address: address.
>  								prev ifNotNil: [prev limit: address].
>  								prev := s].
>  						prev := s]]
>  			ifFalse:
>  				[address := maxAddressMask bitAnd: s address + shift.
>  				s address: address.
>  				prev ifNotNil: [prev limit: address].
>  				prev := s]].
>  	prev limit: (lastSize ifNotNil: [prev address + lastSize] ifNil: [module limit]).
>  	^symbols select: [:s| s address notNil]!
> 
> 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]]].
> - 	[self initialized] whileFalse:
> - 		[(Delay forMilliseconds: 100) 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>>symbolsSelect: (in category 'accessing') -----
>  symbolsSelect: aBlock
>  	| size stream |
>  	size := symbolsByModule inject: 0 into: [:sum :symbols| sum + symbols size].
>  	stream := (Array new: size) writeStream.
>  	modules do:
>  		[:module|
>  		(aBlock value: module) ifTrue:
>  			[stream nextPut: module].
> + 		(symbolsByModule at: module ifAbsent: [#()]) do:
> - 		(symbolsByModule at: module) do:
>  			[:sym|
>  			(aBlock value: sym) ifTrue:
>  				[stream nextPut: sym]]].
>  	^stream contents!
> 
> Item was changed:
>  ----- Method: VMProfilerSymbolsManager>>symbolsWithTypes: (in category 'accessing') -----
>  symbolsWithTypes: aSet
>  	| size stream |
>  	(aSet size = 1 and: [aSet anyOne == #module]) ifTrue:
>  		[^modules].
>  	size := symbolsByModule inject: 0 into: [:sum :symbols| sum + symbols size].
>  	stream := (Array new: size) writeStream.
>  	modules do:
>  		[:module|
> + 		(symbolsByModule at: module ifAbsent: [#()]) do:
> - 		(symbolsByModule at: module) do:
>  			[:sym|
>  			(aSet includes: sym type) ifTrue:
>  				[stream nextPut: sym]]].
>  	^stream contents!
> 
> 
> 



More information about the Vm-dev mailing list