[Vm-dev] VM Maker: CogTools-sk.78.mcz

commits at source.squeak.org commits at source.squeak.org
Wed May 24 16:21:27 UTC 2017


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

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

Name: CogTools-sk.78
Author: sk
Time: 24 May 2017, 6:21:14.59984 pm
UUID: 218fceb7-d6b9-46cc-8182-b3f488cb09c4
Ancestors: CogTools-eem.77

Getting the name and ancestors right...

Port to Pharo
* added a VMFileSystem class to deal with FileDirectory/FileSystem
* 2 subclass for VMProfiler : one for Squeak (with the UI-related methods), one for Pharo (only headless for now). 
* workaround so the symbols sort is performed on mac only (temporary)

=============== Diff against CogTools-eem.77 ===============

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

Item was added:
+ ----- Method: PharoVMFileSystem>>deleteContentsOf: (in category 'as yet unclassified') -----
+ deleteContentsOf: aDirectory
+ 
+ 	"have to find something similar"!

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

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

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

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

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

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

Item was added:
+ ----- Method: PharoVMProfiler class>>amOnSpur (in category 'reports') -----
+ amOnSpur
+ 	^(Smalltalk vm parameterAt: 41) anyMask: 16.!

Item was added:
+ ----- Method: PharoVMProfiler class>>default (in category 'accessing') -----
+ default
+ 	"will do something when a UI will be added for Pharo"
+ 	^self new. !

Item was added:
+ ----- Method: PharoVMProfiler>>createParagraph (in category 'as yet unclassified') -----
+ createParagraph
+ 	
+ 	^Paragraph new!

Item was added:
+ ----- Method: PharoVMProfiler>>getVMParameters (in category 'as yet unclassified') -----
+ getVMParameters
+ 
+ 	^Smalltalk vm getParameters !

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

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

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

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

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

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

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

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

Item was added:
+ ----- Method: SqueakVMProfiler class>>amOnSpur (in category 'reports') -----
+ amOnSpur
+ 	^(Smalltalk vmParameterAt: 41) anyMask: 16!

Item was added:
+ ----- Method: SqueakVMProfiler class>>default (in category 'instance creation') -----
+ default
+ 	^self openInstance!

