Vm-dev August 2013

vm-dev@lists.squeakfoundation.org

26 participants
167 discussions

Re: Issue 11 in cog: From Pharo tracker: Snow Leopard has different lookup logic for libraries so FFI or ALien calls can fail.
by cog＠googlecode.com 08 Aug '13

08 Aug '13

Comment #1 on issue 11 by guillermopolito(a)gmail.com: From Pharo tracker: Snow Leopard has different lookup logic for libraries so FFI or ALien calls can fail. http://code.google.com/p/cog/issues/detail?id=11 Moved to fogbugz 11322 -- You received this message because this project is configured to send all issue notifications to this address. You may adjust your notification preferences at: https://code.google.com/hosting/settings

1 1

Re: Issue 6 in cog: Ship Cog with prebuilt OSProcess plugin
by cog＠googlecode.com 08 Aug '13

08 Aug '13

Comment #6 on issue 6 by guillermopolito(a)gmail.com: Ship Cog with prebuilt OSProcess plugin http://code.google.com/p/cog/issues/detail?id=6 Moved to fogbugz 11321 -- You received this message because this project is configured to send all issue notifications to this address. You may adjust your notification preferences at: https://code.google.com/hosting/settings

1 1

Re: Issue 5 in cog: [ENH]Proposal, extend the #getSystemAttribute: primitive
by cog＠googlecode.com 08 Aug '13

08 Aug '13

Comment #1 on issue 5 by guillermopolito(a)gmail.com: [ENH]Proposal, extend the #getSystemAttribute: primitive http://code.google.com/p/cog/issues/detail?id=5 Moved to fogbugz number 11319 -- You received this message because this project is configured to send all issue notifications to this address. You may adjust your notification preferences at: https://code.google.com/hosting/settings

1 1

Re: Issue 4 in cog: Ensure that command-line works consistently for all platforms
by cog＠googlecode.com 08 Aug '13

08 Aug '13

Comment #1 on issue 4 by guillermopolito(a)gmail.com: Ensure that command-line works consistently for all platforms http://code.google.com/p/cog/issues/detail?id=4 Moved to fogbugz. Number 11318 -- You received this message because this project is configured to send all issue notifications to this address. You may adjust your notification preferences at: https://code.google.com/hosting/settings

1 1

Re: Issue 2 in cog: Big cursor primivitve fail
by cog＠googlecode.com 08 Aug '13

08 Aug '13

Comment #1 on issue 2 by guillermopolito(a)gmail.com: Big cursor primivitve fail http://code.google.com/p/cog/issues/detail?id=2 Moved to fogbugz number 11320 -- You received this message because this project is configured to send all issue notifications to this address. You may adjust your notification preferences at: https://code.google.com/hosting/settings

1 1

Re: Issue 67 in cog: CMake Mac Configs Are Inconsistent
by cog＠googlecode.com 08 Aug '13

08 Aug '13

Comment #3 on issue 67 by guillermopolito(a)gmail.com: CMake Mac Configs Are Inconsistent http://code.google.com/p/cog/issues/detail?id=67 Mirrored in fogbugz https://pharo.fogbugz.com/default.asp?11351#82795 -- You received this message because this project is configured to send all issue notifications to this address. You may adjust your notification preferences at: https://code.google.com/hosting/settings

1 0

Re: [smalltalk-research] Re: Reference to paper about the VM simulator?
by Guillermo Polito 06 Aug '13

06 Aug '13

Nice, thanks Stefan! On Tue, Aug 6, 2013 at 1:43 PM, Stefan Marr <stmarr(a)gmail.com> wrote: > Anther slightly related paper by Eliot: > http://www.cs.iastate.edu/~design/vmil/2011/papers/p03-miranda.pdf > > > On Tuesday, August 6, 2013 12:03:27 PM UTC+2, Guillermo Polito wrote: >> >> Hi guys, >> >> I was wondering if there's some publication around the VM simulator. I >> was looking around but I did not find much. >> >> tx! >> Guille >> > -- > You received this message because you are subscribed to the Google Groups > "Smalltalk Research" group. > To unsubscribe from this group and stop receiving emails from it, send an > email to smalltalk-research+unsubscribe(a)googlegroups.com. > For more options, visit https://groups.google.com/groups/opt_out. > > >

2 1

Reference to paper about the VM simulator?
by Guillermo Polito 06 Aug '13

06 Aug '13

Hi guys, I was wondering if there's some publication around the VM simulator. I was looking around but I did not find much. tx! Guille

2 1

VM Maker: CogTools-eem.67.mcz
by commits＠source.squeak.org 02 Aug '13

02 Aug '13

Eliot Miranda uploaded a new version of CogTools to project VM Maker: http://source.squeak.org/VMMaker/CogTools-eem.67.mcz ==================== Summary ==================== Name: CogTools-eem.67 Author: eem Time: 2 August 2013, 2:33:50.527 pm UUID: 9629c2f2-8e6a-4a9a-be68-833436488a2c Ancestors: Qwaq-VMProfiling-eem.66 Get the package name right... =============== Diff against Qwaq-VMProfiling-eem.66 ===============

1 0

VM Maker: Qwaq-VMProfiling-eem.66.mcz
by commits＠source.squeak.org 02 Aug '13

02 Aug '13

Eliot Miranda uploaded a new version of CogTools to project VM Maker: http://source.squeak.org/VMMaker/Qwaq-VMProfiling-eem.66.mcz ==================== Summary ==================== Name: Qwaq-VMProfiling-eem.66 Author: eem Time: 2 August 2013, 2:32:41.232 pm UUID: 6c875f9a-9f18-4476-b8e1-6ddd64b4bfb5 Ancestors: Qwaq-VMProfiling-eem.65 Release the Qwaq VMProfiler as VMProfiler. This version derives from Qwaq-VMProfiling-eem.65. Thanks to all at 3D ICC, especially Ron Teitlebaum, for permission to release this. In memory of Andreas Raab, who gave me the opportunity to build Cog, and who was my friend and colleague. I miss you, Andreas, very much. ==================== Snapshot ==================== SystemOrganization addCategory: #'CogTools-VMProfiler'! Model subclass: #VMProfiler instanceVariableNames: 'sampleBuffer lowResolution highResSamples lowResSamples symbolsMode symbolTypes symbolManager symbolList selections minSelectionIndex maxSelectionIndex total rangeTotal highAddress lowAddress history historyIndex expressionTextMorph previousPattern graph aboutToProfile startTime elapsedTime startStats elapsedStats clearPriorToProfile gcPriorToProfile forkProfile cogCodeConstituents' classVariableNames: 'CannedBenchmarkStrings' poolDictionaries: '' category: 'CogTools-VMProfiler'! !VMProfiler commentStamp: 'eem 7/9/2013 14:08' prior: 0! This tool is a pc-sampling profiler for the VM. It presents the profile data graphically. Copyright© 2011-2013, 3D ICC Immersive Collaboration. All rights reserved. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License.! ----- Method: VMProfiler class>>LICENSE (in category 'LICENSE') ----- LICENSE ^'Project Squeak Copyright (c) 2005-2013, 3D Immersive Collaboration Consulting, LLC., All Rights Reserved Redistributions in source code form must reproduce the above copyright and this condition. Licensed under MIT License (MIT) Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.'! ----- Method: VMProfiler class>>canBenchmark: (in category 'class initialization') ----- canBenchmark: aByteString CannedBenchmarkStrings addLast: aByteString! ----- Method: VMProfiler class>>default (in category 'instance creation') ----- default ^self openInstance! ----- 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.'! ----- Method: VMProfiler class>>open (in category 'instance creation') ----- open ^self new openInWindow! ----- 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! ----- Method: VMProfiler class>>report: (in category 'spying') ----- report: aStream "Compatibility with MessageTally and QSystemProfiler instance side spyOn: & report:" ^self openInstance report: aStream! ----- 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: 1. youngSpaceEnd := gcStatsArray at: 2. memoryEnd := gcStatsArray at: 3. 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. 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) rounded); nextPutAll: '% elapsed time)'. fullGCs = 0 ifFalse: [str nextPutAll: ', avg '; print: (fullGCTime / fullGCs roundTo: 0.1); nextPutAll: 'ms']. str cr. str nextPutAll: ' incr '; print: incrGCs; nextPutAll: ' totalling '; nextPutAll: incrGCTime asStringWithCommas; nextPutAll: 'ms ('; print: ((incrGCTime / elapsedMilliseconds * 100) roundTo: 0.1); nextPutAll: '% elapsed time)'. incrGCs = 0 ifFalse: [str nextPutAll:', avg '; print: (incrGCTime / incrGCs roundTo: 0.01); 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) rounded); nextPutAll: '% elapsed time)'. numCompactions = 0 ifFalse: [str nextPutAll: ', avg '; print: (compactionMsecs / numCompactions roundTo: 0.1); 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 | value := gcStatsArray at: index. str nextPutAll: eventName; tab; print: value; nextPutAll: ' ('; print: (value * 1000 / elapsedMilliseconds) rounded; nextPutAll: ' per second)'; cr]]! ----- Method: VMProfiler class>>spyOn: (in category 'spying') ----- spyOn: aBlock "Compatibility with MessageTally and QSystemProfiler instance side spyOn: & report:" ^Cursor execute showWhile: [self openInstance spyOn: aBlock]! ----- Method: VMProfiler class>>unload (in category 'class initialization') ----- unload (TheWorldMenu respondsTo: #unregisterOpenCommandWithReceiver:) ifTrue: [TheWorldMenu unregisterOpenCommandWithReceiver: self]. TheWorldMenu unregisterOpenCommand: 'VM Profiler'! ----- 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]. ! ----- 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! ----- Method: VMProfiler>>backwardsButton (in category 'opening') ----- backwardsButton ^ImageMorph new image: ((ScriptingSystem formAtKey: #playMPEG) flipBy: #horizontal centerAt: 0@0)! ----- 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! ----- 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| (checkBoxButton perform: get) 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! ----- Method: VMProfiler>>clearButton (in category 'buttons') ----- clearButton "just weird..." ^'clear'! ----- Method: VMProfiler>>clearColor (in category 'buttons') ----- clearColor ^Color lightBlue! ----- Method: VMProfiler>>clearHistory (in category 'initialization') ----- clearHistory history := OrderedCollection new. historyIndex := 0! ----- Method: VMProfiler>>clearPriorToProfile (in category 'buttons') ----- clearPriorToProfile ^clearPriorToProfile! ----- Method: VMProfiler>>clearProfile (in category 'profiling') ----- clearProfile self stopVMProfile. self clearVMProfile. self stopVMProfile. highResSamples atAllPut: 0. lowResSamples atAllPut: 0. total := 0. elapsedTime := 0. elapsedStats := nil. self clearHistory. self updateButtons! ----- Method: VMProfiler>>clearVMProfile (in category 'primitives') ----- clearVMProfile "Clear the VM profile sample buffer." <primitive: 250> ^self primitiveFailed! ----- Method: VMProfiler>>computeCogCodeModule (in category 'Cog compiled code') ----- computeCogCodeModule cogCodeConstituents ifNil: [^self]. symbolManager computeCogCodeModule: cogCodeConstituents. self changed: #symbolList "Compute average cog method size: (| cogCodeConstituents i1 i2 | cogCodeConstituents := VMProfiler basicNew primitiveCollectCogCodeConstituents. i1 := cogCodeConstituents indexOf: 'methodZoneBase'. i2 := cogCodeConstituents indexOf: 'CCFree'. (cogCodeConstituents at: i2 + 1) - (cogCodeConstituents at: i1 + 1) / (i2 - i1 / 2.0))"! ----- Method: VMProfiler>>computeHistograms: (in category 'profiling') ----- computeHistograms: numSamples sampleBuffer isNil ifTrue: [sampleBuffer := Bitmap new: self profileSize]. self getVMProfileSamplesInto: sampleBuffer. Cursor wait showWhile: [1 to: numSamples do: [:i| | pc | pc := sampleBuffer at: i. highResSamples noCheckAt: pc put: (highResSamples noCheckAt: pc) + 1. lowResSamples at: pc // lowResolution + 1 put: (lowResSamples at: pc // lowResolution + 1) + 1]]. total := total + numSamples! ----- Method: VMProfiler>>computeStats: (in category 'profiling') ----- computeStats: stopStats elapsedStats ifNil: [elapsedStats := Array new: stopStats size withAll: 0]. startStats ifNotNil: [(#(1 2 3 7 8 9 10 11 22 46 47 56 57 58 59 60 61 62 63) select: [:i| i <= elapsedStats size]) do: [:i| (stopStats at: i) isNumber ifTrue: [elapsedStats at: i put: (stopStats at: i) - (startStats at: i)]]]! ----- Method: VMProfiler>>drawButton (in category 'buttons') ----- drawButton "just weird..." ^'plot'! ----- 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! ----- 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! ----- Method: VMProfiler>>forkProfile (in category 'buttons') ----- forkProfile ^forkProfile! ----- Method: VMProfiler>>forwardsButton (in category 'opening') ----- forwardsButton ^ImageMorph new image: (ScriptingSystem formAtKey: #playMPEG)! ----- Method: VMProfiler>>gcPriorToProfile (in category 'buttons') ----- gcPriorToProfile ^gcPriorToProfile! ----- Method: VMProfiler>>getVMProfileSamplesInto: (in category 'primitives') ----- getVMProfileSamplesInto: sampleBuffer "Stop profiling the virtual machine and if the argument is a Bitmap of the right size, copy the profile data into it. Otherwise fail." <primitive: 252> ^self primitiveFailed! ----- Method: VMProfiler>>graphMargin (in category 'accessing') ----- graphMargin ^graph margin! ----- Method: VMProfiler>>hasFuture (in category 'selecting') ----- hasFuture ^historyIndex < history size! ----- Method: VMProfiler>>hasFutureColor (in category 'buttons') ----- hasFutureColor ^self hasFuture ifTrue: [Color transparent] ifFalse: [Color darkGray]! ----- Method: VMProfiler>>hasHistory (in category 'selecting') ----- hasHistory ^historyIndex >= 1! ----- Method: VMProfiler>>hasHistoryColor (in category 'buttons') ----- hasHistoryColor ^self hasHistory ifTrue: [Color transparent] ifFalse: [Color darkGray]! ----- Method: VMProfiler>>highAddressText (in category 'accessing') ----- highAddressText ^((highAddress printStringRadix: 16) allButFirst: 3) asText! ----- Method: VMProfiler>>highAddressText: (in category 'accessing') ----- highAddressText: aText highAddress := ((Integer readFrom: aText asString asUppercase readStream base: 16) max: 0) min: 16rFFFFFFFF. self selectSymbolsInRange! ----- 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! ----- Method: VMProfiler>>initialExtent (in category 'opening') ----- initialExtent ^768@768 min: RealEstateAgent maximumUsableArea extent! ----- Method: VMProfiler>>initialize (in category 'initialization') ----- initialize "Use a SparseLargeArray so we can apparently have a sample per pc in the entire address space" highResSamples := SparseLargeArray new: (2 raisedToInteger: 32) chunkSize: 32 * 1024 arrayClass: Array base: 0 defaultValue: 0. lowResolution := 16 * 1024. lowResSamples := Array new: (2 raisedToInteger: 32) / lowResolution withAll: 0. self initializeSymbols. self clearHistory. symbolsMode := #byAddress. symbolTypes := IdentitySet new. selections := ByteArray new. highAddress := lowAddress := minSelectionIndex := maxSelectionIndex := 0. self toggleShowing: #module. aboutToProfile := false. total := rangeTotal := startTime := elapsedTime := 0. gcPriorToProfile := clearPriorToProfile := true. forkProfile := false! ----- Method: VMProfiler>>initializeSymbols (in category 'initialization') ----- initializeSymbols Smalltalk platformName caseOf: { ['Mac OS'] -> [Cursor wait showWhile: [symbolManager := VMProfilerMacSymbolsManager new]]. ['unix'] -> [Cursor wait showWhile: [symbolManager := VMProfilerLinuxSymbolsManager new]] } otherwise: [self error: 'not yet supported on ', Smalltalk platformName]! ----- Method: VMProfiler>>interpReport: (in category 'reports') ----- interpReport: s | totals samplesInInterp | totals := Dictionary new. samplesInInterp := 0. Cursor execute showWhile: [| interp labels| interp := (symbolManager symbolsInModule: symbolManager vmModule) detect: [:sym| sym name endsWith: 'interpret']. labels := (symbolManager symbolsInModule: symbolManager vmModule) select: [:sym| sym type == #label and: [sym address between: interp address and: interp limit]]. symbolList := {interp}, labels. symbolList withIndexDo: [:sym :index| | samples | samples := 0. sym address to: (index < symbolList size ifTrue: [(symbolList at: index + 1) address] ifFalse: [interp limit]) - 1 do: [:a| samples := samples + (highResSamples at: a)]. samples > 0 ifTrue: [totals at: sym put: samples. samplesInInterp := samplesInInterp + samples]]]. self putReportPreambleOn: s. s print: samplesInInterp; nextPutAll: ' samples in the Interpreter'; tab; nextPut: $(; print: total; nextPutAll: ' samples in the entire program) '. self printPercentage: samplesInInterp total: total on: s. s nextPutAll: ' of total'; cr; cr. totals isEmpty ifFalse: [self printSymbolTotals: totals labelled: 'interpret' on: s sumTotal: samplesInInterp]. self class reportGCStats: elapsedStats upTime: elapsedTime on: s! ----- Method: VMProfiler>>interpreterReport: (in category 'reports') ----- interpreterReport: justWeird (String streamContents: [:s| self interpReport: s]) openInWorkspaceWithTitle: 'Interpreter Labels by Cost'! ----- 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! ----- Method: VMProfiler>>listEntryForIndex: (in category 'accessing') ----- listEntryForIndex: index ^(symbolList at: index ifAbsent: [^nil]) displayText! ----- Method: VMProfiler>>longestWidthIn: (in category 'reports') ----- longestWidthIn: aCollectionOfAssociations ^aCollectionOfAssociations inject: 0 into: [:len :assoc| len max: (self widthInDefaultFontOf: (assoc key isString ifTrue: [assoc key] ifFalse: [assoc key name]))]! ----- Method: VMProfiler>>lowAddressText (in category 'accessing') ----- lowAddressText ^((lowAddress printStringRadix: 16) allButFirst: 3) asText! ----- Method: VMProfiler>>lowAddressText: (in category 'accessing') ----- lowAddressText: aText lowAddress := ((Integer readFrom: aText asString asUppercase readStream base: 16) max: 0) min: 16rFFFFFFFF. self selectSymbolsInRange! ----- Method: VMProfiler>>notProfiling (in category 'profiling') ----- notProfiling ^self profiling not! ----- Method: VMProfiler>>notProfilingAndData (in category 'profiling') ----- notProfilingAndData ^sampleBuffer notNil and: [self notProfiling]! ----- 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]. 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@0 corner: 0.15@1); addMorph: (graph := VMProfilePlotMorph model: self) frame: (0.15@0 corner: 1.0(a)0.7); addMorph: labelsMorph frame: (0.15(a)0.7 corner: 1.0(a)0.85); "address boxes" addMorph: (self addressTextMorph:'Type the low address of the histogram here' get: #lowAddressText set: #lowAddressText:) frame: (0.16(a)0.86 corner: 0.27(a)0.91); addMorph: (self addressTextMorph:'Type the high address of the histogram here' get: #highAddressText set: #highAddressText:) frame: (0.88(a)0.86 corner: 0.99(a)0.91); addMorph: (self totalTextMorph: 'Shows the total number of samples' get: #totalText) frame: (0.88(a)0.92 corner: 0.99(a)0.98); "symbol list check-box filters" addMorph: (self checkMorph: 'show module symbols' get: #showingModules set: #toggleShowModules) frame: (0.16(a)0.915 corner: 0.175(a)0.93); addMorph: (buttons addLast: (StringMorph contents: 'modules')) frame: (0.19(a)0.915 corner: 0.27(a)0.93); addMorph: (self checkMorph: 'show extern symbols' get: #showingPublicFunctions set: #toggleShowPublicFunctions) frame: (0.16(a)0.935 corner: 0.175(a)0.95); addMorph: (buttons addLast: (StringMorph contents: 'externs')) frame: (0.19(a)0.935 corner: 0.27(a)0.95); addMorph: (self checkMorph: 'show static symbols' get: #showingPrivateFunctions set: #toggleShowPrivateFunctions) frame: (0.16(a)0.955 corner: 0.175(a)0.97); addMorph: (buttons addLast: (StringMorph contents: 'statics')) frame: (0.19(a)0.955 corner: 0.27(a)0.97); addMorph: (self checkMorph: 'show static symbols' get: #showingLabels set: #toggleShowLabels) frame: (0.16(a)0.975 corner: 0.175(a)0.99); addMorph: (buttons addLast: (StringMorph contents: 'labels')) frame: (0.19(a)0.975 corner: 0.27(a)0.99); "history buttons" addMorph: (self historyButtonMorph: #backwardsButton help: 'go back to previous selection' set: #regress enable: #hasHistory color: #hasHistoryColor) frame: (0.28(a)0.86 corner: 0.315(a)0.90); addMorph: (self historyButtonMorph: #forwardsButton help: 'go forward to next selection' set: #progress enable: #hasFuture color: #hasFutureColor) frame: (0.32(a)0.86 corner: 0.355(a)0.90); "profiling buttons" addMorph: (self buttonMorph: #drawButton help: 'plot the graph' set: #plotGraph enable: #notProfilingAndData color: #clearColor) frame: (0.37(a)0.86 corner: 0.45(a)0.91); addMorph: (self buttonMorph: #clearButton help: 'clear the histogram data' set: #clearProfile enable: #notProfiling color: #clearColor) frame: (0.46(a)0.86 corner: 0.54(a)0.91); addMorph: (self buttonMorph: #startButton help: 'start the profiler' set: #startProfiling enable: #notProfiling color: #profileColor) frame: (0.28(a)0.915 corner: 0.36(a)0.96); addMorph: (self buttonMorph: #stopButton help: 'stop the profiler' set: #stopProfiling enable: #profiling color: #stopColor) frame: (0.37(a)0.915 corner: 0.45(a)0.96); addMorph: (self buttonMorph: #profileExpressionButton help: 'compile and profile the expression to the right' set: #profileExpression enable: #notProfiling color: #profileColor) frame: (0.46(a)0.915 corner: 0.54(a)0.96); addMorph: expressionTextMorph frame: (0.55(a)0.86 corner: 0.87(a)0.98); addMorph: (self checkMorph: 'Run the full garbage collector prior to profiling' get: #gcPriorToProfile set: #toggleGcPriorToProfile) frame: (0.28(a)0.97 corner: 0.295(a)0.985); addMorph: (buttons addLast: (StringMorph contents: 'gc prior')) frame: (0.30(a)0.97 corner: 0.365(a)0.995); addMorph: (self checkMorph: 'Clear the profile prior to profiling' get: #clearPriorToProfile set: #toggleClearPriorToProfile) frame: (0.37(a)0.97 corner: 0.385(a)0.985); addMorph: (buttons addLast: (StringMorph contents: 'clear prior')) frame: (0.39(a)0.97 corner: 0.455(a)0.995); addMorph: (self checkMorph: 'Run the profiled expression in its own process' get: #forkProfile set: #toggleForkProfile) frame: (0.46(a)0.97 corner: 0.475(a)0.985); addMorph: (buttons addLast: (StringMorph contents: 'fork profile')) frame: (0.48(a)0.97 corner: 0.545(a)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. "Cope with Squeak 4.1 SystemWindow background color changes" window addMorph: (AlignmentMorph new color: Color white; yourself) frame: (0@0 corner: 1@1). self updateButtons. "weird!!" buttons do: [:buttonMorph| buttonMorph color: Color black]. "otherwise labels don't show :(" window openInWorld. self toggleShowing: #module. ^window! ----- Method: VMProfiler>>plot:from:to:addressRange:to: (in category 'graph') ----- plot: data from: start to: end addressRange: startAddress to: limitAddress | histSeries intSeries resolution prevX prevY prevI sum integral bin binsPerPoint fillInIntegral | graph clear. histSeries := graph series: #histogram. intSeries := graph alternateSeries: #integral. fillInIntegral := Preferences vmProfilerFillInIntegral. intSeries color: Color magenta; type: #stepped; drawArea: fillInIntegral. resolution := graph drawBounds width. binsPerPoint := end - start + 1 >= resolution ifTrue: [(end - start + 1 / resolution) ceiling] ifFalse: [1]. prevY := prevI := integral := 0. prevX := bin := start. [bin <= end] whileTrue: [binsPerPoint > 1 ifTrue: [sum := 0. bin to: (bin + binsPerPoint - 1 min: end) do: [:i| sum := sum + (data at: i)]] ifFalse: [sum := data at: bin]. sum = 0 ifTrue: [(bin = start or: [prevY ~= 0]) ifTrue: [histSeries addPoint: bin @ sum. intSeries addPoint: bin @ integral]] ifFalse: [prevY = 0 ifTrue: [histSeries addPoint: prevX @ prevY. intSeries addPoint: prevX @ prevI]. histSeries addPoint: bin @ sum. intSeries addPoint: bin @ (integral := integral + sum)]. prevX := bin. prevY := sum. prevI := integral. bin := bin + binsPerPoint]. histSeries addPoint: end @ 0. intSeries addPoint: end @ integral. (fillInIntegral and: [integral ~= 0]) ifTrue: [intSeries addPoint: end @ 0]. rangeTotal := integral. graph xAxisFormatter: [:n| | address | address := [startAddress + ((n asFloat - start) * (limitAddress - startAddress) / (end - start))] on: ZeroDivide do: [:ex| 0]. (address rounded asInteger printStringRadix: 16) allButFirst: 3]. graph yAxisFormatter: [:n| (n rounded = n ifTrue: [n] ifFalse: [n >= 100 ifTrue: [n rounded] ifFalse: [(n * 10) rounded / 10]]) printString]. graph limitMinX: start limitMaxX: end. self changed: #positionedLabels; changed: #totalText! ----- Method: VMProfiler>>plotGraph (in category 'graph') ----- plotGraph lowResSamples first ifNil: [^self]. (lowAddress = 0 and: [highAddress = 0]) ifTrue: [highAddress := (1 << 32) - 1. self updateAddressDependents]. highAddress - lowAddress / lowResolution > 100 ifTrue: [self plot: lowResSamples from: lowAddress // lowResolution + 1 to: (highAddress + lowResolution - 1 // lowResolution + 1 min: lowResSamples size) addressRange: lowAddress to: highAddress] ifFalse: [self plot: highResSamples from: lowAddress to: highAddress addressRange: lowAddress to: highAddress]. graph fullDrawOn: Display getCanvas! ----- Method: VMProfiler>>positionedLabels (in category 'accessing') ----- positionedLabels "Compute the set of labels to be displayed for the given address range. Try and display no more than 25 labels. The result is a dictionary of fractional position in the range to string." | counts types symbolsInRange positionedLabels index count range | minSelectionIndex isZero ifTrue: [^Dictionary new]. "count how many labels of each type there are in the range." counts := Dictionary new. (types := #(module objectFile publicFunction privateFunction label)) do: [:type| counts at: type put: 0]. types := types select: [:type| symbolTypes includes: type]. symbolsInRange := symbolManager symbolsSelect: [:sym| sym address <= highAddress and: [sym limit >= lowAddress and: [(symbolTypes includes: sym type)]]]. symbolsInRange do: [:s| counts at: s type put: (counts at: s type) + 1]. "Find out what types give us at least one label but no more than 25 unless necessary to have at least one." index := 1. count := counts at: (types at: index). [index <= types size and: [count + (counts at: (types at: index)) < 25]] whileTrue: [count := count + (counts at: (types at: index)). index := index + 1]. "add labels to positionedLabels indexed by their fractional position in the range, filtering by type." types := types copyFrom: 1 to: (index min: types size). positionedLabels := Dictionary new: count. range := (highAddress - lowAddress) asFloat. symbolsInRange do: [:s | (types includes: s type) ifTrue: [positionedLabels at: ([s address - lowAddress / range] on: ZeroDivide do: [:ex| 0]) put: s displayText]]. ^positionedLabels! ----- Method: VMProfiler>>primitiveCollectCogCodeConstituents (in category 'primitives') ----- primitiveCollectCogCodeConstituents "Answer the contents of the code zone as an array of pair-wise element, address in ascending address order. Answer a string for a runtime routine or abstract label (beginning, end, etc), a CompiledMethod for a cog machine-code method, or a selector (presumably a Symbol) for a cog machine-code open or closed PIC. Fail if this isn't a Cog VM or if out of memory. If this isn't a Cog VM answer nil." <primitive: 253 error: ec> ^ec ifNotNil: [self primitiveFailed] "self basicNew primitiveCollectCogCodeConstituents"! ----- Method: VMProfiler>>primitiveControlVMProfile:size: (in category 'primitives') ----- primitiveControlVMProfile: startStopBar size: bufferSizeOrNil "Control the VM statistical profile pc sampling system. The first argument must be a boolean which causes the system to start or stop. The second argument can be nil or is the number of samples to make space for. Answer the current number of samples in the buffer." <primitive: 251> ^self primitiveFailed! ----- Method: VMProfiler>>printPercentage:total:on: (in category 'menus') ----- printPercentage: value total: total on: aStream "Print percentage as NN.FF% (or 100.0%) on aStream" | rounded percentage | percentage := (rounded := (value * 10000 / total) rounded) / 100.0. percentage < 10 ifTrue: [aStream space; space]. aStream print: percentage. (rounded \\ 10 = 0 and: [rounded ~= 10000]) ifTrue: [aStream nextPut: $0]. aStream nextPut: $%! ----- Method: VMProfiler>>printSymbolTotals:labelled:on:sumTotal: (in category 'reports') ----- printSymbolTotals: totals labelled: label on: aStream sumTotal: sumTotal "Print sorted totals for all symbols with a total greater than 0.01% of the grand total." | substantial insubstantial cut cumulative heading percentageWidth compositionWidth tabWidth labelWidthCut labelledInFull | cut := total / 10000.0. substantial := totals associations select: [:assoc| assoc value > cut]. labelWidthCut := total / 1000.0. labelledInFull := totals associations select: [:assoc| assoc value > labelWidthCut]. insubstantial := totals associations inject: 0 into: [:sum :assoc| (assoc value <= cut ifTrue: [assoc value] ifFalse: [0]) + sum]. substantial := substantial asSortedCollection: [:a1 :a2| a1 value > a2 value or: [a1 value = a2 value and: [a1 name < a2 name]]]. insubstantial > 0 ifTrue: [substantial := substantial asArray, {'...others...'->insubstantial}]. cumulative := 0. heading := '% of ', label, ' (% of total)'. tabWidth := self widthInDefaultFontOf: (String with: Character tab). percentageWidth := self widthInDefaultFontOf: '99.99% (99.99%) '. compositionWidth := (self longestWidthIn: labelledInFull) + tabWidth max: (self widthInDefaultFontOf: heading) + tabWidth - percentageWidth. self put: heading paddedTo: compositionWidth + percentageWidth tabWidth: tabWidth on: aStream. aStream nextPutAll: '(samples) (cumulative)'; cr. substantial do: [:assoc| self printPercentage: assoc value total: sumTotal on: aStream. aStream space; space; space; space; nextPut: $(. self printPercentage: assoc value total: total on: aStream. aStream nextPut: $); tab. self put: (assoc key isString ifTrue: [assoc key] ifFalse: [assoc key name]) paddedTo: compositionWidth tabWidth: tabWidth on: aStream. aStream nextPut: $(; print: assoc value; nextPut: $); tab: (assoc value < 100 ifTrue: [2] ifFalse: [1]); nextPut: $(. cumulative := cumulative + assoc value. self printPercentage: cumulative total: sumTotal on: aStream. aStream nextPut: $); cr]. aStream cr; cr! ----- Method: VMProfiler>>profileColor (in category 'buttons') ----- profileColor ^self profiling ifTrue: [Color darkGray] ifFalse: [Color lightGreen]! ----- 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]! ----- Method: VMProfiler>>profileExpressionButton (in category 'buttons') ----- profileExpressionButton "Just weird!!" ^'profile:'! ----- 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! ----- Method: VMProfiler>>profiling (in category 'profiling') ----- profiling ^aboutToProfile or: [self statusOfVMProfile]! ----- 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! ----- Method: VMProfiler>>put:paddedTo:tabWidth:on: (in category 'reports') ----- put: aString paddedTo: compositionWidth tabWidth: tabWidth on: aStream | fittedString size width | fittedString := aString. size := fittedString size. [(width := self widthInDefaultFontOf: fittedString) > compositionWidth] whileTrue: [size := size - 2. fittedString := aString contractTo: size]. aStream nextPutAll: fittedString; tab: compositionWidth - width + (width \\ tabWidth) // tabWidth! ----- Method: VMProfiler>>putReportPreambleOn: (in category 'reports') ----- putReportPreambleOn: s | expr | s nextPutAll: (SmalltalkImage current getSystemAttribute: 0); space; nextPutAll: Utilities changeStampPerSe; cr. (startStats size >= 44 and: [(startStats at: 44) isNumber]) ifTrue: [s nextPutAll: 'eden size: '; nextPutAll: (startStats at: 44) asStringWithCommas. s nextPutAll: ' stack pages: '; print: (startStats at: 42). (startStats size >= 46 and: [(startStats at: 46) isNumber and: [(startStats at: 46) > 0]]) ifTrue: [s nextPutAll: ' code size: '; nextPutAll: (startStats at: 46) asStringWithCommas]. s cr]. s cr. (expr := self trimmedExpressionText) notEmpty ifTrue: [s nextPutAll: expr; cr; cr]. (gcPriorToProfile or: [clearPriorToProfile or: [forkProfile]]) ifTrue: [gcPriorToProfile ifTrue: [s nextPutAll: 'gc prior. ']. clearPriorToProfile ifTrue: [s nextPutAll: 'clear prior. ']. forkProfile ifTrue: [s nextPutAll: 'run in separate process.']. s cr]. elapsedTime > 0 ifTrue: [s print: elapsedTime / 1000.0; nextPutAll: ' seconds; sampling frequency '; print: (total * 1000 / elapsedTime) rounded; nextPutAll: ' hz'; cr]! ----- 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! ----- Method: VMProfiler>>report: (in category 'reports') ----- report: s | vmTotals cogTotals nonVMTotals samplesInVM samplesInCog samplesInNonVMModules samplesInNonVM | vmTotals := Dictionary new. cogTotals := Dictionary new. nonVMTotals := Dictionary new. samplesInVM := samplesInCog := samplesInNonVMModules := 0. Cursor execute showWhile: [(symbolManager symbolsInModule: symbolManager vmModule) do: [:sym| | samples | (#(publicFunction privateFunction) includes: sym type) ifTrue: [samples := 0. sym address to: sym limit - 1 do: [:a| samples := samples + (highResSamples at: a)]. samples > 0 ifTrue: [vmTotals at: sym put: samples. samplesInVM := samplesInVM + samples]]]. (symbolManager symbolsInModule: symbolManager cogModule) do: [:sym| | samples | (#(publicFunction privateFunction) includes: sym type) ifTrue: [samples := 0. sym address to: sym limit - 1 do: [:a| samples := samples + (highResSamples at: a)]. samples > 0 ifTrue: [cogTotals at: sym put: samples. samplesInCog := samplesInCog + samples]]]. ((symbolManager modules copyWithout: symbolManager vmModule) copyWithout: symbolManager cogModule) do: [:module| (symbolManager symbolsInModule: module) do: [:sym| | samples | ((#(publicFunction privateFunction) includes: sym type) and: [(sym address // lowResolution to: sym limit // lowResolution) anySatisfy: [:pc| (lowResSamples at: pc + 1) > 0]]) ifTrue: [samples := 0. sym address to: sym limit - 1 do: [:a| samples := samples + (highResSamples at: a)]. samples > 0 ifTrue: [nonVMTotals at: sym put: samples. samplesInNonVMModules := samplesInNonVMModules + samples]]]]]. samplesInNonVM := total - samplesInVM - samplesInCog. nonVMTotals at: 'Samples Not In Any Function' put: samplesInNonVM - samplesInNonVMModules. 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! ----- Method: VMProfiler>>selectBenchmark: (in category 'menus') ----- selectBenchmark: expressionString expressionTextMorph setText: expressionString asText! ----- 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! ----- Method: VMProfiler>>selectSymbolsInRange (in category 'selecting') ----- selectSymbolsInRange minSelectionIndex := maxSelectionIndex := 0. 1 to: (selections size min: symbolList size) do: [:i| | symbol | symbol := symbolList at: i. selections at: i put: ((symbol limit notNil "guard against lazy initialization" and: [symbol limit > lowAddress and: [symbol address <= highAddress]]) ifTrue: [minSelectionIndex = 0 ifTrue: [minSelectionIndex := i]. maxSelectionIndex := i. 1] ifFalse: [0])]. self changed: #allSelections. self changed: #symbolIndex! ----- Method: VMProfiler>>selectionRange (in category 'profiling') ----- selectionRange ^expressionTextMorph ifNotNil: [1 to: expressionTextMorph text size] ifNil: [0 to: 0]! ----- Method: VMProfiler>>showingLabels (in category 'buttons') ----- showingLabels ^symbolTypes includes: #label! ----- Method: VMProfiler>>showingModules (in category 'buttons') ----- showingModules ^symbolTypes includes: #module! ----- Method: VMProfiler>>showingPrivateFunctions (in category 'buttons') ----- showingPrivateFunctions ^symbolTypes includes: #privateFunction! ----- Method: VMProfiler>>showingPublicFunctions (in category 'buttons') ----- showingPublicFunctions ^symbolTypes includes: #publicFunction! ----- Method: VMProfiler>>spyOn: (in category 'spying') ----- spyOn: aBlock | blockToProfile r | blockToProfile := forkProfile ifTrue: [| sem fr | sem := Semaphore new. [[fr := aBlock value. sem signal] fork. sem wait. fr]] ifFalse: [aBlock]. self startProfiling. r := blockToProfile ensure: [self stopProfiling]. WorldState addDeferredUIMessage: [self plotGraph]. ^r! ----- Method: VMProfiler>>startButton (in category 'buttons') ----- startButton "just weird..." ^'start'! ----- Method: VMProfiler>>startProfiling (in category 'profiling') ----- startProfiling "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 := Smalltalk getVMParameters. startTime := Time millisecondClockValue. self startVMProfile. aboutToProfile := false! ----- Method: VMProfiler>>startVMProfile (in category 'primitives') ----- startVMProfile "Start profiling the virtual machine." self primitiveControlVMProfile: true size: self profileSize! ----- Method: VMProfiler>>statusOfVMProfile (in category 'primitives') ----- statusOfVMProfile <primitive: 252> ^self primitiveFailed! ----- Method: VMProfiler>>stopButton (in category 'buttons') ----- stopButton "just weird..." ^'stop'! ----- Method: VMProfiler>>stopColor (in category 'buttons') ----- stopColor ^self profiling ifTrue: [Color red] ifFalse: [Color darkGray]! ----- Method: VMProfiler>>stopProfiling (in category 'profiling') ----- stopProfiling | numSamples now vmParameters | numSamples := self stopVMProfile. now := Time millisecondClockValue. vmParameters := Smalltalk getVMParameters. cogCodeConstituents := self primitiveCollectCogCodeConstituents. elapsedTime := now - startTime + elapsedTime. self computeStats: vmParameters. self computeHistograms: numSamples. self computeCogCodeModule. self clearHistory. self updateButtons! ----- Method: VMProfiler>>stopVMProfile (in category 'primitives') ----- stopVMProfile "Stop profiling the virtual machine." ^self primitiveControlVMProfile: false size: self profileSize! ----- Method: VMProfiler>>symbolIndex (in category 'accessing') ----- symbolIndex "Answer the first index in the last contiguous range of selections." | index | minSelectionIndex = 0 ifTrue: [^0]. index := maxSelectionIndex. [index > 1 and: [(selections at: index - 1) ~= 0]] whileTrue: [index := index - 1]. ^index! ----- Method: VMProfiler>>symbolList (in category 'accessing') ----- symbolList ^symbolList! ----- 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! ----- Method: VMProfiler>>symbolSelectionAt: (in category 'accessing') ----- symbolSelectionAt: index ^(selections at: index ifAbsent: [0]) ~= 0! ----- 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! ----- Method: VMProfiler>>toggleClearPriorToProfile (in category 'buttons') ----- toggleClearPriorToProfile clearPriorToProfile := clearPriorToProfile not. self changed: #clearPriorToProfile! ----- Method: VMProfiler>>toggleForkProfile (in category 'buttons') ----- toggleForkProfile forkProfile := forkProfile not. self changed: #forkProfile! ----- Method: VMProfiler>>toggleGcPriorToProfile (in category 'buttons') ----- toggleGcPriorToProfile gcPriorToProfile := gcPriorToProfile not. self changed: #gcPriorToProfile! ----- 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! ----- Method: VMProfiler>>toggleShowLabels (in category 'buttons') ----- toggleShowLabels self toggleShowing: #label! ----- Method: VMProfiler>>toggleShowModules (in category 'buttons') ----- toggleShowModules self toggleShowing: #module! ----- Method: VMProfiler>>toggleShowPrivateFunctions (in category 'buttons') ----- toggleShowPrivateFunctions self toggleShowing: #privateFunction! ----- Method: VMProfiler>>toggleShowPublicFunctions (in category 'buttons') ----- toggleShowPublicFunctions self toggleShowing: #publicFunction! ----- 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! ----- 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! ----- 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! ----- Method: VMProfiler>>trimmedExpressionText (in category 'menus') ----- trimmedExpressionText | expression | ^((expression := expressionTextMorph text asString) notEmpty and: [expression first = $[ and: [expression last = $] ]]) ifTrue: [expression copyFrom: 2 to: expression size - 1] ifFalse: [expression]! ----- 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]]! ----- 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 := highAddress := (1 << 32) - 1. minSelectionIndex := maxSelectionIndex := 0] ifNotNil: [minSelectionIndex := min. maxSelectionIndex := max. minSelectionIndex + 1 to: maxSelectionIndex - 1 do: [:i| selections at: i put: 1]. lowAddress := (symbolList at: minSelectionIndex) address. highAddress := (symbolList at: maxSelectionIndex) limit]. self updateAddressDependents! ----- 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]! ----- Method: VMProfiler>>vmReport: (in category 'reports') ----- vmReport: justWeird (String streamContents: [:s| self report: s]) openInWorkspaceWithTitle: 'VM Functions by Cost'! ----- Method: VMProfiler>>widthInDefaultFontOf: (in category 'reports') ----- widthInDefaultFontOf: aString ^(NewParagraph new compose: aString asText style: TextStyle default from: 1 in: Display boundingBox; adjustRightX) extent x! Morph subclass: #VMProfileGraphLabelMorph instanceVariableNames: 'positionedLabels font getLabelsSelector model' classVariableNames: '' poolDictionaries: '' category: 'CogTools-VMProfiler'! ----- Method: VMProfileGraphLabelMorph class>>LICENSE (in category 'LICENSE') ----- LICENSE ^'Project Squeak Copyright (c) 2005-2013, 3D Immersive Collaboration Consulting, LLC., All Rights Reserved Redistributions in source code form must reproduce the above copyright and this condition. Licensed under MIT License (MIT) Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.'! ----- Method: VMProfileGraphLabelMorph class>>model:font:getLabels: (in category 'instance creation') ----- model: anObject font: aFont getLabels: aSelector ^self new model: anObject; font: aFont; getLabelsSelector: aSelector; yourself! ----- Method: VMProfileGraphLabelMorph>>changed (in category 'updating') ----- changed positionedLabels := model perform: getLabelsSelector. super changed! ----- Method: VMProfileGraphLabelMorph>>drawClippedOn: (in category 'drawing') ----- drawClippedOn: clippedCanvas "Display the labels at their relative positions sloping down at 45 degrees. Draw a label every font height pixels along to avoid a mess when there are lots of labels." | labelForm lfc rotatedLabelForm rlfc warp degSin degCos side rect pts minDelta lastX margin range rotationOffset xs | labelForm := Form extent: self height * 2 @ font height depth: 4. rotatedLabelForm := Form extent: self height asPoint depth: 4. lfc := labelForm getCanvas. rlfc := rotatedLabelForm getCanvas. warp := (WarpBlt current toForm: rotatedLabelForm) sourceForm: labelForm; colorMap: (labelForm colormapIfNeededFor: rotatedLabelForm); cellSize: 2 "smooothing"; "installs a new colormap if cellSize > 1" combinationRule: Form paint. degSin := 45 degreeSin. degCos := 45 degreeCos. "See Form>>rotateBy:magnify:smoothing:" side := labelForm extent r. rect := (0@0 extent: side@side) align: (side / 2) asPoint with: labelForm extent / 2. pts := rect innerCorners collect: [:pt | | p | p := pt - rect center. ((labelForm width / 2.0) + (p x asFloat*degCos) + (p y asFloat*degSin)) @ ((labelForm height / 2.0) - (p x asFloat*degSin) + (p y asFloat*degCos))]. minDelta := font height / 1.75. "1.6 a little greater than 2 sqrt" lastX := font height negated. margin := model graphMargin. range := self width - margin - margin. rotationOffset := (labelForm height / 2 * 2 sqrt) ceiling. (xs := positionedLabels keys asSortedCollection) withIndexDo: [:fractionalX :index| | x | x := (fractionalX * range) rounded. (lastX + minDelta <= x or: [index < xs size and: [lastX + minDelta + minDelta <= ((xs at: index + 1) * range)]]) ifTrue: [lfc fillColor: Color black; drawString: (positionedLabels at: fractionalX) at: 0@0 font: font color: Color white. rlfc fillColor: Color black. warp copyQuad: pts toRect: rotatedLabelForm boundingBox. clippedCanvas image: rotatedLabelForm at: self bounds origin + ((fractionalX * range max: lastX + minDelta) floor + margin - rotationOffset@0) sourceRect: rotatedLabelForm boundingBox rule: Form erase. true ifTrue: [| box | box := (self bounds origin + ((fractionalX * range) floor + margin@0)) extent: 1@6. Display fill: box rule: Form over fillColor: Color gray]. lastX := x]]! ----- Method: VMProfileGraphLabelMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas super drawOn: aCanvas. aCanvas clipBy: self bounds during: [:clippedCanvas| self drawClippedOn: clippedCanvas]! ----- Method: VMProfileGraphLabelMorph>>font (in category 'accessing') ----- font "Answer the value of font" ^ font! ----- Method: VMProfileGraphLabelMorph>>font: (in category 'accessing') ----- font: anObject "Set the value of font" font := anObject! ----- Method: VMProfileGraphLabelMorph>>getLabelsSelector (in category 'accessing') ----- getLabelsSelector "Answer the value of getLabelsSelector" ^ getLabelsSelector! ----- Method: VMProfileGraphLabelMorph>>getLabelsSelector: (in category 'accessing') ----- getLabelsSelector: anObject "Set the value of getLabelsSelector" getLabelsSelector := anObject! ----- Method: VMProfileGraphLabelMorph>>initialize (in category 'initialization') ----- initialize super initialize. positionedLabels := Dictionary new. font := TextStyle default defaultFont. getLabelsSelector := #positionedLabels! ----- Method: VMProfileGraphLabelMorph>>model (in category 'accessing') ----- model "Answer the value of model" ^ model! ----- Method: VMProfileGraphLabelMorph>>model: (in category 'accessing') ----- model: anObject "Set my model and make me me a dependent of the given object." model ifNotNil: [model removeDependent: self]. anObject ifNotNil: [anObject addDependent: self]. model := anObject! ----- Method: VMProfileGraphLabelMorph>>update: (in category 'updating') ----- update: aParameter aParameter == getLabelsSelector ifTrue: [self changed]! PluggableListMorph subclass: #PluggableListMorphOfManyAlt instanceVariableNames: 'dragOnOrOff getSelectionListSelector setSelectionListSelector currentRow' classVariableNames: '' poolDictionaries: '' category: 'CogTools-VMProfiler'! !PluggableListMorphOfManyAlt commentStamp: '<historical>' prior: 0! A variant of its superclass that allows multiple items to be selected simultaneously. There is still a distinguished element which is selected, but each other element in the list may be flagged on or off. This is a clone of PluggableListMorphOfMany that sends the changePrimarySelection: selector only when the mouse is first pushed and sends the changeListSelection: selector while the mouse is being dragged. This allows the model to choose to respond to a new selection by deselecting existing selections. This differs from PluggableListMorphOfMany which sends both selectors all the time.! ----- Method: PluggableListMorphOfManyAlt class>>on:list:primarySelection:changePrimarySelection:listSelection:changeListSelection:getListElement:menu: (in category 'instance creation') ----- on: anObject list: listSel primarySelection: getSelectionSel changePrimarySelection: setSelectionSel listSelection: getListSel changeListSelection: setListSel getListElement: listElemSel menu: getMenuSel ^ self new on: anObject list: listSel primarySelection: getSelectionSel changePrimarySelection: setSelectionSel listSelection: getListSel changeListSelection: setListSel getListElement: listElemSel menu: getMenuSel keystroke: #arrowKey:from: "default"! ----- Method: PluggableListMorphOfManyAlt class>>on:list:primarySelection:changePrimarySelection:listSelection:changeListSelection:menu: (in category 'instance creation') ----- on: anObject list: listSel primarySelection: getSelectionSel changePrimarySelection: setSelectionSel listSelection: getListSel changeListSelection: setListSel menu: getMenuSel ^ self new on: anObject list: listSel primarySelection: getSelectionSel changePrimarySelection: setSelectionSel listSelection: getListSel changeListSelection: setListSel getListElement: nil "default" menu: getMenuSel keystroke: #arrowKey:from: "default"! ----- Method: PluggableListMorphOfManyAlt class>>on:list:primarySelection:changePrimarySelection:listSelection:changeListSelection:menu:keystroke: (in category 'instance creation') ----- on: anObject list: listSel primarySelection: getSelectionSel changePrimarySelection: setSelectionSel listSelection: getListSel changeListSelection: setListSel menu: getMenuSel keystroke: keyActionSel ^ self new on: anObject list: listSel primarySelection: getSelectionSel changePrimarySelection: setSelectionSel listSelection: getListSel changeListSelection: setListSel getListElement: nil "default" menu: getMenuSel keystroke: keyActionSel! ----- Method: PluggableListMorphOfManyAlt>>getList (in category 'model access') ----- getList "Answer the list to be displayed. Caches the returned list in the 'list' ivar" getListSelector == nil ifTrue: [^ #()]. list := model perform: getListSelector. list == nil ifTrue: [^ #()]. getListElementSelector ifNil: [list := list collect: [ :item | item asStringOrText ]]. ^ list! ----- Method: PluggableListMorphOfManyAlt>>itemSelectedAmongMultiple: (in category 'model access') ----- itemSelectedAmongMultiple: index ^self listSelectionAt: index! ----- Method: PluggableListMorphOfManyAlt>>list: (in category 'initialization') ----- list: listOfStrings scroller removeAllMorphs. list := listOfStrings ifNil: [Array new]. list isEmpty ifTrue: [^ self selectedMorph: nil]. super list: listOfStrings. "At this point first morph is sensitized, and all morphs share same handler." scroller firstSubmorph on: #mouseEnterDragging send: #mouseEnterDragging:onItem: to: self. scroller firstSubmorph on: #mouseUp send: #mouseUp:onItem: to: self. "This should add this behavior to the shared event handler thus affecting all items"! ----- Method: PluggableListMorphOfManyAlt>>listSelectionAt: (in category 'drawing') ----- listSelectionAt: index getSelectionListSelector ifNil:[^false]. ^model perform: getSelectionListSelector with: index! ----- Method: PluggableListMorphOfManyAlt>>listSelectionAt:put: (in category 'drawing') ----- listSelectionAt: index put: value setSelectionListSelector ifNil:[^false]. ^model perform: setSelectionListSelector with: index with: value! ----- Method: PluggableListMorphOfManyAlt>>mouseDown: (in category 'event handling') ----- mouseDown: event | oldIndex oldVal row | Transcript cr; show: 'mouseDown:'. event yellowButtonPressed ifTrue: [^ self yellowButtonActivity: event shiftPressed]. row := self rowAtLocation: event position. row = 0 ifTrue: [^super mouseDown: event]. model okToChange ifFalse: [^ self]. "No change if model is locked" "Set meaning for subsequent dragging of selection" dragOnOrOff := (self listSelectionAt: row) not. currentRow := row. oldIndex := self getCurrentSelectionIndex. oldVal := oldIndex ~= 0 ifTrue: [self listSelectionAt: oldIndex] ifFalse: [false]. "Need to restore the old one, due to how model works, and set new one." oldIndex ~= 0 ifTrue: [self listSelectionAt: oldIndex put: oldVal]. "Set or clear new primary selection (listIndex)" self listSelectionAt: row put: oldVal not! ----- Method: PluggableListMorphOfManyAlt>>mouseMove: (in category 'event handling') ----- mouseMove: event "The mouse has moved, as characterized by the event provided. Adjust the scrollbar, and alter the selection as appropriate" | row | Transcript cr; show: 'mouseMove:'. event position y < self top ifTrue: [scrollBar scrollUp: 1. row := self rowAtLocation: scroller topLeft + (1 @ 1)] ifFalse: [row := event position y > self bottom ifTrue: [scrollBar scrollDown: 1. self rowAtLocation: scroller bottomLeft + (1 @ -1)] ifFalse: [ self rowAtLocation: event position]]. row = 0 ifTrue: [^super mouseDown: event]. model okToChange ifFalse: [^self]. "No change if model is locked" currentRow = row ifTrue: [^self]. currentRow := row. dragOnOrOff ifNil: ["Don't treat a mouse move immediately after a mouse down to the same index." row = self getCurrentSelectionIndex ifTrue: [^self]. "Was not set at mouse down, which means the mouse must have gone down in an area where there was no list item" dragOnOrOff := (self listSelectionAt: row) not]. "Set or clear new primary selection (listIndex)" dragOnOrOff ifTrue: [self changeModelSelection: row] ifFalse: [self changeModelSelection: 0]. row changed! ----- Method: PluggableListMorphOfManyAlt>>mouseUp: (in category 'event handling') ----- mouseUp: event dragOnOrOff := nil. "So improperly started drags will have no effect" currentRow := nil "So mouseMove won't trigger more than once"! ----- Method: PluggableListMorphOfManyAlt>>on:list:primarySelection:changePrimarySelection:listSelection:changeListSelection:getListElement:menu:keystroke: (in category 'initialization') ----- on: anObject list: listSel primarySelection: getSelectionSel changePrimarySelection: setSelectionSel listSelection: getListSel changeListSelection: setListSel getListElement: listElemSel menu: getMenuSel keystroke: keyActionSel "setup a whole load of pluggability options" getSelectionListSelector := getListSel. setSelectionListSelector := setListSel. getListElementSelector := listElemSel. self on: anObject list: listSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel ! ----- Method: PluggableListMorphOfManyAlt>>scrollSelectionIntoView (in category 'selection') ----- scrollSelectionIntoView "Make sure that the current selection is visible. If the selections() will fit in the scroll region then scroll the selection(s) to the middle of the visible region. If it is larger, make the first part visible." | row rowBounds innerBounds i | (row := self getCurrentSelectionIndex) = 0 ifTrue: [^self]. rowBounds := self listMorph drawBoundsForRow: row. innerBounds := self innerBounds. i := row + 1. [(model perform: getSelectionListSelector with: i) and: [(self listMorph drawBoundsForRow: i) bottom - rowBounds top < innerBounds height]] whileTrue: [i := i + 1]. rowBounds := rowBounds merge: (self listMorph drawBoundsForRow: i - 1). self scrollToShow: (innerBounds align: innerBounds center with: rowBounds center)! ----- Method: PluggableListMorphOfManyAlt>>update: (in category 'updating') ----- update: aSymbol aSymbol == #allSelections ifTrue: [^self updateList; selectionIndex: self getCurrentSelectionIndex]. ^super update: aSymbol! Point subclass: #PlotPoint instanceVariableNames: 'series scaledPoint extra' classVariableNames: '' poolDictionaries: '' category: 'CogTools-VMProfiler'! !PlotPoint commentStamp: '<historical>' prior: 0! PlotPoint is a point that have more data used to draw in a PlotMorph! ----- Method: PlotPoint class>>at:serie: (in category 'instance creation') ----- at: aPoint serie: aPlotSerie ^ self new initializeAt: aPoint series: aPlotSerie! ----- Method: PlotPoint class>>at:serie:extra: (in category 'instance creation') ----- at: aPoint serie: aPlotSerie extra: anObject ^ self new initializeAt: aPoint serie: aPlotSerie extra: anObject! ----- Method: PlotPoint class>>at:series: (in category 'instance creation') ----- at: aPoint series: aPlotSeries ^ self new initializeAt: aPoint series: aPlotSeries! ----- Method: PlotPoint class>>at:series:extra: (in category 'instance creation') ----- at: aPoint series: aPlotSeries extra: anObject ^ self new initializeAt: aPoint series: aPlotSeries extra: anObject! ----- Method: PlotPoint class>>new (in category 'instance creation') ----- new ^super new initialize! ----- Method: PlotPoint>>= (in category 'comparing') ----- = anObject ^ super = anObject and: [series = anObject series and: [extra = anObject extra]]! ----- Method: PlotPoint>>extra (in category 'accessing') ----- extra ^extra! ----- Method: PlotPoint>>hash (in category 'comparing') ----- hash ^ super hash bitXor: (series hash bitXor: extra hash)! ----- Method: PlotPoint>>initialize (in category 'initialization') ----- initialize scaledPoint := self! ----- Method: PlotPoint>>initializeAt:series: (in category 'initialization') ----- initializeAt: aPoint series: aPlotSeries self setX: aPoint x setY: aPoint y. series := aPlotSeries! ----- Method: PlotPoint>>initializeAt:series:extra: (in category 'initialization') ----- initializeAt: aPoint series: aPlotSeries extra: anObject self setX: aPoint x setY: aPoint y. series := aPlotSeries. extra := anObject! ----- Method: PlotPoint>>printOn: (in category 'printing') ----- printOn: aStream super printOn: aStream. aStream nextPutAll: ' series:('; print: series; nextPutAll: ') scaled:'; print: scaledPoint. extra isNil ifFalse: [aStream nextPutAll: ' extra:'; print: extra]! ----- Method: PlotPoint>>scaledPoint (in category 'accessing') ----- scaledPoint ^ scaledPoint ifNil:[self]! ----- Method: PlotPoint>>scaledPoint: (in category 'accessing') ----- scaledPoint: anObject scaledPoint := anObject! ----- Method: PlotPoint>>series (in category 'accessing') ----- series ^ series! Object subclass: #PlotMorphGrid instanceVariableNames: 'plot drawAxis drawGrid' classVariableNames: '' poolDictionaries: '' category: 'CogTools-VMProfiler'! !PlotMorphGrid commentStamp: '<historical>' prior: 0! I'm the grid of a PlotMorph! ----- Method: PlotMorphGrid class>>new (in category 'instance creation') ----- new ^ super new initialize! ----- Method: PlotMorphGrid class>>on: (in category 'instance creation') ----- on: aPlotMorph ^ self new initializeOn: aPlotMorph! ----- Method: PlotMorphGrid>>bestStep: (in category 'drawing') ----- bestStep: aNumber "answer the best step for grid drawing" | bestStep | bestStep := aNumber. 2 to: 40 by: 2 do: [:i | | step | step := aNumber / i. (step between: 25 and: 100) ifTrue: [bestStep := step]]. ^ bestStep! ----- Method: PlotMorphGrid>>drawAxis: (in category 'accessing') ----- drawAxis: aBoolean drawAxis := aBoolean! ----- Method: PlotMorphGrid>>drawAxisOn: (in category 'drawing') ----- drawAxisOn: aCanvas | axisColor yTo lighter darker baseColor bounds xTo | baseColor := plot baseColor alpha: 1. lighter := baseColor twiceLighter twiceLighter twiceLighter. darker := baseColor twiceDarker twiceDarker twiceDarker. axisColor := (lighter diff: baseColor) > (darker diff: baseColor) ifTrue: [lighter] ifFalse: [darker]. "" bounds := plot drawBounds. "Y axe" yTo := bounds topLeft - (0 @ 7). aCanvas line: bounds bottomLeft + (0 @ 5) to: yTo color: axisColor. aCanvas line: yTo to: yTo + (4 @ 4) color: axisColor. aCanvas line: yTo to: yTo + (-4 @ 4) color: axisColor. "X axe" xTo := bounds bottomRight + (7 @ 0). aCanvas line: bounds bottomLeft - (5 @ 0) to: xTo color: axisColor. aCanvas line: xTo to: xTo + (-4 @ -4) color: axisColor. aCanvas line: xTo to: xTo + (-4 @ 4) color: axisColor! ----- Method: PlotMorphGrid>>drawGrid: (in category 'accessing') ----- drawGrid: aBoolean drawGrid := aBoolean! ----- Method: PlotMorphGrid>>drawGridOn: (in category 'drawing') ----- drawGridOn: aCanvas | gridColor lighter darker baseColor bounds | baseColor := plot baseColor alpha: 1. lighter := baseColor twiceLighter. darker := baseColor twiceDarker. gridColor := (lighter diff: baseColor) > (darker diff: baseColor) ifTrue: [lighter] ifFalse: [darker]. bounds := plot drawBounds. (bounds left to: bounds right by: (self bestStep: bounds width)) do: [:x | | xRounded | xRounded := x rounded. aCanvas line: xRounded @ bounds top to: xRounded @ bounds bottom color: gridColor]. (bounds top to: bounds bottom by: (self bestStep: bounds height)) do: [:y | | yRounded | yRounded := y rounded. aCanvas line: bounds left @ yRounded to: bounds right @ yRounded color: gridColor]! ----- Method: PlotMorphGrid>>drawOn: (in category 'drawing') ----- drawOn: aCanvas drawGrid ifTrue: [self drawGridOn: aCanvas]. drawAxis ifTrue: [self drawAxisOn: aCanvas]! ----- Method: PlotMorphGrid>>initialize (in category 'initialization') ----- initialize drawAxis := true. drawGrid := true! ----- Method: PlotMorphGrid>>initializeOn: (in category 'initialization') ----- initializeOn: aPlotMorph plot := aPlotMorph! Object subclass: #PlotSeries instanceVariableNames: 'name description color width points drawPoints drawLine drawArea type' classVariableNames: '' poolDictionaries: '' category: 'CogTools-VMProfiler'! !PlotSeries commentStamp: '<historical>' prior: 0! I'm a serie of a PlotMorph! ----- Method: PlotSeries class>>name: (in category 'instance creation') ----- name: aString ^ self new initializeName: aString ! ----- Method: PlotSeries>>addPoint: (in category 'points') ----- addPoint: aPoint points add: (PlotPoint at: aPoint serie: self)! ----- Method: PlotSeries>>addPoint:extra: (in category 'points') ----- addPoint: aPoint extra:anObject points add: (PlotPoint at: aPoint serie: self extra:anObject)! ----- Method: PlotSeries>>areaColor (in category 'accessing-color') ----- areaColor ^ color alpha: 0.25! ----- Method: PlotSeries>>clear (in category 'accessing') ----- clear points := OrderedCollection new! ----- Method: PlotSeries>>color (in category 'accessing') ----- color ^color! ----- Method: PlotSeries>>color: (in category 'accessing-color') ----- color: anObject color := anObject! ----- Method: PlotSeries>>description (in category 'accessing') ----- description ^ description ifNil:[name]! ----- Method: PlotSeries>>description: (in category 'accessing') ----- description: aString description := aString! ----- Method: PlotSeries>>drawArea: (in category 'accessing') ----- drawArea: aBoolean drawArea := aBoolean! ----- Method: PlotSeries>>drawLine: (in category 'accessing') ----- drawLine: aBoolean drawLine := aBoolean! ----- Method: PlotSeries>>drawOn: (in category 'drawing') ----- drawOn: aCanvas points isEmpty ifTrue: [^ self]. "" drawArea ifTrue: ["" type == #straightened ifTrue: [self drawStraightenedAreaOn: aCanvas]. type == #stepped ifTrue: [self drawSteppedAreaOn: aCanvas]]. drawLine ifTrue: ["" type == #straightened ifTrue: [self drawStraightenedLineOn: aCanvas]. type == #stepped ifTrue: [self drawSteppedLineOn: aCanvas]]. drawPoints ifTrue: [self drawPointsOn: aCanvas]! ----- Method: PlotSeries>>drawPoints: (in category 'accessing') ----- drawPoints: aBoolean drawPoints := aBoolean! ----- Method: PlotSeries>>drawPointsOn: (in category 'drawing') ----- drawPointsOn: aCanvas | pointColor minus plus | pointColor := self pointColor. minus := width @ width. plus := minus * 2. points do: [:point | | scaledPoint | scaledPoint := point scaledPoint. aCanvas fillOval: (scaledPoint - minus rect: scaledPoint + plus) color: pointColor]! ----- Method: PlotSeries>>drawSteppedAreaOn: (in category 'drawing') ----- drawSteppedAreaOn: aCanvas | areaColor areaPoints lastScaledPoint | areaColor := self areaColor. areaPoints := OrderedCollection new. lastScaledPoint := nil. points do: [:each | | scaledPoint | scaledPoint := each scaledPoint. lastScaledPoint ifNotNil: [areaPoints add: scaledPoint x @ lastScaledPoint y]. areaPoints add: scaledPoint. lastScaledPoint := scaledPoint]. aCanvas drawPolygon: areaPoints color: areaColor borderWidth: 0 borderColor: areaColor! ----- Method: PlotSeries>>drawSteppedLineOn: (in category 'drawing') ----- drawSteppedLineOn: aCanvas | lineColor lastScaledPoint | lineColor := self lineColor. lastScaledPoint := nil. points do: [:point | | scaledPoint | scaledPoint := point scaledPoint. lastScaledPoint ifNotNil: [""aCanvas line: lastScaledPoint to: scaledPoint x @ lastScaledPoint y width: width color: lineColor. aCanvas line: scaledPoint x @ lastScaledPoint y to: scaledPoint width: width color: lineColor]. lastScaledPoint := scaledPoint]! ----- Method: PlotSeries>>drawStraightenedAreaOn: (in category 'drawing') ----- drawStraightenedAreaOn: aCanvas | areaColor | areaColor := self areaColor. aCanvas drawPolygon: (points collect: [:each | each scaledPoint]) color: areaColor borderWidth: 0 borderColor: areaColor! ----- Method: PlotSeries>>drawStraightenedLineOn: (in category 'drawing') ----- drawStraightenedLineOn: aCanvas | lineColor lastScaledPoint | lineColor := self lineColor. lastScaledPoint := nil. points do: [:point | | scaledPoint | scaledPoint := point scaledPoint. lastScaledPoint ifNotNil: [aCanvas line: lastScaledPoint to: scaledPoint width: width color: lineColor]. lastScaledPoint := scaledPoint]! ----- Method: PlotSeries>>initializeName: (in category 'initialization') ----- initializeName: aString name := aString. "" color := Color black. "" width := 1. drawPoints := true. drawLine := true. drawArea := false. type := #straightened. points := OrderedCollection new! ----- Method: PlotSeries>>lineColor (in category 'accessing-color') ----- lineColor ^ color alpha: 0.85! ----- Method: PlotSeries>>maxPoint (in category 'points') ----- maxPoint ^ points isEmpty ifTrue: [nil] ifFalse: [points max]! ----- Method: PlotSeries>>minPoint (in category 'points') ----- minPoint ^ points isEmpty ifTrue: [nil] ifFalse: [points min]! ----- Method: PlotSeries>>name (in category 'accessing') ----- name ^ name! ----- Method: PlotSeries>>pointColor (in category 'accessing-color') ----- pointColor ^ color twiceLighter alpha: 0.85! ----- Method: PlotSeries>>points (in category 'accessing') ----- points ^points! ----- Method: PlotSeries>>printOn: (in category 'printing') ----- printOn: aStream aStream nextPutAll: 'Serie:'; nextPutAll: name; nextPutAll: ', color:'; nextPutAll: color asString; nextPutAll: ', width:'; nextPutAll: width asString; nextPutAll: ', drawPoints:'; nextPutAll: drawPoints asString; nextPutAll: ', drawLine:'; nextPutAll: drawLine asString; nextPutAll: ', drawArea:'; nextPutAll: drawArea asString! ----- Method: PlotSeries>>scaleTo:height:maxPoint:minPoint: (in category 'points') ----- scaleTo: anRectangle height: heightInteger maxPoint: maxPoint minPoint: minPoint | drawExtent scaleFrom scaleTo| drawExtent := 1 @ 1 max: maxPoint - minPoint. drawExtent isZero ifTrue:[^ self]. "" scaleFrom := 0 @ 0 rect: drawExtent. scaleTo := anRectangle. points do: [:point | | tempPoint | tempPoint := point - minPoint scaleFrom: scaleFrom to: scaleTo. point scaledPoint: tempPoint x @ (heightInteger - tempPoint y)]! ----- Method: PlotSeries>>type: (in category 'accessing') ----- type: aSymbol "Line Type (#straightened, #stepped)" type := aSymbol! ----- Method: PlotSeries>>width: (in category 'accessing') ----- width: anObject width := anObject! Object subclass: #VMPSymbol instanceVariableNames: 'name address limit' classVariableNames: '' poolDictionaries: '' category: 'CogTools-VMProfiler'! !VMPSymbol commentStamp: '<historical>' prior: 0! A text symbol in the VM's address space corresponding to some form of executable code (see subclasses)! VMPSymbol subclass: #VMPExecutableModuleSymbol instanceVariableNames: 'vmshift shortName' classVariableNames: '' poolDictionaries: '' category: 'CogTools-VMProfiler'! !VMPExecutableModuleSymbol commentStamp: '<historical>' prior: 0! A symbol for some sort of executable, e.g. the VM or a dynamically loaded library it is using. The vmshift inst var is the amount (if any) the text segment of the module has been moved in memory from its static definition.! ----- Method: VMPExecutableModuleSymbol class>>LICENSE (in category 'LICENSE') ----- LICENSE ^'Project Squeak Copyright (c) 2005-2013, 3D Immersive Collaboration Consulting, LLC., All Rights Reserved Redistributions in source code form must reproduce the above copyright and this condition. Licensed under MIT License (MIT) Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.'! ----- Method: VMPExecutableModuleSymbol>>displayText (in category 'printing') ----- displayText ^(name copyFrom: (name lastIndexOf: FileDirectory pathNameDelimiter) + 1 to: name size) asText allBold! ----- Method: VMPExecutableModuleSymbol>>hash (in category 'comparing') ----- hash "Override to avoid hashing on the address. This avoids multiple entries for modules in the symbol manager's symbolsByModule dictionary. Lazy initialization in the symbol manager may change a module's address after parsing its symbols." ^self class hash bitXor: name hash! ----- Method: VMPExecutableModuleSymbol>>nameMatches: (in category 'testing') ----- nameMatches: aPattern ^(super nameMatches: aPattern) or: [shortName notNil and: [aPattern match: shortName]]! ----- Method: VMPExecutableModuleSymbol>>shortName (in category 'accessing') ----- shortName "Answer the value of shortName" ^ shortName! ----- Method: VMPExecutableModuleSymbol>>shortName: (in category 'accessing') ----- shortName: aString "Set the value of shortName" shortName := aString! ----- Method: VMPExecutableModuleSymbol>>type (in category 'accessing') ----- type ^#module! ----- Method: VMPExecutableModuleSymbol>>vmshift (in category 'accessing') ----- vmshift "Answer the value of vmshift" ^ vmshift! ----- Method: VMPExecutableModuleSymbol>>vmshift: (in category 'accessing') ----- vmshift: anObject "Set the value of vmshift" vmshift := anObject! VMPSymbol subclass: #VMPFunctionSymbol instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'CogTools-VMProfiler'! !VMPFunctionSymbol commentStamp: '<historical>' prior: 0! A symbol for a function or procedure (see subclasses)! ----- Method: VMPFunctionSymbol class>>LICENSE (in category 'LICENSE') ----- LICENSE ^'Project Squeak Copyright (c) 2005-2013, 3D Immersive Collaboration Consulting, LLC., All Rights Reserved Redistributions in source code form must reproduce the above copyright and this condition. Licensed under MIT License (MIT) Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.'! VMPFunctionSymbol subclass: #VMPPrivateFunctionSymbol instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'CogTools-VMProfiler'! !VMPPrivateFunctionSymbol commentStamp: '<historical>' prior: 0! A symbol for a function or procedure private to an object or module! ----- Method: VMPPrivateFunctionSymbol class>>LICENSE (in category 'LICENSE') ----- LICENSE ^'Project Squeak Copyright (c) 2005-2013, 3D Immersive Collaboration Consulting, LLC., All Rights Reserved Redistributions in source code form must reproduce the above copyright and this condition. Licensed under MIT License (MIT) Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.'! ----- Method: VMPPrivateFunctionSymbol>>type (in category 'accessing') ----- type ^#privateFunction! VMPFunctionSymbol subclass: #VMPPublicFunctionSymbol instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'CogTools-VMProfiler'! !VMPPublicFunctionSymbol commentStamp: '<historical>' prior: 0! A symbol for a public function or procedure exported from some module! ----- Method: VMPPublicFunctionSymbol class>>LICENSE (in category 'LICENSE') ----- LICENSE ^'Project Squeak Copyright (c) 2005-2013, 3D Immersive Collaboration Consulting, LLC., All Rights Reserved Redistributions in source code form must reproduce the above copyright and this condition. Licensed under MIT License (MIT) Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.'! ----- Method: VMPPublicFunctionSymbol>>type (in category 'accessing') ----- type ^#publicFunction! VMPSymbol subclass: #VMPLabelSymbol instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'CogTools-VMProfiler'! ----- Method: VMPLabelSymbol class>>LICENSE (in category 'LICENSE') ----- LICENSE ^'Project Squeak Copyright (c) 2005-2013, 3D Immersive Collaboration Consulting, LLC., All Rights Reserved Redistributions in source code form must reproduce the above copyright and this condition. Licensed under MIT License (MIT) Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.'! ----- Method: VMPLabelSymbol>>limit (in category 'accessing') ----- limit "Answer the address. labels are point entities" ^address! ----- Method: VMPLabelSymbol>>limit: (in category 'accessing') ----- limit: aValue "Ignore. labels are point entities"! ----- Method: VMPLabelSymbol>>type (in category 'accessing') ----- type ^#label! VMPSymbol subclass: #VMPObjectFileSymbol instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'CogTools-VMProfiler'! !VMPObjectFileSymbol commentStamp: '<historical>' prior: 0! A symbol for an object file which has been linked into a module! ----- Method: VMPObjectFileSymbol class>>LICENSE (in category 'LICENSE') ----- LICENSE ^'Project Squeak Copyright (c) 2005-2013, 3D Immersive Collaboration Consulting, LLC., All Rights Reserved Redistributions in source code form must reproduce the above copyright and this condition. Licensed under MIT License (MIT) Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.'! ----- Method: VMPObjectFileSymbol>>type (in category 'accessing') ----- type ^#objectFile! ----- Method: VMPSymbol class>>LICENSE (in category 'LICENSE') ----- LICENSE ^'Project Squeak Copyright (c) 2005-2013, 3D Immersive Collaboration Consulting, LLC., All Rights Reserved Redistributions in source code form must reproduce the above copyright and this condition. Licensed under MIT License (MIT) Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.'! ----- Method: VMPSymbol class>>defaultIntegerBaseInDebugger (in category 'debugger') ----- defaultIntegerBaseInDebugger ^16! ----- Method: VMPSymbol>>= (in category 'comparing') ----- = anObject ^self class == anObject class and: [address = anObject address and: [name = anObject name]]! ----- Method: VMPSymbol>>address (in category 'accessing') ----- address "Answer the value of address" ^ address! ----- Method: VMPSymbol>>address: (in category 'accessing') ----- address: anObject "Set the value of address" address := anObject! ----- Method: VMPSymbol>>displayText (in category 'printing') ----- displayText "Answer the name as a string, which for the purposes of the symbol list is an unemphasized text." ^name! ----- Method: VMPSymbol>>hash (in category 'comparing') ----- hash ^address hash bitXor: name hash! ----- Method: VMPSymbol>>limit (in category 'accessing') ----- limit "Answer the value of limit" ^ limit! ----- Method: VMPSymbol>>limit: (in category 'accessing') ----- limit: anObject "Set the value of limit" anObject - address > 2097152 ifTrue: [Transcript cr; nextPutAll: name; space; print: anObject - address; tab; nextPutAll: (anObject - address) hex; flush. "self halt"]. limit := anObject "VMProfilerMacSymbolsManager basicNew initializeSynchronously"! ----- Method: VMPSymbol>>name (in category 'accessing') ----- name "Answer the value of name" ^name! ----- Method: VMPSymbol>>name: (in category 'accessing') ----- name: anObject "Set the value of name" name := anObject! ----- Method: VMPSymbol>>nameMatches: (in category 'testing') ----- nameMatches: aPattern ^aPattern match: name! ----- Method: VMPSymbol>>printOn: (in category 'printing') ----- printOn: aStream super printOn: aStream. [aStream space; nextPut: $(; nextPutAll: self type; space; nextPutAll: name; space. address printOn: aStream base: 16. (limit ~~ nil and: [limit ~= address]) ifTrue: [aStream nextPut: $-. limit printOn: aStream base: 16]. aStream nextPut: $)] on: Error do: [:ex| aStream print: ex; nextPut: $)]! ----- Method: VMPSymbol>>size: (in category 'accessing') ----- size: size limit := address + size! ----- Method: VMPSymbol>>type (in category 'accessing') ----- type ^self subclassResponsibility! Object subclass: #VMProfilerSymbolsManager instanceVariableNames: 'modules symbolsByModule modulesByName vmModule cogModule' classVariableNames: '' poolDictionaries: '' category: 'CogTools-VMProfiler'! VMProfilerSymbolsManager subclass: #VMProfilerLinuxSymbolsManager instanceVariableNames: 'initialized tempDir maxAddressMask warnInconsistentShift' classVariableNames: '' poolDictionaries: '' category: 'CogTools-VMProfiler'! ----- Method: VMProfilerLinuxSymbolsManager class>>LICENSE (in category 'LICENSE') ----- LICENSE ^'Project Squeak Copyright (c) 2005-2013, 3D Immersive Collaboration Consulting, LLC., All Rights Reserved Redistributions in source code form must reproduce the above copyright and this condition. Licensed under MIT License (MIT) Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.'! ----- Method: VMProfilerLinuxSymbolsManager class>>defaultIntegerBaseInDebugger (in category 'debugger') ----- defaultIntegerBaseInDebugger ^16! ----- 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! ----- Method: VMProfilerLinuxSymbolsManager class>>shutDown: (in category 'shut down') ----- shutDown: quitting (quitting and: [#('Mac OS' 'unix') includes: Smalltalk platformName]) ifTrue: [| tempDir | (tempDir := self tempDirectory) exists ifTrue: [tempDir recursiveDelete]]! ----- Method: VMProfilerLinuxSymbolsManager class>>tempDirectory (in category 'accessing') ----- tempDirectory ^FileDirectory on: '/tmp/vmsyms', OSProcess thisOSProcess pid printString! ----- Method: VMProfilerLinuxSymbolsManager>>hexFromStream: (in category 'parsing') ----- hexFromStream: aStream "Fast reading of lower-case hexadecimal." | value index | value := 0. [nil ~~ (index := '0123456789abcdef' indexOf: aStream next ifAbsent: nil)] whileTrue: [value := (value bitShift: 4) + index - 1]. ^value "(self basicNew hexFromStream: '91a45000' readStream) hex"! ----- Method: VMProfilerLinuxSymbolsManager>>initialize (in category 'initialize-release') ----- initialize "Initialize the receiver, parsing the symbols in the background for faster startup." self initializeMost. self parseAsynchronously! ----- 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) 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 := tempDir localNameFor: fileName. counter := 0. [shortNames includes: shortName] whileTrue: [counter := counter + 1. shortName := (tempDir localNameFor: fileName), counter printString]. shortNames add: shortName. longName := (modules at: i + 1) ifNil: [fileName] ifNotNil: [:symlink| symlink first = $/ ifTrue: [symlink] ifFalse: [(FileDirectory dirPathFor: fileName), '/', symlink]]. "some files are off limits (e.g. /dgagent/lib/preload.so)" (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]! ----- Method: VMProfilerLinuxSymbolsManager>>initializeSynchronously (in category 'initialize-release') ----- initializeSynchronously "Initialize the receiver, parsing the symbols in the foreground for debugging." self initializeMost. self parseSynchronously! ----- Method: VMProfilerLinuxSymbolsManager>>initialized (in category 'accessing') ----- initialized ^initialized! ----- Method: VMProfilerLinuxSymbolsManager>>parseAsynchronously (in category 'parsing') ----- parseAsynchronously "Parse the symbols in the background for faster startup." "Parse only the VM module. The profiler needs this initialized early." symbolsByModule at: vmModule put: { vmModule }. self parseSymbolsFor: vmModule. "Kick-off a process to compute the symbol list for each module. Parsing symbols can take a few seconds so we parse in the background." [modules allButFirst do: [:module| symbolsByModule at: module put: { module }. self parseSymbolsFor: module. module address ifNil: [symbolsByModule removeKey: module]]. modules := (modules reject: [:m| m address isNil]) asSortedCollection: [:m1 :m2| m1 address <= m2 address]. initialized := true] forkAt: Processor userBackgroundPriority! ----- Method: VMProfilerLinuxSymbolsManager>>parseSymbolsFor: (in category 'parsing') ----- parseSymbolsFor: module | proc symtab symStream | (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 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]! ----- Method: VMProfilerLinuxSymbolsManager>>parseSymbolsFrom:to: (in category 'parsing') ----- parseSymbolsFrom: symtab "<ReadStream>" to: symStream "<WriteStream> ^<VMPSymbol>" "Parse the text symbols on the stream symtab (in objdump format) to symStream. Answer the last text symbol." | prev | [symtab atEnd] whileFalse: [| line tokens address size type symbol | tokens := (line := symtab upTo: Character lf) substrings. self assert: (tokens size between: 5 and: 7). self assert: ((tokens size = 5 and: [tokens third = '.text']) "labels" or: [tokens fourth = '.text']) "functions". address := Integer readFrom: tokens first readStream radix: 16. size := tokens size = 5 ifTrue: [0] "labels" ifFalse: [Integer readFrom: tokens fifth readStream radix: 16]. type := tokens second. symbol := (type = 'g' ifTrue: [VMPPublicFunctionSymbol] ifFalse: [(tokens last beginsWith: '.L') ifTrue: [VMPLabelSymbol] ifFalse: [VMPPrivateFunctionSymbol]]) new. symbol name: tokens last; address: address; limit: address + size. (prev isNil or: [prev ~= symbol]) ifTrue: [symStream nextPut: symbol]. prev := symbol]. ^prev! ----- Method: VMProfilerLinuxSymbolsManager>>parseSynchronously (in category 'parsing') ----- parseSynchronously modules do: [:module| symbolsByModule at: module put: { module }. self parseSymbolsFor: module. module address ifNil: [symbolsByModule removeKey: module]]. modules := (modules reject: [:m| m address isNil]) asSortedCollection: [:m1 :m2| m1 address <= m2 address]. initialized := true! ----- Method: VMProfilerLinuxSymbolsManager>>primitiveDLSym:in: (in category 'primitives') ----- primitiveDLSym: symbolName in: libraryName <primitive: 'primitiveDLSymInLibrary' module: 'VMProfileLinuxSupportPlugin' error: ec> ec == #'not found' ifTrue: [^nil]. ^self primitiveFailed! ----- Method: VMProfilerLinuxSymbolsManager>>primitiveExecutableModules (in category 'primitives') ----- primitiveExecutableModules "Answer an Array of pairs of strings for executable modules (the VM executable and loaded libraries). The first element in each pair is the filename of the module. The second element is either nil or the symlink's target, if the filename is a symlink." <primitive: 'primitiveExecutableModules' module: 'VMProfileLinuxSupportPlugin'> ^self primitiveFailed "self basicNew primitiveExecutableModules"! ----- Method: VMProfilerLinuxSymbolsManager>>primitiveInterpretAddress (in category 'primitives') ----- primitiveInterpretAddress "Answer the address of the interpret routine. Used to compute the address shift, if any, of the VM module." <primitive: 'primitiveInterpretAddress' module: 'VMProfileLinuxSupportPlugin'> ^self primitiveFailed "self basicNew primitiveInterpretAddress"! ----- Method: VMProfilerLinuxSymbolsManager>>relocateSymbols:inModule: (in category 'parsing') ----- relocateSymbols: symbols inModule: module "We can't trust the shift that comes from the dyld_get_image_header call in primitiveExecutableModulesAndOffsets. So use dlsym to find out the actual address of the first real symbol and use that to compute the real shift. At least some libraries (e.g. /usr/lib/libSystem.B.dylib) don't have a single shift (!!!!). Check, and compensate by calling dlsym on each symbol." | shift count prev | symbols isEmpty ifTrue: [^symbols]. "avoid symbols first exception" shift := module = vmModule ifTrue: [self primitiveInterpretAddress - (symbols detect: [:s| s name = 'interpret']) address] ifFalse: [(symbols detect: [:sym| sym type == #publicFunction and: [(self primitiveDLSym: sym name in: module name) notNil]] ifNone: []) ifNil: [Transcript cr; show: 'warning, can''t find any public symbols in ', module name. 0] ifNotNil: [:symbol| (self primitiveDLSym: symbol name in: module name) - symbol address]]. module address ifNil: [module address: symbols first address + shift; limit: symbols last limit + shift]. shift = 0 ifTrue: [count := 0. symbols do: [:s| (s address between: module address and: module limit) ifTrue: [count := count + 1]]. count = symbols size ifTrue: [^symbols]. "don't waste time..." count ~= 0 ifTrue: [self error: 'parse error; some symbols within module, some without']. shift := module address]. (prev := symbols first) address: (maxAddressMask bitAnd: symbols first address + shift). symbols do: [:sym| | reloc | prev ~~ sym ifTrue: [reloc := maxAddressMask bitAnd: sym address + shift. sym address: reloc. prev limit: reloc]. prev := sym]. symbols last limit: (symbols last limit ifNil: [module limit] ifNotNil: [:limit| maxAddressMask bitAnd: limit + shift]). ^symbols! VMProfilerSymbolsManager subclass: #VMProfilerMacSymbolsManager instanceVariableNames: 'initialized tempDir maxAddressMask warnInconsistentShift' classVariableNames: '' poolDictionaries: '' category: 'CogTools-VMProfiler'! ----- Method: VMProfilerMacSymbolsManager class>>LICENSE (in category 'LICENSE') ----- LICENSE ^'Project Squeak Copyright (c) 2005-2013, 3D Immersive Collaboration Consulting, LLC., All Rights Reserved Redistributions in source code form must reproduce the above copyright and this condition. Licensed under MIT License (MIT) Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.'! ----- Method: VMProfilerMacSymbolsManager class>>defaultIntegerBaseInDebugger (in category 'debugger') ----- defaultIntegerBaseInDebugger ^16! ----- 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! ----- Method: VMProfilerMacSymbolsManager class>>shutDown: (in category 'shut down') ----- shutDown: quitting (quitting and: [Smalltalk platformName= 'Mac OS']) ifTrue: [| tempDir | (tempDir := self tempDirectory) exists ifTrue: [tempDir recursiveDelete]]! ----- Method: VMProfilerMacSymbolsManager class>>tempDirectory (in category 'accessing') ----- tempDirectory ^FileDirectory on: '/tmp/vmsyms', OSProcess thisOSProcess pid printString! ----- Method: VMProfilerMacSymbolsManager>>hexFromStream: (in category 'parsing') ----- hexFromStream: aStream "Fast reading of lower-case hexadecimal." | value index | value := 0. [nil ~~ (index := '0123456789abcdef' indexOf: aStream next ifAbsent: nil)] whileTrue: [value := (value bitShift: 4) + index - 1]. ^value "(self basicNew hexFromStream: '91a45000' readStream) hex"! ----- Method: VMProfilerMacSymbolsManager>>initialize (in category 'initialize-release') ----- initialize "Initialize the receiver, parsing the symbols in the background for faster startup." self initializeMost. self parseAsynchronously! ----- Method: VMProfilerMacSymbolsManager>>initializeMost (in category 'initialize-release') ----- initializeMost | shortNames | initialized := false. maxAddressMask := (2 raisedToInteger: 32) - 1. modulesByName := Dictionary new. symbolsByModule := Dictionary new. shortNames := Set new. modules := self primitiveExecutableModulesAndOffsets. (tempDir := self class tempDirectory) assureExistence. modules := (1 to: modules size by: 4) collect: [:i| | shortName counter | shortName := tempDir localNameFor: (modules at: i). counter := 0. [shortNames includes: shortName] whileTrue: [counter := counter + 1. shortName := (tempDir localNameFor: (modules at: i)), counter printString]. shortNames add: shortName. (modulesByName at: (modules at: i) put: VMPExecutableModuleSymbol new) name: (modules at: i); shortName: shortName; vmshift: (modules at: i + 1); address: (maxAddressMask bitAnd: (modules at: i + 2) + (modules at: i + 1)); size: (modules at: i + 3)]. "The primitive always answers the VM info in the first entry." vmModule := modules first. modules := modules asSortedCollection: [:m1 :m2| m1 address <= m2 address]! ----- Method: VMProfilerMacSymbolsManager>>initializeSynchronously (in category 'initialize-release') ----- initializeSynchronously "Initialize the receiver, parsing the symbols in the foreground for debugging." self initializeMost. self parseSynchronously! ----- Method: VMProfilerMacSymbolsManager>>initialized (in category 'accessing') ----- initialized ^initialized! ----- Method: VMProfilerMacSymbolsManager>>parseAsynchronously (in category 'parsing') ----- parseAsynchronously "Parse the symbols in the background for faster startup." "Parse only the VM module. The profiler needs this initialized early." symbolsByModule at: vmModule put: { vmModule }. self parseSymbolsFor: vmModule. "Kick-off a process to compute the symbol list for each module. Parsing symbols can take a few seconds so we parse in the background." [modules allButFirst do: [:module| symbolsByModule at: module put: { module }. self parseSymbolsFor: module]. initialized := true] forkAt: Processor userBackgroundPriority! ----- Method: VMProfilerMacSymbolsManager>>parseSymbolsFor: (in category 'parsing') ----- parseSymbolsFor: module | arch proc symtab symStream | arch := 'i386'. "for now; needs to be fetched from a systemAttribute sometime soon." (tempDir fileExists: module shortName) ifFalse: [proc := OSProcess thisOSProcess command: 'cd ', tempDir fullName, ';nm -n -arch ', arch, ' -f "', module name, '" | grep -v " [aAU] " >"', module shortName, '"']. symStream := (Array new: 1000) writeStream. symStream nextPut: module. proc ifNotNil: [[proc isComplete] whileFalse: [(Delay forMilliseconds: 25) wait]]. symtab := [StandardFileStream readOnlyFileNamed: (tempDir fullNameFor: module shortName)] on: Error do: [:ex| "Handle flaky OSProcess stuff by reporting error and failing to parse" Transcript print: ex; flush. ^nil]. [| 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]! ----- Method: VMProfilerMacSymbolsManager>>parseSymbolsFrom:to: (in category 'parsing') ----- parseSymbolsFrom: symtab "<ReadStream>" to: symStream "<WriteStream> ^<VMPSymbol>" "Parse the text symbols on the stream symtab (in nm format) to symStream. Answer the last text symbol." | space lf prev | space := Character space. lf := Character lf. [symtab atEnd] whileFalse: [| line ch address | line := (symtab upTo: lf) readStream. line skipSeparators. ((ch := line peek) notNil and: [ch ~= space and: [(address := self hexFromStream: line) ~= maxAddressMask and: [address ~= 0 "on 10.6 this eliminates initial mh_dylib_header entries"]]]) ifTrue: [| symbol | prev notNil ifTrue: [prev limit: address]. ('Tt' includes: line peek) ifTrue: [| public | public := line next == $T. line skipTo: space. symbol := (line peek == $L ifTrue: [VMPLabelSymbol] ifFalse: [public ifTrue: [VMPPublicFunctionSymbol] ifFalse: [VMPPrivateFunctionSymbol]]) new. line peek = $_ ifTrue: "Get rid of initial underscore." [line next]. "N.B. relied upon by primitiveDLSym: below" symbol name: line upToEnd; address: address. symStream nextPut: symbol. symbol type ~~ #label ifTrue: [prev := symbol]] ifFalse: "first non-text symbol marks the end of the text segment" [symtab setToEnd]]]. ^prev! ----- Method: VMProfilerMacSymbolsManager>>parseSynchronously (in category 'parsing') ----- parseSynchronously modules do: [:module| symbolsByModule at: module put: { module }. self parseSymbolsFor: module]. initialized := true! ----- Method: VMProfilerMacSymbolsManager>>primitiveDLSym: (in category 'primitives') ----- primitiveDLSym: symbolNameString <primitive: 'primitiveDLSym' module: 'VMProfileMacSupportPlugin' error: ec> ^self primitiveFailed! ----- Method: VMProfilerMacSymbolsManager>>primitiveExecutableModulesAndOffsets (in category 'primitives') ----- primitiveExecutableModulesAndOffsets "Answer an Array of pairs of executable module names (the VM executable and all loaded libraries) and the vm address relocation, if any, is for the module." <primitive: 'primitiveExecutableModulesAndOffsets' module: 'VMProfileMacSupportPlugin'> ^self primitiveFailed "self basicNew primitiveExecutableModulesAndOffsets"! ----- Method: VMProfilerMacSymbolsManager>>relocateAndFilter:in:initialShift: (in category 'parsing') ----- relocateAndFilter: symbols in: module initialShift: initialShift "We can't trust the shift that comes from the dyld_get_image_header call in primitiveExecutableModulesAndOffsets. So use dlsym to find out the actual address of the first real symbol and use that to compute the real shift. At least some libraries (e.g. /usr/lib/libSystem.B.dylib) don't have a single shift (!!!!). For these we have to call dlsym on each symbol." | shift prev lastSize | prev := nil. shift := initialShift. symbols last limit isNil ifTrue: [self halt]. symbols do: [:s| | address | lastSize := s limit ifNotNil: [:limit| limit - s address]. s type == #publicFunction ifTrue: [(address := self primitiveDLSym: s name) ifNil: [s address: nil] ifNotNil: [(address between: module address and: module limit) ifTrue: [prev notNil ifTrue: [prev limit: address]. shift := address - s address. s address: address] ifFalse: "duplicate symbol from some other library" [address := maxAddressMask bitAnd: s address + shift. s address: address. prev ifNotNil: [prev limit: address]. prev := s]. prev := s]] ifFalse: [address := maxAddressMask bitAnd: s address + shift. s address: address. prev ifNotNil: [prev limit: address]. prev := s]]. prev limit: (lastSize ifNotNil: [prev address + lastSize] ifNil: [module limit]). ^symbols select: [:s| s address notNil]! ----- Method: VMProfilerMacSymbolsManager>>relocateSymbols:inModule: (in category 'parsing') ----- relocateSymbols: symbols inModule: module "We can't trust the shift that comes from the dyld_get_image_header call in primitiveExecutableModulesAndOffsets. So use dlsym to find out the actual address of the first real symbol and use that to compute the real shift. At least some libraries (e.g. /usr/lib/libSystem.B.dylib) don't have a single shift (!!!!). Check, and compensate by calling dlsym on each symbol." | shift i incr count prev | symbols isEmpty ifTrue: [^symbols]. "avoid symbols first exception" shift := (symbols detect: [:sym| sym type == #publicFunction and: [(self primitiveDLSym: sym name) notNil]] ifNone: []) ifNil: [module vmshift] ifNotNil: [:symbol| (self primitiveDLSym: symbol name) - symbol address]. "Need to check for inconsistentshifts, because its faster by several seconds overall if we can relocate using a single shift. But we can only lookup public symbols." i := 2. incr := warnInconsistentShift ifNil: [symbols size // 50 max: 1] ifNotNil: [1]. [i <= symbols size] whileTrue: [(symbols at: i) type == #publicFunction ifTrue: [(self primitiveDLSym: (symbols at: i) name) ifNotNil: [:addr| addr - (symbols at: i) address ~= shift ifTrue: [warnInconsistentShift == true ifTrue: [Transcript cr; print: module shortName; nextPutAll: ' contains symbols with inconsistent shift'; flush]. ^self relocateAndFilter: symbols in: module initialShift: shift]]. i := i + incr] ifFalse: "not public; can't look it up; so skip it" [i := i + 1]]. warnInconsistentShift == false ifTrue: [Transcript cr; print: module shortName; nextPutAll: ' contains symbols with a consistent shift'; flush]. shift = 0 ifTrue: [count := 0. symbols do: [:s| (s address between: module address and: module limit) ifTrue: [count := count + 1]]. count = symbols size ifTrue: [^symbols]. "don't waste time..." count ~= 0 ifTrue: [self error: 'parse error; some symbols within module, some without']. shift := module address]. (prev := symbols first) address: (maxAddressMask bitAnd: symbols first address + shift). symbols do: [:sym| | reloc | prev ~~ sym ifTrue: [reloc := maxAddressMask bitAnd: sym address + shift. sym address: reloc. prev limit: reloc]. prev := sym]. symbols last limit: (symbols last limit ifNil: [module limit] ifNotNil: [:limit| maxAddressMask bitAnd: limit + shift]). ^symbols! ----- Method: VMProfilerSymbolsManager class>>LICENSE (in category 'LICENSE') ----- LICENSE ^'Project Squeak Copyright (c) 2005-2013, 3D Immersive Collaboration Consulting, LLC., All Rights Reserved Redistributions in source code form must reproduce the above copyright and this condition. Licensed under MIT License (MIT) Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.'! ----- Method: VMProfilerSymbolsManager>>addCogModuleSymbols: (in category 'Cog compiled code') ----- addCogModuleSymbols: symbols [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! ----- Method: VMProfilerSymbolsManager>>cogModule (in category 'accessing') ----- cogModule ^cogModule! ----- Method: VMProfilerSymbolsManager>>computeCogCodeModule: (in category 'Cog compiled code') ----- computeCogCodeModule: cogCodeConstituents | symbols | (cogModule := VMPExecutableModuleSymbol new) name: vmModule shortName, '.', cogCodeConstituents first; shortName: cogCodeConstituents first; vmshift: 0; address: cogCodeConstituents second; size: cogCodeConstituents last - cogCodeConstituents second. symbols := (3 to: cogCodeConstituents size - 2 by: 2) collect: [:i| "Declare methods as public; PICs and entries as private" | thing | ((thing := cogCodeConstituents at: i) isCompiledMethod ifTrue: [VMPPublicFunctionSymbol] ifFalse: [VMPPrivateFunctionSymbol]) new name: (thing isCompiledMethod ifTrue: [thing methodClass name, '>>', thing selector] ifFalse: [thing class == cogCodeConstituents first class ifTrue: [thing] ifFalse: ['PIC ', (thing isString ifTrue: [thing] ifFalse: [thing printString])]]); address: (cogCodeConstituents at: i + 1); limit: (cogCodeConstituents at: i + 3 ifAbsent: [cogCodeConstituents last])]. self addCogModuleSymbols: symbols! ----- Method: VMProfilerSymbolsManager>>moduleFor: (in category 'accessing') ----- moduleFor: aSymbol ^modules detect: [:module| module address <= aSymbol address and: [module limit >= aSymbol limit]] ifNone: []! ----- Method: VMProfilerSymbolsManager>>moduleForAddress: (in category 'accessing') ----- moduleForAddress: address ^modules detect: [:module| module address <= address and: [module limit >= address]] ifNone: []! ----- Method: VMProfilerSymbolsManager>>modules (in category 'accessing') ----- modules ^modules! ----- Method: VMProfilerSymbolsManager>>symbolsInModule: (in category 'accessing') ----- symbolsInModule: aModule ^symbolsByModule at: aModule ifAbsent: [#()]! ----- Method: VMProfilerSymbolsManager>>symbolsSelect: (in category 'accessing') ----- symbolsSelect: aBlock | size stream | size := symbolsByModule inject: 0 into: [:sum :symbols| sum + symbols size]. stream := (Array new: size) writeStream. modules do: [:module| (aBlock value: module) ifTrue: [stream nextPut: module]. (symbolsByModule at: module) do: [:sym| (aBlock value: sym) ifTrue: [stream nextPut: sym]]]. ^stream contents! ----- Method: VMProfilerSymbolsManager>>symbolsWithTypes: (in category 'accessing') ----- symbolsWithTypes: aSet | size stream | aSet = (Set with: #module) ifTrue: [^modules]. size := symbolsByModule inject: 0 into: [:sum :symbols| sum + symbols size]. stream := (Array new: size) writeStream. modules do: [:module| (symbolsByModule at: module) do: [:sym| (aSet includes: sym type) ifTrue: [stream nextPut: sym]]]. ^stream contents! ----- Method: VMProfilerSymbolsManager>>vmModule (in category 'accessing') ----- vmModule ^vmModule! RectangleMorph subclass: #AxesMorph instanceVariableNames: 'form limitMaxX limitMinX limitMaxY limitMinY title xmax xmid xmin ymax ymid ymin xAxisFormatter yAxisFormatter margin grid drawCotas' classVariableNames: '' poolDictionaries: '' category: 'CogTools-VMProfiler'! !AxesMorph commentStamp: 'jcg 8/29/2003 23:01' prior: 0! I am responsible for drawing a pair of axes, a grid, and various labels. I am not responsible for the display of any data, or for handling user input in any special way.! ----- Method: AxesMorph>>baseColor (in category 'accessing') ----- baseColor "Answer the base color to calculate other colors from" | baseColor current | baseColor := self color. current := self. [current notNil & (baseColor = Color transparent)] whileTrue: ["" baseColor := current color. current := current owner]. ^ baseColor! ----- Method: AxesMorph>>changed (in category 'change reporting') ----- changed super changed. form := nil.! ----- Method: AxesMorph>>color: (in category 'accessing') ----- color: aColor super color: aColor. self updateCotas! ----- Method: AxesMorph>>cotaColor (in category 'drawing') ----- cotaColor | baseColor lighter darker | baseColor := self baseColor asNontranslucentColor. baseColor = Color white ifTrue: [^ Color black]. "" lighter := baseColor muchLighter. darker := baseColor muchDarker. "" ^ (lighter diff: baseColor) > (darker diff: baseColor) ifTrue: [lighter] ifFalse: [darker]! ----- Method: AxesMorph>>dataPointToGridPoint: (in category 'utility') ----- dataPointToGridPoint: aPoint "Compute the pixel coordinates wrt the grid origin of the given data point." | drawBounds | drawBounds := self drawBounds. ^ (aPoint - self minPoint) * (drawBounds width @ drawBounds height negated). ! ----- Method: AxesMorph>>dataPointToWorldPoint: (in category 'utility') ----- dataPointToWorldPoint: aPoint "Compute the pixel coordinates wrt the World origin of the given data point." ^ (self dataPointToGridPoint: aPoint) + self gridOrigin! ----- Method: AxesMorph>>drawBounds (in category 'geometry') ----- drawBounds "answer the rectangle inside the morph where the plot is drawn" ^ (0 @ 0 rect: self width @ self height - (self borderWidth * 2)) insetBy: margin! ----- Method: AxesMorph>>drawGridOn: (in category 'drawing') ----- drawGridOn: aCanvas | gridColor right bottom width height lighter darker baseColor | baseColor := self baseColor. lighter := baseColor twiceLighter. darker := baseColor twiceDarker. gridColor := (lighter diff: baseColor) > (darker diff: baseColor) ifTrue: [lighter] ifFalse: [darker]. "" right := self bounds width - margin. width := self bounds width - (margin * 2). bottom := self bounds height - margin. height := self bounds height - (margin * 2). (margin to: right by: width / 10) do: [:x | | xRounded | xRounded := x rounded. aCanvas line: xRounded @ margin to: xRounded @ bottom color: gridColor]. (margin to: bottom by: height / 10) do: [:y | | yRounded | yRounded := y rounded. aCanvas line: margin @ yRounded to: right @ yRounded color: gridColor]! ----- Method: AxesMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas super drawOn: aCanvas. aCanvas image: self form at: self topLeft + self borderWidth rule: Form blend! ----- Method: AxesMorph>>extent: (in category 'geometry') ----- extent: aPoint super extent: (aPoint max: self minExtent)! ----- Method: AxesMorph>>externalName (in category 'naming') ----- externalName ^ super externalName, (title contents isEmpty ifTrue:[''] ifFalse:[' - ', title contents])! ----- Method: AxesMorph>>form (in category 'drawing') ----- form form ifNil: [ Cursor wait showWhile: [ form := Form extent: (self bounds insetBy: self borderWidth) extent depth: Display depth. form fillColor: self color. self updateForm]]. ^ form! ----- Method: AxesMorph>>graphBounds: (in category 'accessing') ----- graphBounds: aRectangle "Sets the axes and then draws." Transcript cr; print: aRectangle; flush. limitMinX := aRectangle left. limitMinY := aRectangle bottom. limitMaxX := aRectangle right. limitMaxY := aRectangle top. self changed! ----- Method: AxesMorph>>gridOrigin (in category 'accessing') ----- gridOrigin "Answer the intersection of the two axes (lower left corner of the grid)" | inset | inset := self borderWidth + margin. ^ self bottomLeft + (inset @ inset negated)! ----- Method: AxesMorph>>gridPointToDataPoint: (in category 'utility') ----- gridPointToDataPoint: aPoint "Compute the coordinates of the data point corresponding to the given grid point (given in pixel coordinates wrt the grid origin)." | drawBounds | drawBounds := self drawBounds. ^ (aPoint x @ aPoint y negated) / (drawBounds extent) + self minPoint ! ----- Method: AxesMorph>>initialize (in category 'initialization') ----- initialize super initialize. self color: Color gray. grid := PlotMorphGrid on: self. xAxisFormatter := [:x | x printString]. yAxisFormatter := [:y | y printString]. self initializeCotas. margin := 15 max: (title height + 2). form := nil. self extent: 1@1.! ----- Method: AxesMorph>>initializeCotas (in category 'initialization') ----- initializeCotas drawCotas := true. "" title := StringMorph contents: '' font: TextStyle defaultFont emphasis: 1. xmax := StringMorph contents: ''. xmid := StringMorph contents: ''. xmin := StringMorph contents: ''. ymax := StringMorph contents: ''. ymid := StringMorph contents: ''. ymin := StringMorph contents: ''. "" self addMorph: title. self addMorph: xmax. self addMorph: xmid. self addMorph: xmin. self addMorph: ymax. self addMorph: ymid. self addMorph: ymin. "" limitMinX := 0. limitMaxX := 1.0. limitMinY := 0. limitMaxY := 1.0.! ----- Method: AxesMorph>>limitMaxX: (in category 'accessing') ----- limitMaxX: aNumberOrNil "Set the maximum value along the X axis. If nil, this value will be computed from the data points to be displayed (subclass responsibility, since AxesMorph doesn't know anything about data)." limitMaxX := aNumberOrNil. self changed.! ----- Method: AxesMorph>>limitMaxY: (in category 'accessing') ----- limitMaxY: aNumberOrNil "Set the maximum value along the X axis. If nil, this value will be computed from the data points to be displayed (subclass responsibility, since AxesMorph doesn't know anything about data)." limitMaxY := aNumberOrNil. self changed! ----- Method: AxesMorph>>limitMinX: (in category 'accessing') ----- limitMinX: aNumberOrNil "Set the maximum value along the X axis. If nil, this value will be computed from the data points to be displayed (subclass responsibility, since AxesMorph doesn't know anything about data)." limitMinX := aNumberOrNil. self changed! ----- Method: AxesMorph>>limitMinX:limitMaxX: (in category 'accessing') ----- limitMinX: minNumberOrNil limitMaxX: maxNumberOrNil "Set the minimum and maximum values along the X axis. If nil, these values will be computed from the data points to be displayed (subclass responsibility, since AxesMorph doesn't know anything about data)." limitMinX := minNumberOrNil. limitMaxX := maxNumberOrNil. self changed! ----- Method: AxesMorph>>limitMinY: (in category 'accessing') ----- limitMinY: aNumberOrNil "Set the maximum value along the X axis. If nil, this value will be computed from the data points to be displayed (subclass responsibility, since AxesMorph doesn't know anything about data)." limitMinY := aNumberOrNil. self changed! ----- Method: AxesMorph>>margin (in category 'accessing') ----- margin "Answer the width of the margin surrounding the grid." ^margin! ----- Method: AxesMorph>>margin: (in category 'accessing') ----- margin: anInteger "Set the size of the margin surrounding the grid." margin := anInteger. self changed! ----- Method: AxesMorph>>maxPoint (in category 'drawing') ----- maxPoint "Limit values must be non-nil" ^ limitMaxX @ limitMaxY! ----- Method: AxesMorph>>minExtent (in category 'geometry') ----- minExtent ^ 125 @ 125 + margin ! ----- Method: AxesMorph>>minPoint (in category 'drawing') ----- minPoint "Limit values must be non-nil" ^ limitMinX @ limitMinY! ----- Method: AxesMorph>>referenceColor (in category 'accessing') ----- referenceColor "This name is confusing because it sounds like it has something to do with PlotMorphs 'references' instance variable." self deprecatedExplanation: 'use #baseColor instead'. ^ self baseColor! ----- Method: AxesMorph>>shouldDrawAxis: (in category 'accessing') ----- shouldDrawAxis: aBoolean grid drawAxis: aBoolean. self changed! ----- Method: AxesMorph>>shouldDrawCotas: (in category 'accessing') ----- shouldDrawCotas: aBoolean aBoolean = drawCotas ifTrue: [^self]. "" drawCotas := aBoolean. title visible: aBoolean. xmax visible: aBoolean. xmid visible: aBoolean. xmin visible: aBoolean. ymax visible: aBoolean. ymid visible: aBoolean. ymin visible: aBoolean. "" self changed! ----- Method: AxesMorph>>shouldDrawGrid: (in category 'accessing') ----- shouldDrawGrid: aBoolean grid drawGrid: aBoolean. self changed! ----- Method: AxesMorph>>title: (in category 'accessing') ----- title:aString title contents: aString! ----- Method: AxesMorph>>updateCotas (in category 'drawing') ----- updateCotas | cotaColor | xmax isNil ifTrue: [^ self]. "" cotaColor := self cotaColor. title color: cotaColor. xmax color: cotaColor. xmid color: cotaColor. xmin color: cotaColor. ymax color: cotaColor. ymid color: cotaColor. ymin color: cotaColor. "" xmax contents: (xAxisFormatter value: self maxPoint x). xmid contents: (xAxisFormatter value: self maxPoint x + self minPoint x / 2). xmin contents: (xAxisFormatter value: self minPoint x). ymax contents: (yAxisFormatter value: self maxPoint y). ymid contents: (yAxisFormatter value: self maxPoint y + self minPoint y / 2). ymin contents: (yAxisFormatter value: self minPoint y). "" title position: self topLeft + ((self width - title width / 2) rounded @ 0) + (0 @ self borderWidth). "" xmax position: self topLeft + (self width - xmax width @ (self height - xmax height)) - (margin @ self borderWidth). xmid position: self topLeft + ((self width - xmid width / 2) rounded @ (self height - xmid height)) - (0 @ self borderWidth). xmin position: self topLeft + (0 @ (self height - xmin height)) + (margin @ 0) - (0 @ self borderWidth). "" ymax position: self topLeft + ((0 - ymax width max: 0) @ 0) + (self borderWidth @ margin). ymid position: self topLeft + ((15 - ymid width max: 0) @ (self height - ymid height / 2) rounded) + (self borderWidth @ 0). ymin position: self topLeft + ((0 - ymin width max: 0) @ (self height - ymin height)) - (0 @ margin) + (self borderWidth @ 0)! ----- Method: AxesMorph>>updateForm (in category 'drawing') ----- updateForm self updateCotas. grid drawOn: form getCanvas.! ----- Method: AxesMorph>>worldPointToDataPoint: (in category 'utility') ----- worldPointToDataPoint: aPoint "Compute the pixel coordinates of the given data point wrt the World origin." ^ self gridPointToDataPoint: aPoint - self gridOrigin ! ----- Method: AxesMorph>>xAxisFormatter: (in category 'accessing') ----- xAxisFormatter: aFormatterBlock xAxisFormatter := aFormatterBlock. self updateCotas! ----- Method: AxesMorph>>yAxisFormatter: (in category 'accessing') ----- yAxisFormatter: aFormatterBlock yAxisFormatter := aFormatterBlock. self updateCotas! AxesMorph subclass: #PlotMorph instanceVariableNames: 'series cachedMaxPoint cachedMinPoint lens scaledPoints references processMouseDown balloonFormatter' classVariableNames: '' poolDictionaries: '' category: 'CogTools-VMProfiler'! !PlotMorph commentStamp: 'dgd 10/11/2003 21:12' prior: 0! I can draw many series of Points in a XY grid. See the methods testXXX in the class side. Samples: PlotMorph test. PlotMorph test2. PlotMorph test4. PlotMorph testWithReferences. ! ----- Method: PlotMorph class>>plotPoints: (in category 'instance creation') ----- plotPoints: aPointOrderedCollection | plotMorph | plotMorph := PlotMorph new. plotMorph color: Color black twiceLighter twiceLighter; title: 'Colors'; extent: 700 @ 300; useRoundedCorners; borderRaised. plotMorph series: #series color: Color white; series: #series drawLine: false. aPointOrderedCollection do: [:e | "" plotMorph series: #series addPoint: e]. plotMorph openInWorld. ^ plotMorph! ----- Method: PlotMorph class>>plotSeries: (in category 'instance creation') ----- plotSeries: aPointOrderedCollection | plotMorph | plotMorph := PlotMorph new. plotMorph color: Color gray lighter; title: 'Colors'; extent: 700 @ 300; useRoundedCorners; borderRaised. plotMorph series: #series color: Color red; series: #series drawLine: false. aPointOrderedCollection do: [:e | "" plotMorph series: #series addPoint: e]. plotMorph openInWorld. ^ plotMorph! ----- Method: PlotMorph class>>test (in category 'testing') ----- test " PlotMorph test " | pm | pm := PlotMorph new. pm color: (Color r: 0.0 g: 0.376 b: 0.317); extent: 320 @ 320; borderWidth: 2; useRoundedCorners; setBorderStyle: #raised; title: 'Some test functions'. pm series: #sin color: Color red; series: #cos color: Color blue; series: #test color: Color yellow. pm series: #sin drawArea: true; series: #cos drawArea: true; series: #test drawArea: true. pm series: #sin description: 'sin'; series: #cos description: 'cosin'; series: #test description: 'test'. pm series: #test type: #stepped. pm series: #sin width: 2; series: #sin drawLine: false. "" pm yAxisFormatter: [:y | (y roundTo: 0.1) asString]. "" 0 to: 360 by: 10 do: [:x | pm series: #sin addPoint: x @ x degreesToRadians sin. pm series: #cos addPoint: x @ x degreesToRadians cos. pm series: #test addPoint: x @ (x degreesToRadians cos + x degreesToRadians sin)]. "" pm openInWorld! ----- Method: PlotMorph class>>test2 (in category 'testing') ----- test2 " PlotMorph test2 " | pm sigmoid | pm := PlotMorph new. pm title: 'Sigmoid'; extent: 250 @ 250; color: Color black. "" pm series: #sigmoid1 color: Color red; series: #sigmoid1 drawPoints: false; series: #sigmoid2 color: Color blue; series: #sigmoid2 drawPoints: false; series: #sigmoid3 color: Color yellow; series: #sigmoid3 drawPoints: false; series: #sigmoid4 color: Color green; series: #sigmoid4 drawPoints: false; series: #sigmoid5 color: Color white; series: #sigmoid5 drawPoints: false. "" pm yAxisFormatter: [:y | (y roundTo: 0.1) asString]. sigmoid := [:x :slope | 1 / (1 + (slope * x) negated exp)]. -10 to: 10 by: 0.25 do: [:x | pm series: #sigmoid1 addPoint: x @ (sigmoid value: x value: 3). pm series: #sigmoid2 addPoint: x @ (sigmoid value: x value: 2). pm series: #sigmoid3 addPoint: x @ (sigmoid value: x value: 1). pm series: #sigmoid4 addPoint: x @ (sigmoid value: x value: 1 / 2). pm series: #sigmoid5 addPoint: x @ (sigmoid value: x value: 1 / 3)]. pm openInWorld! ----- Method: PlotMorph class>>test4 (in category 'testing') ----- test4 " PlotMorph test4 " | pm function | pm := PlotMorph new. pm color: (Color blue twiceDarker twiceDarker twiceDarker alpha: 0.3); extent: 300 @ 300; useRoundedCorners. pm xAxisFormatter: [:x | x rounded asStringWithCommas]. pm yAxisFormatter: [:y | y rounded asString]. pm title: 'Some funny function'. pm series: #test2 color: Color red; series: #test2 drawPoints: false. function := [:x | x degreesToRadians sin / 5 + ((x / 10) degreesToRadians cos + (x / 10) degreesToRadians sin) * 100]. 0 to: 3000 by: 5 do: [:x | pm series: #test2 addPoint: x @ (function value: x)]. pm openInWorld! ----- Method: PlotMorph class>>testWithReferences (in category 'testing') ----- testWithReferences " PlotMorph testWithReferences. " | pm ref | ref := AlignmentMorph newColumn. ref color: Color magenta twiceDarker twiceDarker; hResizing: #shrinkWrap; vResizing: #shrinkWrap; wrapCentering: #center; cellPositioning: #leftCenter. "" pm := PlotMorph new. pm references: ref. pm color: Color magenta twiceDarker twiceDarker; extent: 300 @ 300; borderWidth: 0; title: 'Some test functions'. pm series: #sin color: Color red; series: #cos color: Color blue; series: #test color: Color yellow. pm series: #sin drawArea: true; series: #cos drawArea: true; series: #test drawArea: true. pm series: #sin description: 'sin'; series: #cos description: 'cosin'; series: #test description: 'test'. pm series: #test type: #stepped. 0 to: 360 by: 10 do: [:x | pm series: #sin addPoint: x @ x degreesToRadians sin. pm series: #cos addPoint: x @ x degreesToRadians cos. pm series: #test addPoint: x @ (x degreesToRadians cos + x degreesToRadians sin)]. "" ref openInWorld. pm openInWorld! ----- Method: PlotMorph>>balloonFormatter: (in category 'accessing') ----- balloonFormatter: anObject balloonFormatter := anObject! ----- Method: PlotMorph>>changed (in category 'change reporting') ----- changed cachedMaxPoint := nil. cachedMinPoint := nil. super changed! ----- Method: PlotMorph>>clear (in category 'accessing') ----- clear series do:[:each | each clear]. self seriesChanged! ----- Method: PlotMorph>>exploreExtrasAt: (in category 'private') ----- exploreExtrasAt: nearPoint | extras | extras := (self scaledPoints at: nearPoint) collect: [:each | each extra]. extras := extras select: [:each | each notNil]. extras isEmpty ifFalse:[ extras explore]! ----- Method: PlotMorph>>findNearestPointTo: (in category 'private') ----- findNearestPointTo: targetPoint | nearestPoint | nearestPoint := nil. Cursor wait showWhile: ["" self scaledPoints keysDo: [:scaledPoint | "" (nearestPoint isNil or: [(targetPoint dist: scaledPoint) < (targetPoint dist: nearestPoint)]) ifTrue: [nearestPoint := scaledPoint]]]. ^ nearestPoint! ----- Method: PlotMorph>>handlesMouseDown: (in category 'event handling') ----- handlesMouseDown: evt ^ processMouseDown! ----- Method: PlotMorph>>initialize (in category 'initialization') ----- initialize super initialize. series := Dictionary new. processMouseDown := true. lens := nil. balloonFormatter := [:aCollection | self textForBalloon: aCollection]. self extent: 1 @ 1! ----- Method: PlotMorph>>initializeCotas (in category 'initialization') ----- initializeCotas "Don't put initial limits on the grid range... default is to compute them from series data." super initializeCotas. limitMinX := limitMaxX := limitMinY := limitMaxY := nil.! ----- Method: PlotMorph>>maxPoint (in category 'drawing') ----- maxPoint cachedMaxPoint ifNil: ["" limitMaxX notNil & limitMaxY notNil ifTrue: [cachedMaxPoint := limitMaxY @ limitMaxY] ifFalse: [| maxPoints | maxPoints := series collect: [:serie | serie maxPoint] thenSelect: [:point | point notNil]. cachedMaxPoint := maxPoints isEmpty ifTrue: [1 @ 1] ifFalse: [maxPoints max]. limitMaxX notNil ifTrue: [cachedMaxPoint := limitMaxX @ cachedMaxPoint y]. limitMaxY notNil ifTrue: [cachedMaxPoint := cachedMaxPoint x @ limitMaxY]]]. ^ cachedMaxPoint! ----- Method: PlotMorph>>minPoint (in category 'drawing') ----- minPoint cachedMinPoint ifNil: ["" limitMinX notNil & limitMinY notNil ifTrue: [cachedMinPoint := limitMinX @ limitMinY] ifFalse: [| minPoints | minPoints := series collect: [:serie | serie minPoint] thenSelect: [:point | point notNil]. cachedMinPoint := minPoints isEmpty ifTrue: [0 @ 0] ifFalse: [minPoints min]. limitMinX notNil ifTrue: [cachedMinPoint := limitMinX @ cachedMinPoint y]. limitMinY notNil ifTrue: [cachedMinPoint := cachedMinPoint x @ limitMinY]]]. ^ cachedMinPoint! ----- Method: PlotMorph>>mouseDown: (in category 'event handling') ----- mouseDown: anEvent | nearPoint | nearPoint := self findNearestPointTo: anEvent position - self topLeft - self borderWidth. nearPoint ifNotNil: [anEvent redButtonChanged ifTrue: [self showLensAt: nearPoint] ifFalse: [self exploreExtrasAt: nearPoint]]! ----- Method: PlotMorph>>mouseUp: (in category 'event handling') ----- mouseUp: anEvent lens isNil ifTrue:[^ self]. "" lens deleteBalloon. lens delete. lens := nil! ----- Method: PlotMorph>>processMouseDown: (in category 'accessing') ----- processMouseDown: aBoolean processMouseDown := aBoolean! ----- Method: PlotMorph>>references: (in category 'accessing') ----- references: aMorphOrNil "Specifies a morph (if not nil) that is updated with the names of the plotted series, displayed in the same color as the actual plot." references := aMorphOrNil! ----- Method: PlotMorph>>scalePoints (in category 'drawing') ----- scalePoints | | scaledPoints := nil. series do: [:serie | serie scaleTo: self drawBounds height: self height - (self borderWidth * 2) maxPoint: self maxPoint minPoint: self minPoint]! ----- Method: PlotMorph>>scaledPoints (in category 'drawing') ----- scaledPoints ^ scaledPoints ifNil: [scaledPoints := Dictionary new. series do: [:serie | serie points do: [:point | | allPoints | allPoints := scaledPoints at: point scaledPoint ifAbsentPut: [OrderedCollection new]. allPoints add: point]]. scaledPoints]! ----- Method: PlotMorph>>series (in category 'accessing') ----- series ^series! ----- Method: PlotMorph>>series: (in category 'series') ----- series: aSeriesOrSymbol "If aSeriesOrSymbol is a PlotSeries, simply answer it. Otherwise, it should be a string, and the returned value is the series with that name." ^ aSeriesOrSymbol isString ifTrue: [| symbol | symbol := aSeriesOrSymbol asSymbol. series at: symbol ifAbsentPut: [PlotSeries name: symbol]] ifFalse: [aSeriesOrSymbol]! ----- Method: PlotMorph>>series:addPoint: (in category 'series') ----- series: aSymbol addPoint: aPoint "Find the appropriate series and set a property in it." (self series: aSymbol) addPoint: aPoint. self changed! ----- Method: PlotMorph>>series:addPoint:extra: (in category 'series') ----- series: aSymbol addPoint: aPoint extra: anObject "Find the appropriate series and set a property in it." (self series: aSymbol) addPoint: aPoint extra: anObject. self changed ! ----- Method: PlotMorph>>series:color: (in category 'series') ----- series: aSymbol color: aColor "Find the appropriate series and set a property in it." (self series:aSymbol) color:aColor. self changed! ----- Method: PlotMorph>>series:description: (in category 'series') ----- series: aSymbol description: aString "Find the appropriate series and set a property in it." (self series: aSymbol) description: aString. self changed! ----- Method: PlotMorph>>series:drawArea: (in category 'series') ----- series: aSymbol drawArea: aBoolean "Find the appropriate series and set a property in it." (self series: aSymbol) drawArea: aBoolean. self changed! ----- Method: PlotMorph>>series:drawLine: (in category 'series') ----- series: aSymbol drawLine: aBoolean "Find the appropriate series and set a property in it." (self series: aSymbol) drawLine: aBoolean. self changed! ----- Method: PlotMorph>>series:drawPoints: (in category 'series') ----- series: aSymbol drawPoints: aBoolean "Find the appropriate series and set a property in it." (self series: aSymbol) drawPoints: aBoolean. self changed! ----- Method: PlotMorph>>series:type: (in category 'series') ----- series: seriesSymbol type: lineTypeSymbol "Find the appropriate series and set a property in it." (self series: seriesSymbol) type: lineTypeSymbol. self changed! ----- Method: PlotMorph>>series:width: (in category 'series') ----- series: aSymbol width: anInteger "Find the appropriate series and set a property in it." (self series: aSymbol) width: anInteger. self changed! ----- Method: PlotMorph>>seriesChanged (in category 'private') ----- seriesChanged cachedMaxPoint := nil. cachedMinPoint := nil. "If the morphs has no owner, then the morph is not open yet" owner isNil ifTrue:[^ self]. "" self changed. self updateCotas! ----- Method: PlotMorph>>showLensAt: (in category 'private') ----- showLensAt: nearPoint lens := EllipseMorph new. lens color: (Color red alpha: 0.5). lens extent: 7 @ 7. self addMorph: lens. lens position: self topLeft + nearPoint - (3 @ 3) + self borderWidth. lens showBalloon: (balloonFormatter value: (self scaledPoints at: nearPoint))! ----- Method: PlotMorph>>textForBalloon: (in category 'private') ----- textForBalloon: aCollection | stream point | point := aCollection anyOne. stream := String new writeStream. stream nextPutAll: (xAxisFormatter value: point x); nextPutAll: ' '; nextPutAll: (yAxisFormatter value: point y); nextPut: Character cr. aCollection do: [:each | stream nextPutAll: each series name. each extra ifNotNil: [stream nextPutAll: ': '; print: each extra]] separatedBy: [stream nextPut: Character cr]. ^ stream contents! ----- Method: PlotMorph>>updateForm (in category 'drawing') ----- updateForm "Override superclass implementation to do drawing of data." | canvas | self updateReferences. self updateCotas. self scalePoints. canvas := form getCanvas. grid drawOn: canvas. (series values asSortedCollection: [:x :y | x name <= y name]) do: [:serie | serie drawOn: canvas]. ! ----- Method: PlotMorph>>updateReferences (in category 'drawing') ----- updateReferences "Update a 'legend' displaying the description of each plotted series in the same color as that series." | seriesWithDescription sortedSeried | references isNil ifTrue: [^ self]. "" references removeAllMorphs. "" seriesWithDescription := series reject: [:each | each description isEmpty]. sortedSeried := seriesWithDescription asSortedCollection: [:x :y | x description asLowercase <= y description asLowercase]. sortedSeried do: [:serie | | ref | ref := StringMorph new. ref contents: serie description. ref color: serie color. references addMorphBack: ref. serie]! PlotMorph subclass: #VMProfilePlotMorph instanceVariableNames: 'alternateSeries selectionStart selectionStop oldSelectionRectangle model cachedAlternateMaxPoint cachedAlternateMinPoint aymax aymid aymin' classVariableNames: '' poolDictionaries: '' category: 'CogTools-VMProfiler'! ----- Method: VMProfilePlotMorph class>>LICENSE (in category 'LICENSE') ----- LICENSE ^'Project Squeak Copyright (c) 2005-2013, 3D Immersive Collaboration Consulting, LLC., All Rights Reserved Redistributions in source code form must reproduce the above copyright and this condition. Licensed under MIT License (MIT) Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.'! ----- Method: VMProfilePlotMorph class>>model: (in category 'instance creation') ----- model: aProfiler ^self new model: aProfiler; yourself! ----- Method: VMProfilePlotMorph>>alternateMaxPoint (in category 'drawing') ----- alternateMaxPoint cachedAlternateMaxPoint ifNil: [| maxPoints | maxPoints := alternateSeries collect: [:serie | serie maxPoint] thenSelect: [:point | point notNil]. cachedAlternateMaxPoint := maxPoints isEmpty ifTrue: [1 @ 1] ifFalse: [maxPoints max]]. ^cachedAlternateMaxPoint! ----- Method: VMProfilePlotMorph>>alternateMinPoint (in category 'drawing') ----- alternateMinPoint cachedAlternateMinPoint ifNil: [| minPoints | minPoints := alternateSeries collect: [:serie | serie minPoint] thenSelect: [:point | point notNil]. cachedAlternateMinPoint := minPoints isEmpty ifTrue: [1 @ 1] ifFalse: [minPoints min]]. ^cachedAlternateMinPoint! ----- Method: VMProfilePlotMorph>>alternateSeries: (in category 'series') ----- alternateSeries: aSeriesOrSymbol "If aSeriesOrSymbol is a PlotSeries, simply answer it. Otherwise, it should be a string, and the returned value is the series with that name." ^ aSeriesOrSymbol isString ifTrue: [| symbol | symbol := aSeriesOrSymbol asSymbol. alternateSeries at: symbol ifAbsentPut: [PlotSeries name: symbol]] ifFalse: [aSeriesOrSymbol]! ----- Method: VMProfilePlotMorph>>changed (in category 'change reporting') ----- changed cachedAlternateMaxPoint := cachedAlternateMinPoint := nil. super changed! ----- Method: VMProfilePlotMorph>>clear (in category 'accessing') ----- clear alternateSeries do:[:each | each clear]. super clear! ----- Method: VMProfilePlotMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas self selectionRectangle ifNotNil: [:selectionRectangle| aCanvas fillRectangle: selectionRectangle color: Color lightBlue]. super drawOn: aCanvas! ----- Method: VMProfilePlotMorph>>initialize (in category 'initialization') ----- initialize super initialize. alternateSeries := Dictionary new! ----- Method: VMProfilePlotMorph>>initializeCotas (in category 'initialization') ----- initializeCotas super initializeCotas. aymax := StringMorph contents: ''. aymid := StringMorph contents: ''. aymin := StringMorph contents: ''. self addMorph: aymax. self addMorph: aymid. self addMorph: aymin! ----- Method: VMProfilePlotMorph>>invalidateSelection (in category 'selection') ----- invalidateSelection self selectionRectangle ifNil: [oldSelectionRectangle ifNotNil: [self invalidRect: oldSelectionRectangle. oldSelectionRectangle := nil]] ifNotNil: [:selectionRectangle| self invalidRect: (oldSelectionRectangle ifNil: [selectionRectangle] ifNotNil: [oldSelectionRectangle merge: selectionRectangle]). oldSelectionRectangle := selectionRectangle]! ----- Method: VMProfilePlotMorph>>model (in category 'accessing') ----- model ^model! ----- Method: VMProfilePlotMorph>>model: (in category 'accessing') ----- model: anObject "Set my model and make me me a dependent of the given object." model ifNotNil: [model removeDependent: self]. anObject ifNotNil: [anObject addDependent: self]. model := anObject! ----- Method: VMProfilePlotMorph>>mouseDown: (in category 'event handling') ----- mouseDown: anEvent selectionStart := anEvent position x. self invalidateSelection! ----- Method: VMProfilePlotMorph>>mouseMove: (in category 'event handling') ----- mouseMove: anEvent selectionStop := anEvent position x. self invalidateSelection! ----- Method: VMProfilePlotMorph>>mouseUp: (in category 'event handling') ----- mouseUp: anEvent | selectionRect screenDrawBounds range | selectionRect := self selectionRectangle. screenDrawBounds := self bounds insetBy: margin. range := screenDrawBounds width asFloat. selectionStart := selectionStop := nil. self invalidateSelection. selectionRect ifNotNil: [model selectProportionFrom: ((selectionRect left - screenDrawBounds left) / range max: 0.0) to: ((selectionRect right - screenDrawBounds left) / range min: 1.0)]! ----- Method: VMProfilePlotMorph>>scalePoints (in category 'drawing') ----- scalePoints super scalePoints. alternateSeries do: [:serie | serie scaleTo: self drawBounds height: self height - (self borderWidth * 2) maxPoint: self alternateMaxPoint minPoint: self alternateMinPoint]! ----- Method: VMProfilePlotMorph>>selectionRectangle (in category 'selection') ----- selectionRectangle ^(selectionStart notNil and: [selectionStop notNil]) ifTrue: [| bounds | bounds := self bounds. ((selectionStart min: selectionStop) max: bounds left)@bounds top corner: ((selectionStart max: selectionStop) min: bounds right)@bounds bottom]! ----- Method: VMProfilePlotMorph>>seriesChanged (in category 'private') ----- seriesChanged cachedAlternateMaxPoint := cachedAlternateMinPoint := nil. super seriesChanged! ----- Method: VMProfilePlotMorph>>updateCotas (in category 'drawing') ----- updateCotas | cotaColor | super updateCotas. aymax isNil ifTrue: [^ self]. "" cotaColor := self cotaColor. aymax color: cotaColor. aymid color: cotaColor. aymin color: cotaColor. aymax contents: (yAxisFormatter value: self alternateMaxPoint y). aymid contents: (yAxisFormatter value: self alternateMaxPoint y + self alternateMinPoint y / 2). aymin contents: (yAxisFormatter value: self alternateMinPoint y). "" aymax position: self topRight - ((aymax width + self borderWidth) @ 0) + (0@self borderWidth). aymid position: self topRight - (aymid width + self borderWidth @ 0) + (0 @ (self height - aymid height / 2) rounded). aymin position: self topRight - (aymin width + self borderWidth @ 0) + (0 @ (self height - aymin height - margin - self borderWidth) rounded).! ----- Method: VMProfilePlotMorph>>updateForm (in category 'drawing') ----- updateForm | canvas | super updateForm. canvas := form getCanvas. (alternateSeries values asSortedCollection: [:x :y | x name <= y name]) do: [:serie | serie drawOn: canvas]. !

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev August 2013