Item was added:
+ ----- Method: SqueakVMProfiler class>>fixTabs (in category 'as yet unclassified') -----
+ fixTabs
+ 	"Make sure the DefaultTabsArray and DefaultMarginTabsArray are adequately sized for modern displays."
+ 	| defaultTab tempArray width |
+ 	(Smalltalk bindingOf: #TextConstants) ifNil: [^self].
+ 	width := 2000.
+ 	(TextConstants at: #DefaultTabsArray) last < width ifTrue:
+ 		[defaultTab := TextConstants at: #DefaultTab.
+ 		 tempArray := Array new: 2000 // defaultTab.
+ 		 1 to: tempArray size do:
+ 			[:i | tempArray at: i put: defaultTab * i].
+ 		 TextConstants at: #DefaultTabsArray put: tempArray.
+ 		 tempArray := Array new: (width // defaultTab) // 2.
+ 		 1 to: tempArray size do:
+ 			[:i | tempArray at: i put: (Array with: (defaultTab*i) with: (defaultTab*i))].
+ 		 TextConstants at: #DefaultMarginTabsArray put: tempArray]!

Item was added:
+ ----- Method: SqueakVMProfiler class>>initialize (in category 'as yet unclassified') -----
+ initialize
+ 
+ 	super initialize.
+ 	(TheWorldMenu respondsTo: #registerOpenCommand:) ifTrue:
+ 		[TheWorldMenu registerOpenCommand: {'VM Profiler'. {self. #open}. 'A VM profiler'}].
+ 	Preferences ifNotNil: [Preferences addBooleanPreference: #vmProfilerFillInIntegral 
+ 									   category: #vmProfiler 
+ 									   default: false
+ 									   balloonHelp: 'If enabled, the profiler will fill in the area under the integral.'].
+ 	('Squeak*' match: Smalltalk version) ifTrue: [self fixTabs] "ugly fix for configuration. temporary"!

Item was added:
+ ----- Method: SqueakVMProfiler class>>open (in category 'instance creation') -----
+ open
+ 	^self new openInWindow!

Item was added:
+ ----- Method: SqueakVMProfiler class>>openInstance (in category 'instance creation') -----
+ openInstance
+ 	| window |
+ 	window := World submorphs
+ 					detect: [:sm| sm isSystemWindow and: [sm label = 'VMProfiler']]
+ 					ifNone: [self open].
+ 	^window model!

Item was added:
+ ----- Method: SqueakVMProfiler class>>report: (in category 'spying') -----
+ report: aStream
+ 	"Compatibility with MessageTally and AndreasSystemProfiler instance side spyOn: & report:"
+ 	^self openInstance report: aStream!

Item was added:
+ ----- Method: SqueakVMProfiler class>>spyOn: (in category 'spying') -----
+ spyOn: aBlock
+ 	"Compatibility with MessageTally and AndreasSystemProfiler instance side spyOn: & report:"
+ 	^Cursor execute showWhile:
+ 		[self openInstance spyOn: aBlock]!

Item was added:
+ ----- Method: SqueakVMProfiler>>addToHistory (in category 'selecting') -----
+ addToHistory
+ 	historyIndex < history size ifTrue:
+ 		[history := history copyFrom: 1 to: historyIndex].
+ 	(history isEmpty or: [history last ~= (lowAddress to: highAddress)]) ifTrue:
+ 		[history addLast: (lowAddress to: highAddress).
+ 		 historyIndex := history size].
+ !

Item was added:
+ ----- Method: SqueakVMProfiler>>addressTextMorph:get:set: (in category 'opening') -----
+ addressTextMorph: help get: getter set: setter
+ 	| ptm |
+ 	ptm := PluggableTextMorph
+ 			on: self
+ 			text: getter accept: setter
+ 			readSelection: nil menu: nil.
+ 	ptm setProperty: #alwaysAccept toValue: true;
+ 		askBeforeDiscardingEdits: false;
+ 		acceptOnCR: true;
+ 		setBalloonText: help;
+ 		retractableOrNot;
+ 		hideOrShowScrollBars;
+ 		setProperty: #noScrollBarPlease toValue: true;
+ 		setProperty: #noVScrollBarPlease toValue: true.
+ 	^ptm!

Item was added:
+ ----- Method: SqueakVMProfiler>>backwardsButton (in category 'opening') -----
+ backwardsButton
+ 	^ImageMorph new image: ((ScriptingSystem formAtKey: #playMPEG) flipBy: #horizontal centerAt: 0 at 0)!

Item was added:
+ ----- Method: SqueakVMProfiler>>buttonMorph:help:set:enable:color: (in category 'opening') -----
+ buttonMorph: getLabelMessage help: help set: setter enable: enabler color: colorGetter
+ 	| pbm |
+ 	pbm := PluggableButtonMorphPlus on: self getState: nil action: setter label: getLabelMessage.
+ 	pbm
+ 		useRoundedCorners;
+ 		getEnabledSelector: enabler;
+ 		setBalloonText: help;
+ 		getColorSelector: colorGetter;
+ 		offColor: Color transparent.
+ 	^pbm!

Item was added:
+ ----- Method: SqueakVMProfiler>>checkMorph:get:set: (in category 'opening') -----
+ checkMorph: help get: getter set: setter
+ 	| checkBoxButton |
+ 	checkBoxButton := UpdatingThreePhaseButtonMorph checkBox.
+ 	#(onImage pressedImage offImage)
+ 		with: #(onImage: pressedImage: offImage:)
+ 		do: [:get :set| | form |
+ 			((form := checkBoxButton perform: get) isColorForm
+ 			 and: [form colors last = Color white]) ifTrue:
+ 				[checkBoxButton
+ 					perform: set
+ 					with: ((checkBoxButton perform: get) copy
+ 							colors: {Color transparent. Color black};
+ 							yourself)]].
+ 	^checkBoxButton
+ 		target: self;
+ 		actionSelector: setter;
+ 		getSelector: getter;
+ 		setBalloonText: help;
+ 		yourself!

Item was added:
+ ----- Method: SqueakVMProfiler>>clearButton (in category 'buttons') -----
+ clearButton
+ 	"just weird..."
+ 	^'clear'!

Item was added:
+ ----- Method: SqueakVMProfiler>>clearColor (in category 'buttons') -----
+ clearColor
+ 	^Color lightBlue!

Item was added:
+ ----- Method: SqueakVMProfiler>>clearPriorToProfile (in category 'buttons') -----
+ clearPriorToProfile
+ 	^clearPriorToProfile!

Item was added:
+ ----- Method: SqueakVMProfiler>>createParagraph (in category 'as yet unclassified') -----
+ createParagraph
+ 	
+ 	^NewParagraph new!

Item was added:
+ ----- Method: SqueakVMProfiler>>drawButton (in category 'buttons') -----
+ drawButton
+ 	"just weird..."
+ 	^'plot'!

Item was added:
+ ----- Method: SqueakVMProfiler>>expressionTextMenu: (in category 'menus') -----
+ expressionTextMenu: aMenuMorph
+ 	| expression |
+ 	expression := self trimmedExpressionText.
+ 	(expression isEmpty
+ 	or: [CannedBenchmarkStrings includes: expression]) ifFalse:
+ 		[aMenuMorph add: 'add text to benchmarks' target: self class selector: #canBenchmark: argument: expression].
+ 	aMenuMorph add: 'inspect canned benchmarks' target: ToolSet selector: #inspect: argument: CannedBenchmarkStrings.
+ 	CannedBenchmarkStrings isEmpty ifTrue:
+ 		[^aMenuMorph].
+ 	aMenuMorph addLine.
+ 	CannedBenchmarkStrings do:
+ 		[:benchmark|
+ 		 aMenuMorph add: (benchmark contractTo: 60) target: self selector: #selectBenchmark: argument: benchmark].
+ 	^aMenuMorph!

Item was added:
+ ----- Method: SqueakVMProfiler>>findSymbol:event: (in category 'menus') -----
+ findSymbol: typeOrNil event: event
+ 	| pattern matches selection anIndex |
+ 	previousPattern ifNil:
+ 		[previousPattern := '*'].
+ 	pattern := UIManager default
+ 					request: 'Symbol or pattern to find'
+ 					initialAnswer: previousPattern.
+ 	pattern isEmpty ifTrue: [^self].
+ 	previousPattern := pattern.
+ 	matches := symbolManager symbolsSelect:
+ 					(typeOrNil
+ 						ifNotNil:
+ 							[(pattern includesAnyOf: '#*')
+ 								ifTrue: [[:sym|
+ 										 sym type == typeOrNil
+ 										 and: [sym nameMatches: pattern]]]
+ 								ifFalse: [[:sym|
+ 										 sym type == typeOrNil
+ 										 and: [sym name
+ 												includesSubstring: pattern
+ 												caseSensitive: false]]]]
+ 						ifNil:
+ 							[(pattern includesAnyOf: '#*')
+ 								ifTrue: [[:sym| sym nameMatches: pattern]]
+ 								ifFalse: [[:sym| sym name
+ 												includesSubstring: pattern
+ 												caseSensitive: false]]]).
+ 	matches isEmpty ifTrue:
+ 		[^UIManager inform: 'No symbols match your query'].
+ 	matches size = 1
+ 		ifTrue: [selection := matches first]
+ 		ifFalse:
+ 			[matches := matches asSortedCollection:
+ 					[:s1 :s2| | sd1 sd2 |
+ 					(sd1 := s1 displayText) asString < (sd2 := s2 displayText) asString
+ 					or: [sd1 = sd2 and: [s1 address <= s2 address]]].
+ 			 selection := (SelectionMenu
+ 							labelList: {'Choose symbol'},
+ 									  (matches collect:
+ 										[:ea|
+ 										ea type == #module
+ 											ifTrue: [ea displayText]
+ 											ifFalse: [ea displayText, ' @', (ea address printStringRadix: 16),
+ 													' in ', (symbolManager moduleFor: ea) displayText]])
+ 							lines: {1}
+ 							selections: {nil}, matches) startUp.
+ 			selection ifNil: [^self]].
+ 	(symbolTypes includes: selection type) ifFalse:
+ 		[self toggleShowing: selection type].
+ 	minSelectionIndex := 0.
+ 	1 to: symbolList size do:
+ 		[:i|
+ 		selections
+ 			at: i
+ 			put: (((symbolList at: i) address >= selection address
+ 				  and: [(symbolList at: i) limit <= selection limit])
+ 					ifTrue: [minSelectionIndex = 0 ifTrue: [minSelectionIndex := i].
+ 							maxSelectionIndex := i.
+ 							1]
+ 					ifFalse: [0])].
+ 	self changed: #symbolList.
+ 	self addToHistory.
+ 	"If selecting a label make sure there's not a zero address range so
+ 	 select from the previous non-label symbol to the following non-label symbol"
+ 	selection address = selection limit
+ 		ifTrue: [anIndex := minSelectionIndex.
+ 				[(symbolList at: anIndex) type == #label
+ 				and: [anIndex > 1]] whileTrue: [anIndex := anIndex - 1].
+ 				lowAddress := (symbolList at: anIndex) address.
+ 				anIndex := maxSelectionIndex.
+ 				[(symbolList at: anIndex) type == #label
+ 				and: [anIndex < symbolList size]] whileTrue: [anIndex := anIndex + 1].
+ 				highAddress := (symbolList at: anIndex) address]
+ 		ifFalse:
+ 			[lowAddress := selection address.
+ 			 highAddress := selection limit]. 
+ 	self updateAddressDependents;
+ 		updateButtons;
+ 		plotGraph!

Item was added:
+ ----- Method: SqueakVMProfiler>>forkProfile (in category 'buttons') -----
+ forkProfile
+ 	^forkProfile!

Item was added:
+ ----- Method: SqueakVMProfiler>>forwardsButton (in category 'opening') -----
+ forwardsButton
+ 	^ImageMorph new image: (ScriptingSystem formAtKey: #playMPEG)!

Item was added:
+ ----- Method: SqueakVMProfiler>>getVMParameters (in category 'as yet unclassified') -----
+ getVMParameters
+ 
+ 	^Smalltalk getVMParameters !

Item was added:
+ ----- Method: SqueakVMProfiler>>graphMargin (in category 'accessing') -----
+ graphMargin
+ 	^graph margin!

Item was added:
+ ----- Method: SqueakVMProfiler>>hasFuture (in category 'selecting') -----
+ hasFuture
+ 	^historyIndex < history size!

Item was added:
+ ----- Method: SqueakVMProfiler>>hasFutureColor (in category 'buttons') -----
+ hasFutureColor
+ 	^self hasFuture ifTrue: [Color transparent] ifFalse: [Color darkGray]!

Item was added:
+ ----- Method: SqueakVMProfiler>>hasHistory (in category 'selecting') -----
+ hasHistory
+ 	^historyIndex >= 1!

Item was added:
+ ----- Method: SqueakVMProfiler>>hasHistoryColor (in category 'buttons') -----
+ hasHistoryColor
+ 	^self hasHistory ifTrue: [Color transparent] ifFalse: [Color darkGray]!

Item was added:
+ ----- Method: SqueakVMProfiler>>highAddressText (in category 'accessing') -----
+ highAddressText
+ 	^((highAddress printStringRadix: 16) allButFirst: 3) asText!

Item was added:
+ ----- Method: SqueakVMProfiler>>highAddressText: (in category 'accessing') -----
+ highAddressText: aText
+ 	highAddress := ((Integer readFrom: aText asString asUppercase readStream base: 16) max: 0) min: self highestAddress.
+ 	self selectSymbolsInRange!

Item was added:
+ ----- Method: SqueakVMProfiler>>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 added:
+ ----- Method: SqueakVMProfiler>>historyButtonMorph:help:set:enable:color: (in category 'opening') -----
+ historyButtonMorph: getLabelMessage help: help set: setter enable: enabler color: colorGetter
+ 	| pbm |
+ 	pbm := PluggableButtonMorphPlus on: self getState: nil action: setter label: getLabelMessage.
+ 	pbm
+ 		getEnabledSelector: enabler;
+ 		setBalloonText: help;
+ 		getColorSelector: colorGetter;
+ 		offColor: Color transparent.
+ 	^pbm!

Item was added:
+ ----- Method: SqueakVMProfiler>>labelFont (in category 'opening') -----
+ labelFont
+ 	"Answer the font in which to draw the graph labels.
+ 	 N.B. the labelling morph shrinks this font by half when displaying."
+ 	^(TextStyle named: 'BitstreamVeraSans') fontOfPointSize: 16!

Item was added:
+ ----- Method: SqueakVMProfiler>>lowAddressText (in category 'accessing') -----
+ lowAddressText
+ 	^((lowAddress printStringRadix: 16) allButFirst: 3) asText!

Item was added:
+ ----- Method: SqueakVMProfiler>>lowAddressText: (in category 'accessing') -----
+ lowAddressText: aText
+ 	lowAddress := ((Integer readFrom: aText asString asUppercase readStream base: 16) max: 0) min: 16rFFFFFFFF.
+ 	self selectSymbolsInRange!

Item was added:
+ ----- Method: SqueakVMProfiler>>notProfiling (in category 'profiling') -----
+ notProfiling
+ 	^self profiling not!

Item was added:
+ ----- Method: SqueakVMProfiler>>notProfilingAndData (in category 'profiling') -----
+ notProfilingAndData
+ 	^sampleBuffer notNil and: [self notProfiling]!

Item was added:
+ ----- Method: SqueakVMProfiler>>openInWindow (in category 'opening') -----
+ openInWindow
+ 	"VMProfiler open"
+ 	| window symbolListMorph labelsMorph buttons |
+ 	(window := SystemWindow new)
+ 		setProperty: #allowPaneSplitters toValue: false;
+ 		model: self;
+ 		setLabel: self class name;
+ 		fillStyle: Color white;
+ 		paneColor: Color white;
+ 		color: Color white.
+ 	(window respondsTo: #allowPaneSplitters:) ifTrue:
+ 		[window allowPaneSplitters: false].
+ 	"Cope with Squeak 4.1 SystemWindow background color changes"
+ 	window addMorph: (AlignmentMorph new color: Color white; yourself) frame: (0 at 0 corner: 1 at 1).
+ 	symbolListMorph := PluggableListMorphOfManyAlt
+ 						on: self
+ 						list: #symbolList
+ 						primarySelection: #symbolIndex
+ 						changePrimarySelection: #toggleListIndex:
+ 						listSelection: #symbolSelectionAt:
+ 						changeListSelection: #symbolSelectionAt:put:
+ 						getListElement: #listEntryForIndex:
+ 						menu: #symbolListMenu:.
+ 	symbolListMorph showHScrollBarOnlyWhenNeeded: false. "buggy misnamed selector :)"
+ 	labelsMorph := VMProfileGraphLabelMorph model: self font: self labelFont getLabels: #positionedLabels.
+ 	expressionTextMorph := PluggableTextMorph
+ 								on: self
+ 								text: nil accept: nil
+ 								readSelection: #selectionRange
+ 								menu: #expressionTextMenu:.
+ 	expressionTextMorph
+ 		setProperty: #alwaysAccept toValue: true;
+ 		askBeforeDiscardingEdits: false;
+ 		setBalloonText: 'type an expression to profile here'.
+ 	buttons := OrderedCollection new.
+ 	window
+ 		addMorph: symbolListMorph frame: (0 at 0 corner: 0.15 at 1);
+ 		addMorph: (graph := VMProfilePlotMorph model: self) frame: (0.15 at 0 corner: 1.0 at 0.7);
+ 		addMorph: labelsMorph frame: (0.15 at 0.7 corner: 1.0 at 0.85);
+ 		"address boxes"
+ 		addMorph: (self addressTextMorph:'Type the low address of the histogram here'
+ 						get: #lowAddressText
+ 						set: #lowAddressText:)
+ 			frame: (0.16 at 0.86 corner: 0.27 at 0.91);
+ 		addMorph: (self addressTextMorph:'Type the high address of the histogram here'
+ 						get: #highAddressText
+ 						set: #highAddressText:)
+ 			frame: (0.88 at 0.86 corner: 0.99 at 0.91);
+ 		addMorph: (self totalTextMorph: 'Shows the total number of samples' get: #totalText)
+ 			frame: (0.88 at 0.92 corner: 0.99 at 0.98);
+ 		"symbol list check-box filters"
+ 		addMorph: (self checkMorph: 'show module symbols'
+ 						get: #showingModules
+ 						set: #toggleShowModules)
+ 			frame: (0.16 at 0.915 corner: 0.175 at 0.93);
+ 		addMorph: (buttons addLast: (StringMorph contents: 'modules'))
+ 			frame: (0.19 at 0.915 corner: 0.27 at 0.93);
+ 		addMorph: (self checkMorph: 'show extern symbols'
+ 						get: #showingPublicFunctions
+ 						set: #toggleShowPublicFunctions)
+ 			frame: (0.16 at 0.935 corner: 0.175 at 0.95);
+ 		addMorph: (buttons addLast: (StringMorph contents: 'externs'))
+ 			frame: (0.19 at 0.935 corner: 0.27 at 0.95);
+ 		addMorph: (self checkMorph: 'show static symbols'
+ 						get: #showingPrivateFunctions
+ 						set: #toggleShowPrivateFunctions)
+ 			frame: (0.16 at 0.955 corner: 0.175 at 0.97);
+ 		addMorph: (buttons addLast: (StringMorph contents: 'statics'))
+ 			frame: (0.19 at 0.955 corner: 0.27 at 0.97);
+ 		addMorph: (self checkMorph: 'show static symbols'
+ 						get: #showingLabels
+ 						set: #toggleShowLabels)
+ 			frame: (0.16 at 0.975 corner: 0.175 at 0.99);
+ 		addMorph: (buttons addLast: (StringMorph contents: 'labels'))
+ 			frame: (0.19 at 0.975 corner: 0.27 at 0.99);
+ 		"history buttons"
+ 		addMorph: (self historyButtonMorph: #backwardsButton help: 'go back to previous selection'
+ 						set: #regress enable: #hasHistory color: #hasHistoryColor)
+ 			frame: (0.28 at 0.86 corner: 0.315 at 0.90);
+ 		addMorph: (self historyButtonMorph: #forwardsButton help: 'go forward to next selection'
+ 						set: #progress enable: #hasFuture color: #hasFutureColor)
+ 			frame: (0.32 at 0.86 corner: 0.355 at 0.90);
+ 		"profiling buttons"
+ 		addMorph: (self buttonMorph: #drawButton help: 'plot the graph'
+ 						set: #plotGraph enable: #notProfilingAndData color: #clearColor)
+ 			frame: (0.37 at 0.86 corner: 0.45 at 0.91);
+ 		addMorph: (self buttonMorph: #clearButton help: 'clear the histogram data'
+ 						set: #clearProfile enable: #notProfiling color: #clearColor)
+ 			frame: (0.46 at 0.86 corner: 0.54 at 0.91);
+ 		addMorph: (self buttonMorph: #startButton help: 'start the profiler'
+ 						set: #startProfiling enable: #notProfiling color: #profileColor)
+ 			frame: (0.28 at 0.915 corner: 0.36 at 0.96);
+ 		addMorph: (self buttonMorph: #stopButton help: 'stop the profiler'
+ 						set: #stopProfiling enable: #profiling color: #stopColor)
+ 			frame: (0.37 at 0.915 corner: 0.45 at 0.96);
+ 		addMorph: (self buttonMorph: #profileExpressionButton help: 'compile and profile the expression to the right'
+ 						set: #profileExpression enable: #notProfiling color: #profileColor)
+ 			frame: (0.46 at 0.915 corner: 0.54 at 0.96);
+ 		addMorph: expressionTextMorph
+ 			frame: (0.55 at 0.86 corner: 0.87 at 0.98);
+ 		addMorph: (self checkMorph: 'Run the full garbage collector prior to profiling'
+ 						get: #gcPriorToProfile
+ 						set: #toggleGcPriorToProfile)
+ 			frame: (0.28 at 0.97 corner: 0.295 at 0.985);
+ 		addMorph: (buttons addLast: (StringMorph contents: 'gc prior'))
+ 			frame: (0.30 at 0.97 corner: 0.365 at 0.995);
+ 		addMorph: (self checkMorph: 'Clear the profile prior to profiling'
+ 						get: #clearPriorToProfile
+ 						set: #toggleClearPriorToProfile)
+ 			frame: (0.37 at 0.97 corner: 0.385 at 0.985);
+ 		addMorph: (buttons addLast: (StringMorph contents: 'clear prior'))
+ 			frame: (0.39 at 0.97 corner: 0.455 at 0.995);
+ 		addMorph: (self checkMorph: 'Run the profiled expression in its own process'
+ 						get: #forkProfile
+ 						set: #toggleForkProfile)
+ 			frame: (0.46 at 0.97 corner: 0.475 at 0.985);
+ 		addMorph: (buttons addLast: (StringMorph contents: 'fork profile'))
+ 			frame: (0.48 at 0.97 corner: 0.545 at 0.995).
+ .
+ 	"A Color transparent fillStyle used to be the default.  What a
+ 	 pain that things change so radically from release to release!!"
+ 	graph fillStyle: Color transparent.
+ 
+ 	self updateButtons. "weird!!"
+ 	buttons do: [:buttonMorph| buttonMorph color: Color black]. "otherwise labels don't show :("
+ 	window openInWorld.
+ 	self toggleShowing: #module.
+ 	^window!

Item was added:
+ ----- Method: SqueakVMProfiler>>plotGraph (in category 'graph') -----
+ plotGraph
+ 	sortedSamples isEmpty ifTrue: [^self].
+ 	highAddress = 0 ifTrue:
+ 		[highAddress := self highestAddress.
+ 		 self updateAddressDependents].
+ 	self plotSamplesFrom: lowAddress to: highAddress.
+ 	graph fullDrawOn: Display getCanvas!

Item was added:
+ ----- Method: SqueakVMProfiler>>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: SqueakVMProfiler>>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 added:
+ ----- Method: SqueakVMProfiler>>profileColor (in category 'buttons') -----
+ profileColor
+ 	^self profiling ifTrue: [Color darkGray] ifFalse: [Color lightGreen]!

Item was added:
+ ----- Method: SqueakVMProfiler>>profileExpression (in category 'profiling') -----
+ profileExpression
+ 	| expressionText logExpression block |
+ 	expressionText := expressionTextMorph text.
+ 	expressionText isEmpty ifTrue:
+ 		[^self changed: #flash].
+ 	(expressionText first = $[
+ 	and: [expressionText last = $] ]) ifFalse:
+ 		[expressionText := '[' asText, expressionText, ']' asText.
+ 		 expressionTextMorph setText: expressionText].
+ 	self changed: #selectionRange with: (1 to: expressionText size).
+ 	logExpression := true.  "This could be a preference but for now allows both versions to live here."
+ 	block := logExpression
+ 				ifTrue: [expressionTextMorph doIt]
+ 				ifFalse:
+ 					[Compiler
+ 						evaluate: expressionText
+ 						for: nil
+ 						notifying: (expressionTextMorph instVarNamed: 'textMorph') editor
+ 						logged: false].
+ 	block == expressionTextMorph ifTrue:
+ 		[self error: expressionTextMorph class name, '>>doit does not answer the result'].
+ 	block isBlock ifTrue:
+ 		[self spyOn: block]!

Item was added:
+ ----- Method: SqueakVMProfiler>>profileExpressionButton (in category 'buttons') -----
+ profileExpressionButton
+ 	"Just weird!!"
+ 	^'profile:'!

Item was added:
+ ----- Method: SqueakVMProfiler>>profiling (in category 'profiling') -----
+ profiling
+ 	^aboutToProfile or: [self statusOfVMProfile]!

Item was added:
+ ----- Method: SqueakVMProfiler>>progress (in category 'selecting') -----
+ progress
+ 	| range |
+ 	range := history at: (historyIndex := historyIndex + 1).
+ 	lowAddress := range first.
+ 	highAddress := range last.
+ 	self updateAddressDependents.
+ 	self updateButtons.
+ 	self selectSymbolsInRange.
+ 	self plotGraph!

Item was added:
+ ----- Method: SqueakVMProfiler>>regress (in category 'as yet unclassified') -----
+ regress
+ 	| range |
+ 	range := history at: historyIndex.
+ 	range = (lowAddress to: highAddress)
+ 		ifTrue:
+ 			[(historyIndex := historyIndex - 1) > 0 ifTrue:
+ 				[range := history at: historyIndex]]
+ 		ifFalse:
+ 			[history addLast: (lowAddress to: highAddress)].
+ 	lowAddress := range first.
+ 	highAddress := range last.
+ 	self updateAddressDependents.
+ 	self updateButtons.
+ 	self selectSymbolsInRange.
+ 	self plotGraph!

Item was added:
+ ----- Method: SqueakVMProfiler>>selectProportionFrom:to: (in category 'as yet unclassified') -----
+ selectProportionFrom: low to: high
+ 	| range |
+ 	self addToHistory.
+ 	range := highAddress - lowAddress.
+ 	highAddress := lowAddress + (range * high) rounded.
+ 	lowAddress := lowAddress + (range * low) rounded.
+ 	self selectSymbolsInRange.
+ 	self updateAddressDependents.
+ 	self updateButtons.
+ 	self plotGraph!

Item was added:
+ ----- Method: SqueakVMProfiler>>selectionRange (in category 'profiling') -----
+ selectionRange
+ 	^expressionTextMorph
+ 		ifNotNil: [1 to: expressionTextMorph text size]
+ 		ifNil: [0 to: 0]!

Item was added:
+ ----- Method: SqueakVMProfiler>>showingLabels (in category 'buttons') -----
+ showingLabels
+ 	^symbolTypes includes: #label!

Item was added:
+ ----- Method: SqueakVMProfiler>>showingModules (in category 'buttons') -----
+ showingModules
+ 	^symbolTypes includes: #module!

Item was added:
+ ----- Method: SqueakVMProfiler>>showingPrivateFunctions (in category 'buttons') -----
+ showingPrivateFunctions
+ 	^symbolTypes includes: #privateFunction!

Item was added:
+ ----- Method: SqueakVMProfiler>>showingPublicFunctions (in category 'buttons') -----
+ showingPublicFunctions
+ 	^symbolTypes includes: #publicFunction!

Item was added:
+ ----- Method: SqueakVMProfiler>>spyOn: (in category 'spying') -----
+ spyOn: aBlock
+ 	
+ 	| r |
+ 	r := super spyOn: aBlock.
+ 	WorldState addDeferredUIMessage: [self plotGraph].
+ 	^ r
+ 	!

Item was added:
+ ----- Method: SqueakVMProfiler>>startButton (in category 'buttons') -----
+ startButton
+ 	"just weird..."
+ 	^'start'!

Item was added:
+ ----- Method: SqueakVMProfiler>>statusOfVMProfile (in category 'primitives') -----
+ statusOfVMProfile
+ 	<primitive: 252>
+ 	^self primitiveFailed!

Item was added:
+ ----- Method: SqueakVMProfiler>>stopButton (in category 'buttons') -----
+ stopButton
+ 	"just weird..."
+ 	^'stop'!

Item was added:
+ ----- Method: SqueakVMProfiler>>stopColor (in category 'buttons') -----
+ stopColor
+ 	^self profiling ifTrue: [Color red] ifFalse: [Color darkGray]!

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

Item was added:
+ ----- Method: SqueakVMProfiler>>symbolListMenu: (in category 'menus') -----
+ symbolListMenu: aMenuMorph
+ 	aMenuMorph
+ 		add: 'find...' target: self selector: #findSymbol:event: argument: nil;
+ 		add: 'find module...' target: self selector: #findSymbol:event: argument: #module;
+ 		add: 'find extern...' target: self selector: #findSymbol:event: argument: #publicFunction;
+ 		add: 'find static...' target: self selector: #findSymbol:event: argument: #privateFunction;
+ 		add: 'find label...' target: self selector: #findSymbol:event: argument: #label.
+ 	sampleBuffer ifNotNil:
+ 		[aMenuMorph
+ 			addLine;
+ 			add: 'vm report' target: self selector: #vmReport: argument: #justWeird;
+ 			add: 'interpreter report' target: self selector: #interpreterReport: argument: #justWeird].
+ 	^aMenuMorph!

Item was added:
+ ----- Method: SqueakVMProfiler>>symbolSelectionAt:put: (in category 'accessing') -----
+ symbolSelectionAt: index put: aBoolean
+ 	Transcript cr; nextPutAll: #symbolSelectionAt:; space; print: index; nextPutAll: ' put: '; print: aBoolean; flush.
+ 	minSelectionIndex := maxSelectionIndex := index.
+ 	(index between: 1 and: selections size) ifTrue:
+ 		[selections at: index put: (aBoolean ifTrue: [1] ifFalse: [0])].
+ 	1 to: minSelectionIndex - 1 do:
+ 		[:i| selections at: i put: 0].
+ 	maxSelectionIndex + 1 to: selections size do:
+ 		[:i| selections at: i put: 0].
+ 	self changed: #symbolList.
+ 	self updateAddressSelection!

Item was added:
+ ----- Method: SqueakVMProfiler>>toggleClearPriorToProfile (in category 'buttons') -----
+ toggleClearPriorToProfile
+ 	clearPriorToProfile := clearPriorToProfile not.
+ 	self changed: #clearPriorToProfile!

Item was added:
+ ----- Method: SqueakVMProfiler>>toggleForkProfile (in category 'buttons') -----
+ toggleForkProfile
+ 	forkProfile := forkProfile not.
+ 	self changed: #forkProfile!

Item was added:
+ ----- Method: SqueakVMProfiler>>toggleGcPriorToProfile (in category 'buttons') -----
+ toggleGcPriorToProfile
+ 	gcPriorToProfile := gcPriorToProfile not.
+ 	self changed: #gcPriorToProfile!

Item was added:
+ ----- Method: SqueakVMProfiler>>toggleListIndex: (in category 'accessing') -----
+ toggleListIndex: index
+ 	Transcript cr; nextPutAll: #toggleListIndex:; space; print: index; flush.
+ 	selections at: index put: ((selections at: index ifAbsent: [^self]) bitXor: 1).
+ 	self updateAddressSelection!

Item was added:
+ ----- Method: SqueakVMProfiler>>toggleShowLabels (in category 'buttons') -----
+ toggleShowLabels
+ 	self toggleShowing: #label!

Item was added:
+ ----- Method: SqueakVMProfiler>>toggleShowModules (in category 'buttons') -----
+ toggleShowModules
+ 	self toggleShowing: #module!

Item was added:
+ ----- Method: SqueakVMProfiler>>toggleShowPrivateFunctions (in category 'buttons') -----
+ toggleShowPrivateFunctions
+ 	self toggleShowing: #privateFunction!

Item was added:
+ ----- Method: SqueakVMProfiler>>toggleShowPublicFunctions (in category 'buttons') -----
+ toggleShowPublicFunctions
+ 	self toggleShowing: #publicFunction!

Item was added:
+ ----- Method: SqueakVMProfiler>>totalText (in category 'accessing') -----
+ totalText
+ 	^(String streamContents:
+ 		[:s|
+ 		total > 0 ifTrue:
+ 			[s	print: (rangeTotal * 10000 / total) rounded / 100.0;
+ 				nextPutAll: '% of';
+ 				cr].
+ 		s print: total]) asText!

Item was added:
+ ----- Method: SqueakVMProfiler>>totalTextMorph:get: (in category 'opening') -----
+ totalTextMorph: help get: getter
+ 	| ptm |
+ 	ptm := PluggableTextMorph
+ 			on: self
+ 			text: getter accept: nil
+ 			readSelection: nil menu: nil.
+ 	ptm askBeforeDiscardingEdits: false;
+ 		setBalloonText: help;
+ 		retractableOrNot;
+ 		hideOrShowScrollBars;
+ 		setProperty: #noScrollBarPlease toValue: true;
+ 		setProperty: #noVScrollBarPlease toValue: true.
+ 	^ptm!

Item was added:
+ ----- Method: SqueakVMProfiler>>updateAddressDependents (in category 'accessing') -----
+ updateAddressDependents
+ 	self changed: #lowAddressText; changed: #highAddressText; changed: #symbolIndex.
+ 	self dependents do:
+ 		[:dep|
+ 		 (dep class == PluggableTextMorph
+ 		  and: [dep getTextSelector == #highAddressText]) ifTrue:
+ 			[(dep instVarNamed: 'textMorph') editor setAlignment: #rightFlush]]!

Item was added:
+ ----- Method: SqueakVMProfiler>>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.
+ 			   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:
+ Object subclass: #VMFileSystem
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'CogTools-VMProfiler'!
+ 
+ !VMFileSystem commentStamp: 'SophieKaleba 5/15/2017 01:49' prior: 0!
+ I am a bridge between the file systems of Pharo and Squeak.
+ I am used in the VMProfiler to keep it generic.!

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

Item was added:
+ ----- Method: VMFileSystem>>ensureExistenceOfDirectory: (in category 'public') -----
+ ensureExistenceOfDirectory: aDirName
+ 	self subclassResponsibility !

Item was added:
+ ----- Method: VMFileSystem>>exists: (in category 'public') -----
+ exists: aFilename
+ 	self subclassResponsibility !

Item was added:
+ ----- Method: VMFileSystem>>nameFordirPath:plus: (in category 'as yet unclassified') -----
+ nameFordirPath: aDirPath plus: aProcessId
+ 	
+ 	self subclassResponsibility !

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

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

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 version fileSystem'
- 	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'
  	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 removed:
- ----- Method: VMProfiler class>>amOnSpur (in category 'reports') -----
- amOnSpur
- 	^(Smalltalk vmParameterAt: 41) anyMask: 16!

Item was removed:
- ----- Method: VMProfiler class>>default (in category 'instance creation') -----
- default
- 	^self openInstance!

Item was removed:
- ----- Method: VMProfiler class>>fixTabs (in category 'class initialization') -----
- fixTabs
- 	"Make sure the DefaultTabsArray and DefaultMarginTabsArray are adequately sized for modern displays."
- 	| defaultTab tempArray width |
- 	(Smalltalk bindingOf: #TextConstants) ifNil: [^self].
- 	width := 2000.
- 	(TextConstants at: #DefaultTabsArray) last < width ifTrue:
- 		[defaultTab := TextConstants at: #DefaultTab.
- 		 tempArray := Array new: 2000 // defaultTab.
- 		 1 to: tempArray size do:
- 			[:i | tempArray at: i put: defaultTab * i].
- 		 TextConstants at: #defaultTabsArray put: tempArray.
- 		 tempArray := Array new: (width // defaultTab) // 2.
- 		 1 to: tempArray size do:
- 			[:i | tempArray at: i put: (Array with: (defaultTab*i) with: (defaultTab*i))].
- 		 TextConstants at: #DefaultMarginTabsArray put: tempArray]!

Item was added:
+ ----- 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) version new
+ 		headlessSpyOn: aBlock;
+ 		report: aStream.
+ 		 !

Item was changed:
  ----- Method: VMProfiler class>>initialize (in category 'class initialization') -----
  initialize
  
  	CannedBenchmarkStrings := OrderedCollection new.
+ 	!
- 	(TheWorldMenu respondsTo: #registerOpenCommand:) ifTrue:
- 		[TheWorldMenu registerOpenCommand: {'VM Profiler'. {self. #open}. 'A VM profiler'}].
- 	Preferences
- 		addBooleanPreference: #vmProfilerFillInIntegral 
- 		category: #vmProfiler 
- 		default: false
- 		balloonHelp: 'If enabled, the profiler will fill in the area under the integral.'.
- 	self fixTabs!

Item was removed:
- ----- Method: VMProfiler class>>open (in category 'instance creation') -----
- open
- 	^self new openInWindow!

Item was removed:
- ----- Method: VMProfiler class>>openInstance (in category 'instance creation') -----
- openInstance
- 	| window |
- 	window := World submorphs
- 					detect: [:sm| sm isSystemWindow and: [sm label = 'VMProfiler']]
- 					ifNone: [self open].
- 	^window model!

Item was removed:
- ----- Method: VMProfiler class>>report: (in category 'spying') -----
- report: aStream
- 	"Compatibility with MessageTally and AndreasSystemProfiler instance side spyOn: & report:"
- 	^self openInstance 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 (';
+ 		print: ((fullGCTime / elapsedMilliseconds * 100) roundTo: 0.001);
- 		print: fullGCTime / elapsedMilliseconds * 100 maxDecimalPlaces: 3;
  		nextPutAll: '% elapsed time)'.
  	fullGCs = 0 ifFalse:
+ 		[str	nextPutAll: ', avg '; print: (fullGCTime / fullGCs roundTo: 0.001); nextPutAll: 'ms'].
- 		[str	nextPutAll: ', avg '; print: fullGCTime / fullGCs maxDecimalPlaces: 3; nextPutAll: 'ms'].
  	str	cr.
  	str	nextPutAll: (self amOnSpur ifTrue: ['	scavenges	'] ifFalse: ['	incr			']);
  		print: incrGCs; nextPutAll: ' totalling '; nextPutAll: incrGCTime asStringWithCommas; nextPutAll: 'ms (';
+ 		print: ((incrGCTime / elapsedMilliseconds * 100) roundTo: 0.001);
- 		print: incrGCTime / elapsedMilliseconds * 100 maxDecimalPlaces: 3;
  		nextPutAll: '% elapsed time)'.
  	incrGCs = 0 ifFalse:
+ 		[str nextPutAll:', avg '; print: (incrGCTime / incrGCs roundTo: 0.001); nextPutAll: 'ms'].
- 		[str nextPutAll:', avg '; print: incrGCTime / incrGCs maxDecimalPlaces: 3; 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 (';
+ 			print: ((compactionMsecs / elapsedMilliseconds * 100) roundTo: 0.001);
- 			print: compactionMsecs / elapsedMilliseconds * 100 maxDecimalPlaces: 3;
  			nextPutAll: '% elapsed time)'.
  		numCompactions = 0 ifFalse:
+ 			[str	nextPutAll: ', avg '; print: (compactionMsecs / numCompactions roundTo: 0.001); nextPutAll: 'ms'].
- 			[str	nextPutAll: ', avg '; print: compactionMsecs / numCompactions maxDecimalPlaces: 3; 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 changed:
  ----- Method: VMProfiler class>>spyOn: (in category 'spying') -----
  spyOn: aBlock
+ 	
+ 	(VMProfiler new) version default
+ 		spyOn: aBlock.
+ 
+ 	!
- 	"Compatibility with MessageTally and AndreasSystemProfiler instance side spyOn: & report:"
- 	^Cursor execute showWhile:
- 		[self openInstance spyOn: aBlock]!

Item was removed:
- ----- Method: VMProfiler>>addToHistory (in category 'selecting') -----
- addToHistory
- 	historyIndex < history size ifTrue:
- 		[history := history copyFrom: 1 to: historyIndex].
- 	(history isEmpty or: [history last ~= (lowAddress to: highAddress)]) ifTrue:
- 		[history addLast: (lowAddress to: highAddress).
- 		 historyIndex := history size].
- !

Item was removed:
- ----- Method: VMProfiler>>addressTextMorph:get:set: (in category 'opening') -----
- addressTextMorph: help get: getter set: setter
- 	| ptm |
- 	ptm := PluggableTextMorph
- 			on: self
- 			text: getter accept: setter
- 			readSelection: nil menu: nil.
- 	ptm setProperty: #alwaysAccept toValue: true;
- 		askBeforeDiscardingEdits: false;
- 		acceptOnCR: true;
- 		setBalloonText: help;
- 		retractableOrNot;
- 		hideOrShowScrollBars;
- 		setProperty: #noScrollBarPlease toValue: true;
- 		setProperty: #noVScrollBarPlease toValue: true.
- 	^ptm!

Item was removed:
- ----- Method: VMProfiler>>backwardsButton (in category 'opening') -----
- backwardsButton
- 	^ImageMorph new image: ((ScriptingSystem formAtKey: #playMPEG) flipBy: #horizontal centerAt: 0 at 0)!

Item was removed:
- ----- Method: VMProfiler>>buttonMorph:help:set:enable:color: (in category 'opening') -----
- buttonMorph: getLabelMessage help: help set: setter enable: enabler color: colorGetter
- 	| pbm |
- 	pbm := PluggableButtonMorphPlus on: self getState: nil action: setter label: getLabelMessage.
- 	pbm
- 		useRoundedCorners;
- 		getEnabledSelector: enabler;
- 		setBalloonText: help;
- 		getColorSelector: colorGetter;
- 		offColor: Color transparent.
- 	^pbm!

Item was removed:
- ----- Method: VMProfiler>>checkMorph:get:set: (in category 'opening') -----
- checkMorph: help get: getter set: setter
- 	| checkBoxButton |
- 	checkBoxButton := UpdatingThreePhaseButtonMorph checkBox.
- 	#(onImage pressedImage offImage)
- 		with: #(onImage: pressedImage: offImage:)
- 		do: [:get :set| | form |
- 			((form := checkBoxButton perform: get) isColorForm
- 			 and: [form colors last = Color white]) ifTrue:
- 				[checkBoxButton
- 					perform: set
- 					with: ((checkBoxButton perform: get) copy
- 							colors: {Color transparent. Color black};
- 							yourself)]].
- 	^checkBoxButton
- 		target: self;
- 		actionSelector: setter;
- 		getSelector: getter;
- 		setBalloonText: help;
- 		yourself!

Item was removed:
- ----- Method: VMProfiler>>clearButton (in category 'buttons') -----
- clearButton
- 	"just weird..."
- 	^'clear'!

Item was removed:
- ----- Method: VMProfiler>>clearColor (in category 'buttons') -----
- clearColor
- 	^Color lightBlue!

Item was removed:
- ----- Method: VMProfiler>>clearPriorToProfile (in category 'buttons') -----
- clearPriorToProfile
- 	^clearPriorToProfile!

Item was changed:
  ----- Method: VMProfiler>>clearProfile (in category 'profiling') -----
  clearProfile
  	self stopVMProfile.
  	self clearVMProfile.
  	self stopVMProfile.
  	
  	self initializeSamples.
  	elapsedTime := 0.
  	elapsedStats := nil.
  
  	self clearHistory.
+ !
- 	self updateButtons!

Item was added:
+ ----- Method: VMProfiler>>createParagraph (in category 'as yet unclassified') -----
+ createParagraph
+ 	
+ 	self subclassResponsibility !

Item was removed:
- ----- Method: VMProfiler>>drawButton (in category 'buttons') -----
- drawButton
- 	"just weird..."
- 	^'plot'!

Item was removed:
- ----- Method: VMProfiler>>expressionTextMenu: (in category 'menus') -----
- expressionTextMenu: aMenuMorph
- 	| expression |
- 	expression := self trimmedExpressionText.
- 	(expression isEmpty
- 	or: [CannedBenchmarkStrings includes: expression]) ifFalse:
- 		[aMenuMorph add: 'add text to benchmarks' target: self class selector: #canBenchmark: argument: expression].
- 	aMenuMorph add: 'inspect canned benchmarks' target: ToolSet selector: #inspect: argument: CannedBenchmarkStrings.
- 	CannedBenchmarkStrings isEmpty ifTrue:
- 		[^aMenuMorph].
- 	aMenuMorph addLine.
- 	CannedBenchmarkStrings do:
- 		[:benchmark|
- 		 aMenuMorph add: (benchmark contractTo: 60) target: self selector: #selectBenchmark: argument: benchmark].
- 	^aMenuMorph!

Item was removed:
- ----- Method: VMProfiler>>findSymbol:event: (in category 'menus') -----
- findSymbol: typeOrNil event: event
- 	| pattern matches selection anIndex |
- 	previousPattern ifNil:
- 		[previousPattern := '*'].
- 	pattern := UIManager default
- 					request: 'Symbol or pattern to find'
- 					initialAnswer: previousPattern.
- 	pattern isEmpty ifTrue: [^self].
- 	previousPattern := pattern.
- 	matches := symbolManager symbolsSelect:
- 					(typeOrNil
- 						ifNotNil:
- 							[(pattern includesAnyOf: '#*')
- 								ifTrue: [[:sym|
- 										 sym type == typeOrNil
- 										 and: [sym nameMatches: pattern]]]
- 								ifFalse: [[:sym|
- 										 sym type == typeOrNil
- 										 and: [sym name
- 												includesSubstring: pattern
- 												caseSensitive: false]]]]
- 						ifNil:
- 							[(pattern includesAnyOf: '#*')
- 								ifTrue: [[:sym| sym nameMatches: pattern]]
- 								ifFalse: [[:sym| sym name
- 												includesSubstring: pattern
- 												caseSensitive: false]]]).
- 	matches isEmpty ifTrue:
- 		[^UIManager inform: 'No symbols match your query'].
- 	matches size = 1
- 		ifTrue: [selection := matches first]
- 		ifFalse:
- 			[matches := matches asSortedCollection:
- 					[:s1 :s2| | sd1 sd2 |
- 					(sd1 := s1 displayText) asString < (sd2 := s2 displayText) asString
- 					or: [sd1 = sd2 and: [s1 address <= s2 address]]].
- 			 selection := (SelectionMenu
- 							labelList: {'Choose symbol'},
- 									  (matches collect:
- 										[:ea|
- 										ea type == #module
- 											ifTrue: [ea displayText]
- 											ifFalse: [ea displayText, ' @', (ea address printStringRadix: 16),
- 													' in ', (symbolManager moduleFor: ea) displayText]])
- 							lines: {1}
- 							selections: {nil}, matches) startUp.
- 			selection ifNil: [^self]].
- 	(symbolTypes includes: selection type) ifFalse:
- 		[self toggleShowing: selection type].
- 	minSelectionIndex := 0.
- 	1 to: symbolList size do:
- 		[:i|
- 		selections
- 			at: i
- 			put: (((symbolList at: i) address >= selection address
- 				  and: [(symbolList at: i) limit <= selection limit])
- 					ifTrue: [minSelectionIndex = 0 ifTrue: [minSelectionIndex := i].
- 							maxSelectionIndex := i.
- 							1]
- 					ifFalse: [0])].
- 	self changed: #symbolList.
- 	self addToHistory.
- 	"If selecting a label make sure there's not a zero address range so
- 	 select from the previous non-label symbol to the following non-label symbol"
- 	selection address = selection limit
- 		ifTrue: [anIndex := minSelectionIndex.
- 				[(symbolList at: anIndex) type == #label
- 				and: [anIndex > 1]] whileTrue: [anIndex := anIndex - 1].
- 				lowAddress := (symbolList at: anIndex) address.
- 				anIndex := maxSelectionIndex.
- 				[(symbolList at: anIndex) type == #label
- 				and: [anIndex < symbolList size]] whileTrue: [anIndex := anIndex + 1].
- 				highAddress := (symbolList at: anIndex) address]
- 		ifFalse:
- 			[lowAddress := selection address.
- 			 highAddress := selection limit]. 
- 	self updateAddressDependents;
- 		updateButtons;
- 		plotGraph!

Item was removed:
- ----- Method: VMProfiler>>forkProfile (in category 'buttons') -----
- forkProfile
- 	^forkProfile!

Item was removed:
- ----- Method: VMProfiler>>forwardsButton (in category 'opening') -----
- forwardsButton
- 	^ImageMorph new image: (ScriptingSystem formAtKey: #playMPEG)!

Item was changed:
+ ----- Method: VMProfiler>>gcPriorToProfile (in category 'as yet unclassified') -----
- ----- Method: VMProfiler>>gcPriorToProfile (in category 'buttons') -----
  gcPriorToProfile
  	^gcPriorToProfile!

Item was added:
+ ----- Method: VMProfiler>>getVMParameters (in category 'as yet unclassified') -----
+ getVMParameters
+ 
+ 	self subclassResponsibility !

Item was removed:
- ----- Method: VMProfiler>>graphMargin (in category 'accessing') -----
- graphMargin
- 	^graph margin!

Item was removed:
- ----- Method: VMProfiler>>hasFuture (in category 'selecting') -----
- hasFuture
- 	^historyIndex < history size!

Item was removed:
- ----- Method: VMProfiler>>hasFutureColor (in category 'buttons') -----
- hasFutureColor
- 	^self hasFuture ifTrue: [Color transparent] ifFalse: [Color darkGray]!

Item was removed:
- ----- Method: VMProfiler>>hasHistory (in category 'selecting') -----
- hasHistory
- 	^historyIndex >= 1!

Item was removed:
- ----- Method: VMProfiler>>hasHistoryColor (in category 'buttons') -----
- hasHistoryColor
- 	^self hasHistory ifTrue: [Color transparent] ifFalse: [Color darkGray]!

Item was added:
+ ----- Method: VMProfiler>>headlessSpyOn: (in category 'spying') -----
+ headlessSpyOn: aBlock
+ 	| blockToProfile r |
+ 	blockToProfile := forkProfile 
+ 						ifTrue:
+ 							[| sem fr |
+ 							 sem := Semaphore new.
+ 							 [[fr := aBlock value. sem signal] fork.
+ 							   sem wait.
+ 							   fr]]
+ 						ifFalse: [aBlock].
+ 	[self selectBenchmark: aBlock sourceString]
+ 		on: Error
+ 		do: [:ex|].
+ 	self startProfiling.
+ 	r := blockToProfile ensure: [self stopProfiling].
+ 	^r
+ !

Item was removed:
- ----- Method: VMProfiler>>highAddressText (in category 'accessing') -----
- highAddressText
- 	^((highAddress printStringRadix: 16) allButFirst: 3) asText!

Item was removed:
- ----- Method: VMProfiler>>highAddressText: (in category 'accessing') -----
- highAddressText: aText
- 	highAddress := ((Integer readFrom: aText asString asUppercase readStream base: 16) max: 0) min: self highestAddress.
- 	self selectSymbolsInRange!

Item was removed:
- ----- 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 removed:
- ----- Method: VMProfiler>>historyButtonMorph:help:set:enable:color: (in category 'opening') -----
- historyButtonMorph: getLabelMessage help: help set: setter enable: enabler color: colorGetter
- 	| pbm |
- 	pbm := PluggableButtonMorphPlus on: self getState: nil action: setter label: getLabelMessage.
- 	pbm
- 		getEnabledSelector: enabler;
- 		setBalloonText: help;
- 		getColorSelector: colorGetter;
- 		offColor: Color transparent.
- 	^pbm!

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

Item was added:
+ ----- 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 removed:
- ----- Method: VMProfiler>>labelFont (in category 'opening') -----
- labelFont
- 	"Answer the font in which to draw the graph labels.
- 	 N.B. the labelling morph shrinks this font by half when displaying."
- 	^(TextStyle named: 'BitstreamVeraSans') fontOfPointSize: 16!

Item was removed:
- ----- Method: VMProfiler>>lowAddressText (in category 'accessing') -----
- lowAddressText
- 	^((lowAddress printStringRadix: 16) allButFirst: 3) asText!

Item was removed:
- ----- Method: VMProfiler>>lowAddressText: (in category 'accessing') -----
- lowAddressText: aText
- 	lowAddress := ((Integer readFrom: aText asString asUppercase readStream base: 16) max: 0) min: 16rFFFFFFFF.
- 	self selectSymbolsInRange!

Item was removed:
- ----- Method: VMProfiler>>notProfiling (in category 'profiling') -----
- notProfiling
- 	^self profiling not!

Item was removed:
- ----- Method: VMProfiler>>notProfilingAndData (in category 'profiling') -----
- notProfilingAndData
- 	^sampleBuffer notNil and: [self notProfiling]!

Item was removed:
- ----- Method: VMProfiler>>openInWindow (in category 'opening') -----
- openInWindow
- 	"VMProfiler open"
- 	| window symbolListMorph labelsMorph buttons |
- 	(window := SystemWindow new)
- 		setProperty: #allowPaneSplitters toValue: false;
- 		model: self;
- 		setLabel: self class name;
- 		fillStyle: Color white;
- 		paneColor: Color white;
- 		color: Color white.
- 	(window respondsTo: #allowPaneSplitters:) ifTrue:
- 		[window allowPaneSplitters: false].
- 	"Cope with Squeak 4.1 SystemWindow background color changes"
- 	window addMorph: (AlignmentMorph new color: Color white; yourself) frame: (0 at 0 corner: 1 at 1).
- 	symbolListMorph := PluggableListMorphOfManyAlt
- 						on: self
- 						list: #symbolList
- 						primarySelection: #symbolIndex
- 						changePrimarySelection: #toggleListIndex:
- 						listSelection: #symbolSelectionAt:
- 						changeListSelection: #symbolSelectionAt:put:
- 						getListElement: #listEntryForIndex:
- 						menu: #symbolListMenu:.
- 	symbolListMorph showHScrollBarOnlyWhenNeeded: false. "buggy misnamed selector :)"
- 	labelsMorph := VMProfileGraphLabelMorph model: self font: self labelFont getLabels: #positionedLabels.
- 	expressionTextMorph := PluggableTextMorph
- 								on: self
- 								text: nil accept: nil
- 								readSelection: #selectionRange
- 								menu: #expressionTextMenu:.
- 	expressionTextMorph
- 		setProperty: #alwaysAccept toValue: true;
- 		askBeforeDiscardingEdits: false;
- 		setBalloonText: 'type an expression to profile here'.
- 	buttons := OrderedCollection new.
- 	window
- 		addMorph: symbolListMorph frame: (0 at 0 corner: 0.15 at 1);
- 		addMorph: (graph := VMProfilePlotMorph model: self) frame: (0.15 at 0 corner: 1.0 at 0.7);
- 		addMorph: labelsMorph frame: (0.15 at 0.7 corner: 1.0 at 0.85);
- 		"address boxes"
- 		addMorph: (self addressTextMorph:'Type the low address of the histogram here'
- 						get: #lowAddressText
- 						set: #lowAddressText:)
- 			frame: (0.16 at 0.86 corner: 0.27 at 0.91);
- 		addMorph: (self addressTextMorph:'Type the high address of the histogram here'
- 						get: #highAddressText
- 						set: #highAddressText:)
- 			frame: (0.88 at 0.86 corner: 0.99 at 0.91);
- 		addMorph: (self totalTextMorph: 'Shows the total number of samples' get: #totalText)
- 			frame: (0.88 at 0.92 corner: 0.99 at 0.98);
- 		"symbol list check-box filters"
- 		addMorph: (self checkMorph: 'show module symbols'
- 						get: #showingModules
- 						set: #toggleShowModules)
- 			frame: (0.16 at 0.915 corner: 0.175 at 0.93);
- 		addMorph: (buttons addLast: (StringMorph contents: 'modules'))
- 			frame: (0.19 at 0.915 corner: 0.27 at 0.93);
- 		addMorph: (self checkMorph: 'show extern symbols'
- 						get: #showingPublicFunctions
- 						set: #toggleShowPublicFunctions)
- 			frame: (0.16 at 0.935 corner: 0.175 at 0.95);
- 		addMorph: (buttons addLast: (StringMorph contents: 'externs'))
- 			frame: (0.19 at 0.935 corner: 0.27 at 0.95);
- 		addMorph: (self checkMorph: 'show static symbols'
- 						get: #showingPrivateFunctions
- 						set: #toggleShowPrivateFunctions)
- 			frame: (0.16 at 0.955 corner: 0.175 at 0.97);
- 		addMorph: (buttons addLast: (StringMorph contents: 'statics'))
- 			frame: (0.19 at 0.955 corner: 0.27 at 0.97);
- 		addMorph: (self checkMorph: 'show static symbols'
- 						get: #showingLabels
- 						set: #toggleShowLabels)
- 			frame: (0.16 at 0.975 corner: 0.175 at 0.99);
- 		addMorph: (buttons addLast: (StringMorph contents: 'labels'))
- 			frame: (0.19 at 0.975 corner: 0.27 at 0.99);
- 		"history buttons"
- 		addMorph: (self historyButtonMorph: #backwardsButton help: 'go back to previous selection'
- 						set: #regress enable: #hasHistory color: #hasHistoryColor)
- 			frame: (0.28 at 0.86 corner: 0.315 at 0.90);
- 		addMorph: (self historyButtonMorph: #forwardsButton help: 'go forward to next selection'
- 						set: #progress enable: #hasFuture color: #hasFutureColor)
- 			frame: (0.32 at 0.86 corner: 0.355 at 0.90);
- 		"profiling buttons"
- 		addMorph: (self buttonMorph: #drawButton help: 'plot the graph'
- 						set: #plotGraph enable: #notProfilingAndData color: #clearColor)
- 			frame: (0.37 at 0.86 corner: 0.45 at 0.91);
- 		addMorph: (self buttonMorph: #clearButton help: 'clear the histogram data'
- 						set: #clearProfile enable: #notProfiling color: #clearColor)
- 			frame: (0.46 at 0.86 corner: 0.54 at 0.91);
- 		addMorph: (self buttonMorph: #startButton help: 'start the profiler'
- 						set: #startProfiling enable: #notProfiling color: #profileColor)
- 			frame: (0.28 at 0.915 corner: 0.36 at 0.96);
- 		addMorph: (self buttonMorph: #stopButton help: 'stop the profiler'
- 						set: #stopProfiling enable: #profiling color: #stopColor)
- 			frame: (0.37 at 0.915 corner: 0.45 at 0.96);
- 		addMorph: (self buttonMorph: #profileExpressionButton help: 'compile and profile the expression to the right'
- 						set: #profileExpression enable: #notProfiling color: #profileColor)
- 			frame: (0.46 at 0.915 corner: 0.54 at 0.96);
- 		addMorph: expressionTextMorph
- 			frame: (0.55 at 0.86 corner: 0.87 at 0.98);
- 		addMorph: (self checkMorph: 'Run the full garbage collector prior to profiling'
- 						get: #gcPriorToProfile
- 						set: #toggleGcPriorToProfile)
- 			frame: (0.28 at 0.97 corner: 0.295 at 0.985);
- 		addMorph: (buttons addLast: (StringMorph contents: 'gc prior'))
- 			frame: (0.30 at 0.97 corner: 0.365 at 0.995);
- 		addMorph: (self checkMorph: 'Clear the profile prior to profiling'
- 						get: #clearPriorToProfile
- 						set: #toggleClearPriorToProfile)
- 			frame: (0.37 at 0.97 corner: 0.385 at 0.985);
- 		addMorph: (buttons addLast: (StringMorph contents: 'clear prior'))
- 			frame: (0.39 at 0.97 corner: 0.455 at 0.995);
- 		addMorph: (self checkMorph: 'Run the profiled expression in its own process'
- 						get: #forkProfile
- 						set: #toggleForkProfile)
- 			frame: (0.46 at 0.97 corner: 0.475 at 0.985);
- 		addMorph: (buttons addLast: (StringMorph contents: 'fork profile'))
- 			frame: (0.48 at 0.97 corner: 0.545 at 0.995).
- .
- 	"A Color transparent fillStyle used to be the default.  What a
- 	 pain that things change so radically from release to release!!"
- 	graph fillStyle: Color transparent.
- 
- 	self updateButtons. "weird!!"
- 	buttons do: [:buttonMorph| buttonMorph color: Color black]. "otherwise labels don't show :("
- 	window openInWorld.
- 	self toggleShowing: #module.
- 	^window!

Item was removed:
- ----- Method: VMProfiler>>plotGraph (in category 'graph') -----
- plotGraph
- 	sortedSamples isEmpty ifTrue: [^self].
- 	highAddress = 0 ifTrue:
- 		[highAddress := self highestAddress.
- 		 self updateAddressDependents].
- 	self plotSamplesFrom: lowAddress to: highAddress.
- 	graph fullDrawOn: Display getCanvas!

Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: VMProfiler>>profileColor (in category 'buttons') -----
- profileColor
- 	^self profiling ifTrue: [Color darkGray] ifFalse: [Color lightGreen]!

Item was removed:
- ----- Method: VMProfiler>>profileExpression (in category 'profiling') -----
- profileExpression
- 	| expressionText logExpression block |
- 	expressionText := expressionTextMorph text.
- 	expressionText isEmpty ifTrue:
- 		[^self changed: #flash].
- 	(expressionText first = $[
- 	and: [expressionText last = $] ]) ifFalse:
- 		[expressionText := '[' asText, expressionText, ']' asText.
- 		 expressionTextMorph setText: expressionText].
- 	self changed: #selectionRange with: (1 to: expressionText size).
- 	logExpression := true.  "This could be a preference but for now allows both versions to live here."
- 	block := logExpression
- 				ifTrue: [expressionTextMorph doIt]
- 				ifFalse:
- 					[Compiler
- 						evaluate: expressionText
- 						for: nil
- 						notifying: (expressionTextMorph instVarNamed: 'textMorph') editor
- 						logged: false].
- 	block == expressionTextMorph ifTrue:
- 		[self error: expressionTextMorph class name, '>>doit does not answer the result'].
- 	block isBlock ifTrue:
- 		[self spyOn: block]!

Item was removed:
- ----- Method: VMProfiler>>profileExpressionButton (in category 'buttons') -----
- profileExpressionButton
- 	"Just weird!!"
- 	^'profile:'!

Item was changed:
  ----- Method: VMProfiler>>profileSize (in category 'profiling') -----
  profileSize
  	"Answer the number of pc samples to allocate space for in the VM.
  	 This corresponds to the maximum time the system can collect samples.
  	 Since the VM manages the sample buffer as a ring buffer the VM
  	 answers the last profileSize samples.
  	 256 * 1024 / (1000000 / 666.0) = 174.6 seconds =  2.9 minutes"
  	^256 * 1024!

Item was removed:
- ----- Method: VMProfiler>>profiling (in category 'profiling') -----
- profiling
- 	^aboutToProfile or: [self statusOfVMProfile]!

Item was removed:
- ----- Method: VMProfiler>>progress (in category 'selecting') -----
- progress
- 	| range |
- 	range := history at: (historyIndex := historyIndex + 1).
- 	lowAddress := range first.
- 	highAddress := range last.
- 	self updateAddressDependents.
- 	self updateButtons.
- 	self selectSymbolsInRange.
- 	self plotGraph!

Item was removed:
- ----- Method: VMProfiler>>regress (in category 'selecting') -----
- regress
- 	| range |
- 	range := history at: historyIndex.
- 	range = (lowAddress to: highAddress)
- 		ifTrue:
- 			[(historyIndex := historyIndex - 1) > 0 ifTrue:
- 				[range := history at: historyIndex]]
- 		ifFalse:
- 			[history addLast: (lowAddress to: highAddress)].
- 	lowAddress := range first.
- 	highAddress := range last.
- 	self updateAddressDependents.
- 	self updateButtons.
- 	self selectSymbolsInRange.
- 	self plotGraph!

Item was changed:
  ----- Method: VMProfiler>>report: (in category 'reports') -----
  report: s
  	self totalsDo:
  		[:vmTotals :cogTotals :nonVMTotals
  		 :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].
  		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 removed:
- ----- Method: VMProfiler>>selectProportionFrom:to: (in category 'selecting') -----
- selectProportionFrom: low to: high
- 	| range |
- 	self addToHistory.
- 	range := highAddress - lowAddress.
- 	highAddress := lowAddress + (range * high) rounded.
- 	lowAddress := lowAddress + (range * low) rounded.
- 	self selectSymbolsInRange.
- 	self updateAddressDependents.
- 	self updateButtons.
- 	self plotGraph!

Item was removed:
- ----- Method: VMProfiler>>selectionRange (in category 'profiling') -----
- selectionRange
- 	^expressionTextMorph
- 		ifNotNil: [1 to: expressionTextMorph text size]
- 		ifNil: [0 to: 0]!

Item was removed:
- ----- Method: VMProfiler>>showingLabels (in category 'buttons') -----
- showingLabels
- 	^symbolTypes includes: #label!

Item was removed:
- ----- Method: VMProfiler>>showingModules (in category 'buttons') -----
- showingModules
- 	^symbolTypes includes: #module!

Item was removed:
- ----- Method: VMProfiler>>showingPrivateFunctions (in category 'buttons') -----
- showingPrivateFunctions
- 	^symbolTypes includes: #privateFunction!

Item was removed:
- ----- Method: VMProfiler>>showingPublicFunctions (in category 'buttons') -----
- showingPublicFunctions
- 	^symbolTypes includes: #publicFunction!

Item was changed:
  ----- Method: VMProfiler>>spyOn: (in category 'spying') -----
  spyOn: aBlock
+ 	^ self headlessSpyOn: aBlock
+ 	!
- 	| blockToProfile r |
- 	blockToProfile := forkProfile
- 						ifTrue:
- 							[| sem fr |
- 							 sem := Semaphore new.
- 							 [[fr := aBlock value. sem signal] fork.
- 							   sem wait.
- 							   fr]]
- 						ifFalse: [aBlock].
- 	[self selectBenchmark: aBlock sourceString]
- 		on: Error
- 		do: [:ex|].
- 	self startProfiling.
- 	r := blockToProfile ensure: [self stopProfiling].
- 	WorldState addDeferredUIMessage:
- 		[self plotGraph].
- 	^r!

Item was removed:
- ----- Method: VMProfiler>>startButton (in category 'buttons') -----
- startButton
- 	"just weird..."
- 	^'start'!

Item was changed:
  ----- Method: VMProfiler>>startProfiling (in category 'profiling') -----
  startProfiling
+ 	"still UI-dependent"
  	"Use aboutToProfile to allow us to change the button colors without including the change in the profile."
  	aboutToProfile := true.
  	self clearHistory.
  	self updateButtons.
  	World doOneCycleNow.
  	clearPriorToProfile ifTrue: [self clearProfile].
  	gcPriorToProfile ifTrue: [Smalltalk garbageCollect].
+ 	startStats := self getVMParameters. 
- 	startStats := Smalltalk getVMParameters.
  	startTime := Time millisecondClockValue.
  	self startVMProfile.
  	aboutToProfile := false!

Item was removed:
- ----- Method: VMProfiler>>statusOfVMProfile (in category 'primitives') -----
- statusOfVMProfile
- 	<primitive: 252>
- 	^self primitiveFailed!

Item was removed:
- ----- Method: VMProfiler>>stopButton (in category 'buttons') -----
- stopButton
- 	"just weird..."
- 	^'stop'!

Item was removed:
- ----- Method: VMProfiler>>stopColor (in category 'buttons') -----
- stopColor
- 	^self profiling ifTrue: [Color red] ifFalse: [Color darkGray]!

Item was changed:
  ----- Method: VMProfiler>>stopProfiling (in category 'profiling') -----
  stopProfiling
+ 	"still UI-dependent"
  	| numSamples now vmParameters |
  	numSamples := self stopVMProfile.
  	now := Time millisecondClockValue.
+ 	vmParameters := self getVMParameters. 
- 	vmParameters := Smalltalk getVMParameters.
  	cogCodeConstituents := self primitiveCollectCogCodeConstituents.
  	elapsedTime := now - startTime + elapsedTime.
  	self computeStats: vmParameters.
  	self computeHistograms: numSamples.
  	self computeCogCodeModule.
+ 	('Mac OS' match: Smalltalk platformName) ifTrue: [self computeSortedSymbols]. "workaround. sometimes fails on linux"
- 	self computeSortedSymbols.
  	self clearHistory.
+ 	!
- 	self updateButtons!

Item was removed:
- ----- Method: VMProfiler>>symbolListMenu: (in category 'menus') -----
- symbolListMenu: aMenuMorph
- 	aMenuMorph
- 		add: 'find...' target: self selector: #findSymbol:event: argument: nil;
- 		add: 'find module...' target: self selector: #findSymbol:event: argument: #module;
- 		add: 'find extern...' target: self selector: #findSymbol:event: argument: #publicFunction;
- 		add: 'find static...' target: self selector: #findSymbol:event: argument: #privateFunction;
- 		add: 'find label...' target: self selector: #findSymbol:event: argument: #label.
- 	sampleBuffer ifNotNil:
- 		[aMenuMorph
- 			addLine;
- 			add: 'vm report' target: self selector: #vmReport: argument: #justWeird;
- 			add: 'interpreter report' target: self selector: #interpreterReport: argument: #justWeird].
- 	^aMenuMorph!

Item was removed:
- ----- Method: VMProfiler>>symbolSelectionAt:put: (in category 'accessing') -----
- symbolSelectionAt: index put: aBoolean
- 	Transcript cr; nextPutAll: #symbolSelectionAt:; space; print: index; nextPutAll: ' put: '; print: aBoolean; flush.
- 	minSelectionIndex := maxSelectionIndex := index.
- 	(index between: 1 and: selections size) ifTrue:
- 		[selections at: index put: (aBoolean ifTrue: [1] ifFalse: [0])].
- 	1 to: minSelectionIndex - 1 do:
- 		[:i| selections at: i put: 0].
- 	maxSelectionIndex + 1 to: selections size do:
- 		[:i| selections at: i put: 0].
- 	self changed: #symbolList.
- 	self updateAddressSelection!

Item was removed:
- ----- Method: VMProfiler>>toggleClearPriorToProfile (in category 'buttons') -----
- toggleClearPriorToProfile
- 	clearPriorToProfile := clearPriorToProfile not.
- 	self changed: #clearPriorToProfile!

Item was removed:
- ----- Method: VMProfiler>>toggleForkProfile (in category 'buttons') -----
- toggleForkProfile
- 	forkProfile := forkProfile not.
- 	self changed: #forkProfile!

Item was removed:
- ----- Method: VMProfiler>>toggleGcPriorToProfile (in category 'buttons') -----
- toggleGcPriorToProfile
- 	gcPriorToProfile := gcPriorToProfile not.
- 	self changed: #gcPriorToProfile!

Item was removed:
- ----- Method: VMProfiler>>toggleListIndex: (in category 'accessing') -----
- toggleListIndex: index
- 	Transcript cr; nextPutAll: #toggleListIndex:; space; print: index; flush.
- 	selections at: index put: ((selections at: index ifAbsent: [^self]) bitXor: 1).
- 	self updateAddressSelection!

Item was removed:
- ----- Method: VMProfiler>>toggleShowLabels (in category 'buttons') -----
- toggleShowLabels
- 	self toggleShowing: #label!

Item was removed:
- ----- Method: VMProfiler>>toggleShowModules (in category 'buttons') -----
- toggleShowModules
- 	self toggleShowing: #module!

Item was removed:
- ----- Method: VMProfiler>>toggleShowPrivateFunctions (in category 'buttons') -----
- toggleShowPrivateFunctions
- 	self toggleShowing: #privateFunction!

Item was removed:
- ----- Method: VMProfiler>>toggleShowPublicFunctions (in category 'buttons') -----
- toggleShowPublicFunctions
- 	self toggleShowing: #publicFunction!

Item was changed:
+ ----- Method: VMProfiler>>toggleShowing: (in category 'as yet unclassified') -----
- ----- Method: VMProfiler>>toggleShowing: (in category 'buttons') -----
  toggleShowing: aSymbol
  	(symbolTypes includes: aSymbol)
  		ifTrue: [symbolTypes remove: aSymbol]
  		ifFalse: [symbolTypes add: aSymbol].
  	symbolTypes isEmpty ifTrue:
  		[symbolTypes add: #module.
  		 self changed: #showingModules.
  		 aSymbol == #module ifTrue:
  			[^self]].
  	self changed: #showingModules;
  		changed: #showingPublicFunctions;
  		changed: #showingPrivateFunctions;
  		changed: #showingLabels.
  	symbolList := symbolManager symbolsWithTypes: symbolTypes.
  	selections := ByteArray new: symbolList size.
  	self selectSymbolsInRange.
  	self changed: #symbolList;
  		changed: #positionedLabels!

Item was removed:
- ----- Method: VMProfiler>>totalText (in category 'accessing') -----
- totalText
- 	^(String streamContents:
- 		[:s|
- 		total > 0 ifTrue:
- 			[s	print: (rangeTotal * 10000 / total) rounded / 100.0;
- 				nextPutAll: '% of';
- 				cr].
- 		s print: total]) asText!

Item was removed:
- ----- Method: VMProfiler>>totalTextMorph:get: (in category 'opening') -----
- totalTextMorph: help get: getter
- 	| ptm |
- 	ptm := PluggableTextMorph
- 			on: self
- 			text: getter accept: nil
- 			readSelection: nil menu: nil.
- 	ptm askBeforeDiscardingEdits: false;
- 		setBalloonText: help;
- 		retractableOrNot;
- 		hideOrShowScrollBars;
- 		setProperty: #noScrollBarPlease toValue: true;
- 		setProperty: #noVScrollBarPlease toValue: true.
- 	^ptm!

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 removed:
- ----- Method: VMProfiler>>updateAddressDependents (in category 'accessing') -----
- updateAddressDependents
- 	self changed: #lowAddressText; changed: #highAddressText; changed: #symbolIndex.
- 	self dependents do:
- 		[:dep|
- 		 (dep class == PluggableTextMorph
- 		  and: [dep getTextSelector == #highAddressText]) ifTrue:
- 			[(dep instVarNamed: 'textMorph') editor setAlignment: #rightFlush]]!

Item was removed:
- ----- 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.
- 			   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 changed:
+ ----- Method: VMProfiler>>updateButtons (in category 'as yet unclassified') -----
- ----- Method: VMProfiler>>updateButtons (in category 'buttons') -----
  updateButtons
  	WorldState addDeferredUIMessage:
  		[self changed: #profileColor; changed: #clearColor; changed: #stopColor.
  		 self changed: #profiling; changed: #notProfiling; changed: #notProfilingAndData.
  		 self changed: #hasHistoryColor; changed: #hasFutureColor.
  		 self changed: #hasHistory; changed: #hasFuture]!

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

Item was changed:
  ----- Method: VMProfiler>>widthInDefaultFontOf: (in category 'reports') -----
  widthInDefaultFontOf: aString
+ 	^(self createParagraph 
- 	^(NewParagraph new
  		compose: aString asText
  		style: TextStyle default
  		from: 1
  		in: Display boundingBox;
  		adjustRightX)
  		extent x!

Item was removed:
- ----- Method: VMProfilerLinuxSymbolsManager class>>initialize (in category 'class initialization') -----
- initialize
- 	"Add to the shut down list to delete the temp directory and contents."
- 	Smalltalk addToShutDownList: self!

Item was changed:
  ----- Method: VMProfilerLinuxSymbolsManager class>>shutDown: (in category 'shut down') -----
  shutDown: quitting
  	(quitting
  	 and: [#('Mac OS' 'unix') includes: Smalltalk platformName]) ifTrue:
  		[| tempDir |
+ 		(tempDir := self tempDirectory) notNil ifTrue:
+ 			 [tempDir exists ifTrue:
+ 				[VMFileSystem deleteContentsOf: tempDir]]]!
- 		 (tempDir := self tempDirectory) exists ifTrue:
- 			[tempDir recursiveDelete]]!

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

Item was removed:
- ----- Method: VMProfilerLinuxSymbolsManager>>initialize (in category 'initialize-release') -----
- initialize
- 	"Initialize the receiver, parsing the symbols in the background for faster startup."
- 	self initializeMost.
- 	self parseAsynchronously!

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.
+ 	self fileSystem ensureExistenceOfDirectory:  tempDir. 
- 	(tempDir := self class tempDirectory) assureExistence.
  	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.  
- 					shortName := tempDir localNameFor: fileName.
  					counter := 0.
  					[shortNames includes: shortName] whileTrue:
  						[counter := counter + 1.
+ 						 shortName := (VMFileSystem nameOfFile: fileName  in: tempDir), counter printString].
- 						 shortName := (tempDir localNameFor: fileName), counter printString].
  					shortNames add: shortName.
  					longName := (modules at: i + 1)
  									ifNil: [fileName]
  									ifNotNil:
  										[:symlink|
  										symlink first = $/
  											ifTrue: [symlink]
+ 											ifFalse: [( VMFileSystem parentPathOfFile: fileName ), '/', symlink]].
- 											ifFalse: [(FileDirectory dirPathFor: fileName), '/', symlink]].
  					"some files are off limits (e.g. /dgagent/lib/preload.so)"
+ 					(VMFileSystem exists: longName) ifTrue:
- 					(FileDirectory default fileExists: 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| modulesByName includesKey: m name]!

Item was changed:
  ----- Method: VMProfilerLinuxSymbolsManager>>parseSymbolsFor: (in category 'parsing') -----
  parseSymbolsFor: module
  	| proc symtab symStream |
+ 	(VMFileSystem exists: tempDir fullName, '/', module shortName)  ifFalse:
- 	(tempDir fileExists: module shortName) ifFalse:
  		[proc := OSProcess thisOSProcess command:
  						'objdump -j .text -tT "', module name, '" | fgrep .text | sort >"', tempDir fullName, '/', module shortName, '"'].
  	symStream := (Array new: 1000) writeStream.
  	symStream nextPut: module.
  	proc ifNotNil:
  		[[proc isComplete] whileFalse: [(Delay forMilliseconds: 25) wait]].
+ 	symtab := [StandardFileStream readOnlyFileNamed: (tempDir fullName,'/',module shortName) ]
- 	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].
  	[| prev |
  	 prev := self parseSymbolsFrom: symtab to: symStream.
  	 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 removed:
- ----- Method: VMProfilerMacSymbolsManager class>>initialize (in category 'class initialization') -----
- initialize
- 	"Add to the shut down list to delete the temp directory and contents."
- 	Smalltalk addToShutDownList: self!

Item was changed:
  ----- Method: VMProfilerMacSymbolsManager class>>shutDown: (in category 'shut down') -----
  shutDown: quitting
  	(quitting
+ 	 and: [#('Mac OS' 'unix') includes: Smalltalk platformName]) ifTrue:
- 	 and: [Smalltalk platformName= 'Mac OS']) ifTrue:
  		[| tempDir |
+ 		(tempDir := self tempDirectory) notNil ifTrue:
+ 			 [tempDir exists ifTrue:
+ 				[VMFileSystem deleteContentsOf: tempDir]]]!
- 		 (tempDir := self tempDirectory) exists ifTrue:
- 			[tempDir recursiveDelete]]!

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

Item was changed:
  ----- 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 |
+ 	sizeFileName := module shortName, '.size'.
+ 	(VMFileSystem exists: tempDir fullName, '/', sizeFileName) ifFalse: 
- 	(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 fullName, '/', sizeFileName)) contentsOfEntireFile.
- 	text := (StandardFileStream readOnlyFileNamed: (tempDir fullNameFor: sizeFileName)) contentsOfEntireFile.
  	size := Integer readFrom: (text copyAfter: Character lf) readStream.
  	^size + initialShift!

Item was removed:
- ----- Method: VMProfilerMacSymbolsManager>>initialize (in category 'initialize-release') -----
- initialize
- 	"Initialize the receiver, parsing the symbols in the background for faster startup."
- 	self initializeMost.
- 	self parseAsynchronously!

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.
+ 	self fileSystem ensureExistenceOfDirectory:  tempDir. 
- 	(tempDir := self class tempDirectory) assureExistence.
  	modules := (1 to: modules size by: 4) collect:
  					[:i| | shortName counter |
+ 					shortName := VMFileSystem nameOfFile: (modules at: i) in: tempDir. 
- 					shortName := tempDir localNameFor: (modules at: i).
  					counter := 0.
  					[shortNames includes: shortName] whileTrue:
  						[counter := counter + 1.
+ 						shortName := (VMFileSystem nameOfFile: (modules at: i) in: tempDir), counter printString].  
- 						 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>>parseSymbolsFor: (in category 'parsing') -----
  parseSymbolsFor: module
  	| proc symtab symStream |
+ 	(VMFileSystem exists: tempDir fullName, '/', module shortName) ifFalse: 
+ 	"(tempDir fileExists: module shortName) ifFalse:"
- 	(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."
  		 proc := OSProcess thisOSProcess command:
  						'cd ', tempDir fullName,
  						';nm -n -arch ', self archName, " -f" ' "', module name, '" | grep -v " [aAU] " >"', module shortName, '"'].
  	symStream := (Array new: 1000) writeStream.
  	symStream nextPut: module.
+ 	proc ifNotNil:[(Delay forMilliseconds: 25) wait].
+ 		"[[proc isComplete] whileFalse: [(Delay forMilliseconds: 25) wait]]." "infinite loop"
+ 	symtab := [StandardFileStream readOnlyFileNamed: (tempDir fullName, '/', module shortName)]
- 	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:
  Object subclass: #VMProfilerSymbolsManager
  	instanceVariableNames: 'modules symbolsByModule modulesByName vmModule cogModule'
+ 	classVariableNames: 'VMFileSystem'
- 	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'CogTools-VMProfiler'!

Item was added:
+ ----- Method: VMProfilerSymbolsManager class>>initialize (in category 'as yet unclassified') -----
+ initialize
+ 	"Add to the shut down list to delete the temp directory and contents."
+ 	Smalltalk addToShutDownList: self!

Item was added:
+ ----- Method: VMProfilerSymbolsManager class>>using: (in category 'as yet unclassified') -----
+ using: aFileSystem
+ 
+ 	VMFileSystem := aFileSystem.
+ 	^ self new 
+ 	!

Item was changed:
  ----- Method: VMProfilerSymbolsManager>>addCogModuleSymbols: (in category 'Cog compiled code') -----
  addCogModuleSymbols: symbols
  	self initialized ifFalse:
+ 		[(Delay forMilliseconds: 1000) wait].
- 		[Cursor wait showWhile:
- 			[[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 added:
+ ----- Method: VMProfilerSymbolsManager>>fileSystem (in category 'accessing') -----
+ fileSystem
+ 
+ 	^VMFileSystem !

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

Item was added:
+ ----- Method: VMProfilerSymbolsManager>>initialize (in category 'as yet unclassified') -----
+ initialize
+ 	"Initialize the receiver, parsing the symbols in the background for faster startup."
+ 	self initializeMost.
+ 	self parseAsynchronously!



More information about the Vm-dev mailing list