'From Squeak3.1alpha of 7 March 2001 [latest update: #4332] on 16 September 2001 at 1:54:05 am'! "Change Set: CPUWatcher-nk Date: 14 March 2001 Author: Ned Konz CPUWatcher (a.k.a. PigWatcher) implements a simple runaway process monitoring tool that, when turned on, will suspend a process that is taking up too much of Squeak's time and allow user interaction. It watches for a Process that is taking more than 80% of the time; this threshold can be changed. Also, the ProcessBrowser now uses the CPUWatcher to display CPU percentages for all running processes. CPUWatcher startMonitoring. 'process period 20 seconds, sample rate 100 msec' CPUWatcher current monitorProcessPeriod: 10 sampleRate: 20. CPUWatcher current threshold: 0.5. 'change from 80% to 50%' CPUWatcher stopMonitoring. 22 March: Brought back display of the UI process; this had been removed in newer VM's by the nil-ing out of the active process suspendedContext field. 14 March: Added automatic starting of CPUWatcher when ProcessBrowser is started, if it's available. This will provide percentage numbers. If the ProcessBrowser starts the CPUWatcher, it will stop it on exit. Added CPUWatcher menu items to process list menu. Made CPUWatcher update time more accurate. Added percentage time display to ProcessBrowser. If a CPUWatcher is running, it will use its statistics. Also greatly reduced auto-update jerkiness in ProcessBrowser by using garbageCollectMost rather than garbageCollect. Well, it ignores UI pigs now. You can use the interrupt key for those. By the way, you can see the current tally using: CPUWatcher dumpTallyOnTranscript Note that the CPUWatcher may not catch processes with priorities at or above 6 (the priority of the IO process). (note: this also includes a couple of ProcessBrowser fixes: * suspended processes can now be debugged * suspended processes can have their priority changed) Also (earlier named CPUUsageTally-nk): Compute CPU usage using a 10-msec sample for (at least) the given number of seconds, then dump the usage statistics on the Transcript. The UI is free to continue, meanwhile. ProcessBrowser tallyCPUUsageFor: 10 "! Bag subclass: #IdentityBag instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Collections-Unordered'! Model subclass: #CPUWatcher instanceVariableNames: 'tally watcher threshold ' classVariableNames: 'CurrentCPUWatcher ' poolDictionaries: '' category: 'Tools-Process Browser'! !CPUWatcher commentStamp: '' prior: 0! CPUWatcher implements a simple runaway process monitoring tool that will suspend a process that is taking up too much of Squeak's time and allow user interaction. By default it watches for a Process that is taking more than 80% of the time; this threshold can be changed. CPUWatcher can also be used to show cpu percentages for each process from within the ProcessBrowser. CPUWatcher startMonitoring. "process period 20 seconds, sample rate 100 msec" CPUWatcher current monitorProcessPeriod: 10 sampleRate: 20. CPUWatcher current threshold: 0.5. "change from 80% to 50%" CPUWatcher stopMonitoring. ! Model subclass: #ProcessBrowser instanceVariableNames: 'selectedProcess selectedContext methodText processList processListIndex stackList stackListIndex sourceMap selectedClass selectedSelector searchString autoUpdateProcess deferredMessageRecipient lastUpdate startedCPUWatcher ' classVariableNames: 'SuspendedProcesses ' poolDictionaries: '' category: 'Tools-Process Browser'! !ProcessBrowser commentStamp: '' prior: 0! Change Set: ProcessBrowser Date: 14 March 2000 Author: Ned Konz email: ned@bike-nomad.com This is distributed under the Squeak License. Added 14 March: CPUWatcher integration automatically start and stop CPUWatcher added CPUWatcher to process list menu Added 29 October: MVC version 2.8, 2.7 compatibility rearranged menus added pointer inspection and chasing added suspend/resume recognized more well-known processes misc. bug fixes Added 26 October: highlight pc in source code Added 27 October: added 'signal semaphore' added 'inspect receiver', 'explore receiver', 'message tally' to stack list menu added 'find context', 'next context' to process list menu added 'change priority' and 'debug' choices to process list menu 27 October mods by Bob Arning: alters process display in Ned's ProcessBrowser to - show process priority - drop 'a Process in' that appears on each line - show in priority order - prettier names for known processes - fix to Utilities to forget update downloading process when it ends (1 less dead process) - correct stack dump for the active process ! !Bag class methodsFor: 'instance creation' stamp: 'nk 3/17/2001 09:52'! contentsClass ^Dictionary! ! !Bag class methodsFor: 'instance creation' stamp: 'nk 3/17/2001 09:52'! new: nElements ^ super new setContents: (self contentsClass new: nElements)! ! !Delay methodsFor: 'delaying' stamp: 'nk 3/14/2001 08:52'! isExpired ^delaySemaphore isSignaled. ! ! !IdentityBag class methodsFor: 'instance creation' stamp: 'nk 3/17/2001 09:53'! contentsClass ^IdentityDictionary! ! !CPUWatcher methodsFor: 'process operations' stamp: 'nk 3/8/2001 17:13'! debugProcess: aProcess | uiPriority oldPriority | uiPriority _ Processor activeProcess priority. aProcess priority >= uiPriority ifTrue: [ oldPriority _ ProcessBrowser setProcess: aProcess toPriority: uiPriority - 1 ]. ProcessBrowser debugProcess: aProcess.! ! !CPUWatcher methodsFor: 'process operations' stamp: 'nk 3/8/2001 17:27'! debugProcess: aProcess fromMenu: aMenuMorph aMenuMorph delete. self debugProcess: aProcess.! ! !CPUWatcher methodsFor: 'process operations' stamp: 'nk 3/8/2001 17:21'! resumeProcess: aProcess fromMenu: aMenuMorph aMenuMorph delete. ProcessBrowser resumeProcess: aProcess.! ! !CPUWatcher methodsFor: 'process operations' stamp: 'nk 3/8/2001 17:24'! terminateProcess: aProcess fromMenu: aMenuMorph aMenuMorph delete. ProcessBrowser terminateProcess: aProcess.! ! !CPUWatcher methodsFor: 'porcine capture' stamp: 'nk 3/8/2001 20:47'! catchThePig: aProcess | rules | "nickname, allow-stop, allow-debug" rules _ ProcessBrowser nameAndRulesFor: aProcess. (ProcessBrowser isUIProcess: aProcess) ifTrue: [ "aProcess debugWithTitle: 'Interrupted from the CPUWatcher'." ] ifFalse: [ rules second ifFalse: [ ^self ]. ProcessBrowser suspendProcess: aProcess. self openWindowForSuspendedProcess: aProcess ] ! ! !CPUWatcher methodsFor: 'porcine capture' stamp: 'nk 3/8/2001 16:05'! findThePig "tally has been updated. Look at it to see if there is a bad process. This runs at a very high priority, so make it fast" | countAndProcess | countAndProcess _ tally sortedCounts first. (countAndProcess key / tally size > self threshold) ifTrue: [ | proc | proc _ countAndProcess value. proc == Processor backgroundProcess ifTrue: [ ^self ]. "idle process? OK" self catchThePig: proc ]. ! ! !CPUWatcher methodsFor: 'porcine capture' stamp: 'nk 3/8/2001 18:34'! openMVCWindowForSuspendedProcess: aProcess ProcessBrowser new openAsMVC.! ! !CPUWatcher methodsFor: 'porcine capture' stamp: 'nk 3/8/2001 17:23'! openMorphicWindowForSuspendedProcess: aProcess | menu rules | menu _ MenuMorph new. "nickname allow-stop allow-debug" rules _ ProcessBrowser nameAndRulesFor: aProcess. menu add: 'Dismiss this menu' target: menu selector: #delete; addLine. menu add: 'Open Process Browser' target: ProcessBrowser selector: #open. menu add: 'Resume' target: self selector: #resumeProcess:fromMenu: argumentList: { aProcess . menu }. menu add: 'Terminate' target: self selector: #terminateProcess:fromMenu: argumentList: { aProcess . menu }. rules third ifTrue: [ menu add: 'Debug at a lower priority' target: self selector: #debugProcess:fromMenu: argumentList: { aProcess . menu }. ]. menu addTitle: aProcess identityHash asString, ' ', rules first, ' is taking too much time and has been suspended. What do you want to do with it?'. menu stayUp: true. menu popUpInWorld ! ! !CPUWatcher methodsFor: 'porcine capture' stamp: 'nk 3/8/2001 18:35'! openWindowForSuspendedProcess: aProcess Smalltalk isMorphic ifTrue: [ WorldState addDeferredUIMessage: [ self openMorphicWindowForSuspendedProcess: aProcess ] ] ifFalse: [ [ self openMVCWindowForSuspendedProcess: aProcess ] forkAt: Processor userSchedulingPriority ] ! ! !CPUWatcher methodsFor: 'startup-shutdown' stamp: 'nk 3/14/2001 08:39'! monitorProcessPeriod: secs sampleRate: msecs self stopMonitoring. watcher _ [ [ | promise | promise _ Processor tallyCPUUsageFor: secs every: msecs. tally _ promise value. promise _ nil. self findThePig. ] repeat ] forkAt: Processor highestPriority. Processor yield ! ! !CPUWatcher methodsFor: 'startup-shutdown' stamp: 'nk 3/14/2001 08:07'! startMonitoring self monitorProcessPeriod: 20 sampleRate: 100! ! !CPUWatcher methodsFor: 'startup-shutdown' stamp: 'nk 3/8/2001 16:24'! stopMonitoring watcher ifNotNil: [ ProcessBrowser terminateProcess: watcher. watcher _ nil. ]! ! !CPUWatcher methodsFor: 'accessing' stamp: 'nk 3/14/2001 07:56'! isMonitoring ^watcher notNil! ! !CPUWatcher methodsFor: 'accessing' stamp: 'nk 3/8/2001 18:36'! tally ^tally copy! ! !CPUWatcher methodsFor: 'accessing' stamp: 'nk 3/8/2001 18:49'! threshold "What fraction of the time can a process be the active process before we stop it?" ^threshold! ! !CPUWatcher methodsFor: 'accessing' stamp: 'nk 3/8/2001 18:38'! threshold: thresh "What fraction of the time can a process be the active process before we stop it?" threshold _ (thresh max: 0.02) min: 1.0! ! !CPUWatcher methodsFor: 'accessing' stamp: 'nk 3/14/2001 08:26'! watcherProcess ^watcher! ! !CPUWatcher class methodsFor: 'as yet unclassified' stamp: 'nk 3/8/2001 18:45'! current ^CurrentCPUWatcher ! ! !CPUWatcher class methodsFor: 'as yet unclassified' stamp: 'nk 3/14/2001 08:28'! currentWatcherProcess ^CurrentCPUWatcher ifNotNil: [ CurrentCPUWatcher watcherProcess ] ! ! !CPUWatcher class methodsFor: 'as yet unclassified' stamp: 'nk 3/8/2001 21:43'! dumpTallyOnTranscript self current ifNotNil: [ ProcessBrowser dumpTallyOnTranscript: self current tally ]! ! !CPUWatcher class methodsFor: 'as yet unclassified' stamp: 'nk 3/14/2001 08:06'! isMonitoring ^CurrentCPUWatcher notNil and: [ CurrentCPUWatcher isMonitoring ] ! ! !CPUWatcher class methodsFor: 'as yet unclassified' stamp: 'nk 3/14/2001 08:17'! startMonitoring "CPUWatcher startMonitoring" ^self startMonitoringPeriod: 20 rate: 100 threshold: 0.8! ! !CPUWatcher class methodsFor: 'as yet unclassified' stamp: 'nk 3/14/2001 08:16'! startMonitoringPeriod: pd rate: rt threshold: th "CPUWatcher startMonitoring" CurrentCPUWatcher ifNotNil: [ ^CurrentCPUWatcher startMonitoring. ]. CurrentCPUWatcher _ (self new) monitorProcessPeriod: pd sampleRate: rt; threshold: th; yourself. ^CurrentCPUWatcher ! ! !CPUWatcher class methodsFor: 'as yet unclassified' stamp: 'nk 3/14/2001 08:05'! stopMonitoring "CPUWatcher stopMonitoring" CurrentCPUWatcher ifNotNil: [ CurrentCPUWatcher stopMonitoring. ]. CurrentCPUWatcher _ nil. ! ! !ProcessBrowser methodsFor: 'initialize-release' stamp: 'nk 3/14/2001 09:24'! initialize methodText _ ''. stackListIndex _ 0. searchString _ ''. lastUpdate _ 0. startedCPUWatcher _ self startCPUWatcher. self updateProcessList; processListIndex: 1! ! !ProcessBrowser methodsFor: 'initialize-release' stamp: 'nk 3/14/2001 09:26'! startCPUWatcher "Answers whether I started the CPUWatcher" | pw | pw _ Smalltalk at: #CPUWatcher ifAbsent: [ ^self ]. pw ifNotNil: [ pw isMonitoring ifFalse: [ pw startMonitoringPeriod: 5 rate: 100 threshold: 0.85. self setUpdateCallbackAfter: 7. ^true ] ]. ^false ! ! !ProcessBrowser methodsFor: 'initialize-release' stamp: 'nk 3/14/2001 09:26'! stopCPUWatcher | pw | pw _ Smalltalk at: #CPUWatcher ifAbsent: [ ^self ]. pw ifNotNil: [ pw stopMonitoring. self updateProcessList. startedCPUWatcher _ false. "so a manual restart won't be killed later" ] ! ! !ProcessBrowser methodsFor: 'initialize-release' stamp: 'nk 3/14/2001 08:03'! windowIsClosing startedCPUWatcher ifTrue: [ CPUWatcher stopMonitoring ]! ! !ProcessBrowser methodsFor: 'process actions' stamp: 'nk 3/8/2001 17:02'! changePriority | str newPriority nameAndRules | nameAndRules _ self nameAndRulesForSelectedProcess. nameAndRules third ifFalse: [PopUpMenu inform: 'Nope, won''t change priority of ' , nameAndRules first. ^ self]. str _ FillInTheBlank request: 'New priority' initialAnswer: selectedProcess priority asString. newPriority _ str asNumber asInteger. newPriority ifNil: [^ self]. (newPriority < 1 or: [newPriority > Processor highestPriority]) ifTrue: [PopUpMenu inform: 'Bad priority'. ^ self]. self class setProcess: selectedProcess toPriority: newPriority. self updateProcessList! ! !ProcessBrowser methodsFor: 'process actions' stamp: 'nk 3/8/2001 16:37'! debugProcess | nameAndRules | nameAndRules _ self nameAndRulesForSelectedProcess. nameAndRules third ifFalse: [PopUpMenu inform: 'Nope, won''t debug ' , nameAndRules first. ^ self]. self class debugProcess: selectedProcess.! ! !ProcessBrowser methodsFor: 'process actions' stamp: 'nk 3/8/2001 13:35'! nameAndRulesFor: aProcess "Answer a nickname and two flags: allow-stop, and allow-debug" aProcess == autoUpdateProcess ifTrue: [ ^{'my auto-update process'. true. true} ]. ^self class nameAndRulesFor: aProcess ! ! !ProcessBrowser methodsFor: 'process actions' stamp: 'nk 3/8/2001 13:23'! resumeProcess selectedProcess ifNil: [^ self]. self class resumeProcess: selectedProcess. self updateProcessList! ! !ProcessBrowser methodsFor: 'process actions' stamp: 'nk 3/8/2001 13:21'! suspendProcess | nameAndRules | selectedProcess isSuspended ifTrue: [^ self]. nameAndRules _ self nameAndRulesForSelectedProcess. nameAndRules second ifFalse: [PopUpMenu inform: 'Nope, won''t suspend ' , nameAndRules first. ^ self]. self class suspendProcess: selectedProcess. self updateProcessList! ! !ProcessBrowser methodsFor: 'process actions' stamp: 'nk 3/8/2001 13:25'! terminateProcess | nameAndRules | nameAndRules _ self nameAndRulesForSelectedProcess. nameAndRules second ifFalse: [PopUpMenu inform: 'Nope, won''t kill ' , nameAndRules first. ^ self]. self class terminateProcess: selectedProcess. self updateProcessList! ! !ProcessBrowser methodsFor: 'process list' stamp: 'nk 3/14/2001 09:18'! processListMenu: menu | pw | selectedProcess ifNotNil: [| nameAndRules | nameAndRules _ self nameAndRulesForSelectedProcess. menu addList: {{'inspect (i)'. #inspectProcess}. {'explore (I)'. #exploreProcess}. {'inspect Pointers (P)'. #inspectPointers}}. (Smalltalk includesKey: #PointerFinder) ifTrue: [ menu add: 'chase pointers (c)' action: #chasePointers. ]. nameAndRules second ifTrue: [menu add: 'terminate (t)' action: #terminateProcess. selectedProcess isSuspended ifTrue: [menu add: 'resume (r)' action: #resumeProcess] ifFalse: [menu add: 'suspend (s)' action: #suspendProcess]]. nameAndRules third ifTrue: [menu addList: {{'change priority (p)'. #changePriority}. {'debug (d)'. #debugProcess}}]. menu addList: {{'profile messages (m)'. #messageTally}}. (selectedProcess suspendingList isKindOf: Semaphore) ifTrue: [menu add: 'signal Semaphore (S)' action: #signalSemaphore]. menu add: 'full stack (k)' action: #moreStack. menu addLine]. menu addList: {{'find context... (f)'. #findContext}. {'find again (g)'. #nextContext}}. menu addLine. menu add: (self isAutoUpdating ifTrue: ['turn off auto-update (a)'] ifFalse: ['turn on auto-update (a)']) action: #toggleAutoUpdate. menu add: 'update list (u)' action: #updateProcessList. pw _ Smalltalk at: #CPUWatcher ifAbsent: []. pw ifNotNil: [ menu addLine. pw isMonitoring ifTrue: [ menu add: 'stop CPUWatcher' target: self selector: #stopCPUWatcher ] ifFalse: [ menu add: 'start CPUWatcher' target: self selector: #startCPUWatcher ] ]. ^ menu! ! !ProcessBrowser methodsFor: 'process list' stamp: 'nk 3/14/2001 09:03'! processNameList "since processList is a WeakArray, we have to strengthen the result" | pw tally | pw _ Smalltalk at: #CPUWatcher ifAbsent: [ ]. tally _ pw ifNotNil: [ pw current ifNotNil: [ pw current tally ] ]. ^ processList asOrderedCollection collect: [:each | | percent | percent _ tally ifNotNil: [ ((((tally occurrencesOf: each) * 100.0 / tally size) roundTo: 1) asString padded: #left to: 2 with: $ ), '% ' ] ifNil: [ '' ]. percent, (self prettyNameForProcess: each) ] ! ! !ProcessBrowser methodsFor: 'process list' stamp: 'nk 3/22/2001 09:57'! updateProcessList | oldSelectedProcess newIndex now | now _ Time millisecondClockValue. now - lastUpdate < 500 ifTrue: [^ self]. "Don't update too fast" lastUpdate _ now. oldSelectedProcess _ selectedProcess. processList _ selectedProcess _ selectedSelector _ nil. Smalltalk garbageCollectMost. "lose defunct processes" processList _ Process allSubInstances reject: [:each | each suspendedContext isNil and: [ each ~~ Processor activeProcess ]]. processList _ processList sortBy: [:a :b | a priority >= b priority]. processList _ WeakArray withAll: processList. newIndex _ processList indexOf: oldSelectedProcess ifAbsent: [0]. self changed: #processNameList. self processListIndex: newIndex! ! !ProcessBrowser methodsFor: 'updating' stamp: 'nk 3/14/2001 09:08'! setUpdateCallbackAfter: seconds deferredMessageRecipient ifNotNil: [ | d | d _ Delay forSeconds: seconds. [ d wait. d _ nil. deferredMessageRecipient addDeferredUIMessage: [self updateProcessList] ] fork ]! ! !ProcessBrowser methodsFor: 'views' stamp: 'nk 3/14/2001 09:04'! openAsMVC "Create a pluggable version of me, answer a window" | window processListView stackListView methodTextView | window _ StandardSystemView new model: self controller: (deferredMessageRecipient _ DeferredActionStandardSystemController new). window borderWidth: 1. processListView _ PluggableListView on: self list: #processNameList selected: #processListIndex changeSelected: #processListIndex: menu: #processListMenu: keystroke: #processListKey:from:. processListView window: (0 @ 0 extent: 300 @ 200). window addSubView: processListView. stackListView _ PluggableListView on: self list: #stackNameList selected: #stackListIndex changeSelected: #stackListIndex: menu: #stackListMenu: keystroke: #stackListKey:from:. stackListView window: (300 @ 0 extent: 300 @ 200). window addSubView: stackListView toRightOf: processListView. methodTextView _ PluggableTextView on: self text: #selectedMethod accept: nil readSelection: nil menu: nil. methodTextView askBeforeDiscardingEdits: false. methodTextView window: (0 @ 200 corner: 600 @ 400). window addSubView: methodTextView below: processListView. window setUpdatablePanesFrom: #(#processNameList #stackNameList ). window label: 'Process Browser'. window minimumSize: 300 @ 200. window subViews do: [:each | each controller]. window controller open. startedCPUWatcher ifTrue: [ self setUpdateCallbackAfter: 7 ]. ^ window! ! !ProcessBrowser methodsFor: 'views' stamp: 'nk 3/14/2001 09:04'! openAsMorph "Create a pluggable version of me, answer a window" | window aTextMorph | window _ (SystemWindow labelled: 'later') model: self. deferredMessageRecipient _ WorldState. window addMorph: ((PluggableListMorph on: self list: #processNameList selected: #processListIndex changeSelected: #processListIndex: menu: #processListMenu: keystroke: #processListKey:from:) enableDragNDrop: false) frame: (0 @ 0 extent: 0.5 @ 0.5). window addMorph: ((PluggableListMorph on: self list: #stackNameList selected: #stackListIndex changeSelected: #stackListIndex: menu: #stackListMenu: keystroke: #stackListKey:from:) enableDragNDrop: false) frame: (0.5 @ 0.0 extent: 0.5 @ 0.5). aTextMorph _ PluggableTextMorph on: self text: #selectedMethod accept: nil readSelection: nil menu: nil. aTextMorph askBeforeDiscardingEdits: false. window addMorph: aTextMorph frame: (0 @ 0.5 corner: 1 @ 1). window setUpdatablePanesFrom: #(#processNameList #stackNameList ). (window setLabel: 'Process Browser') openInWorld. startedCPUWatcher ifTrue: [ self setUpdateCallbackAfter: 7 ]. ^ window! ! !ProcessBrowser class methodsFor: 'instance creation' stamp: 'nk 3/14/2001 07:53'! open "ProcessBrowser open" "Create and schedule a ProcessBrowser." Smalltalk garbageCollect. ^ Smalltalk isMorphic ifTrue: [ self new openAsMorph ] ifFalse: [ self new openAsMVC ]! ! !ProcessBrowser class methodsFor: 'process control' stamp: 'nk 3/8/2001 17:09'! debugProcess: aProcess self resumeProcess: aProcess. aProcess debugWithTitle: 'Interrupted from the Process Browser'. ! ! !ProcessBrowser class methodsFor: 'process control' stamp: 'nk 3/8/2001 20:11'! isUIProcess: aProcess ^aProcess == (Smalltalk isMorphic ifTrue: [ Project uiProcess ] ifFalse: [ ScheduledControllers activeControllerProcess ])! ! !ProcessBrowser class methodsFor: 'process control' stamp: 'nk 3/14/2001 08:37'! nameAndRulesFor: aProcess "Answer a nickname and two flags: allow-stop, and allow-debug" (aProcess priority = Processor timingPriority and: [aProcess suspendedContext receiver == Delay]) ifTrue: [^ {'the timer interrupt watcher'. false. false}]. ^ [ aProcess caseOf: { [] -> [{'no process'. false. false}]. [Smalltalk lowSpaceWatcherProcess] -> [{'the low space watcher'. false. false}]. [WeakArray runningFinalizationProcess] -> [{'the WeakArray finalization process'. false. false}]. [Processor activeProcess] -> [{'the UI process'. false. true}]. [Processor backgroundProcess] -> [{'the idle process'. false. false}]. [Sensor inputProcess] -> [{'the I/O process'. false. false}]. [Sensor interruptWatcherProcess] -> [{'the user interrupt watcher'. false. false}]. [Project uiProcess] -> [{'the inactive Morphic UI process'. false. false}]. [SoundPlayer playerProcess] -> [{'the Sound Player'. false. false}]. [ScheduledControllers ifNotNil: [ ScheduledControllers activeControllerProcess ] ] -> [{'the inactive MVC controller process'. false. true}]. [CPUWatcher currentWatcherProcess] -> [{'the CPUWatcher' . false . false}] } otherwise: [{aProcess suspendedContext asString. true. true}] ] ifError: [ :err :rcvr | {aProcess suspendedContext asString. true. true} ]! ! !ProcessBrowser class methodsFor: 'process control' stamp: 'nk 3/8/2001 13:23'! resumeProcess: aProcess | priority | priority _ self suspendedProcesses removeKey: aProcess ifAbsent: [aProcess priority]. aProcess priority: priority. aProcess resume. ! ! !ProcessBrowser class methodsFor: 'process control' stamp: 'nk 3/8/2001 17:07'! setProcess: aProcess toPriority: priority | oldPriority | oldPriority _ self suspendedProcesses at: aProcess ifAbsent: [ ]. oldPriority ifNotNil: [ self suspendedProcesses at: aProcess put: priority ]. aProcess priority: priority. ^oldPriority! ! !ProcessBrowser class methodsFor: 'process control' stamp: 'dew 9/16/2001 01:53'! suspendProcess: aProcess | priority | priority _ aProcess priority. self suspendedProcesses at: aProcess put: priority. "Need to take the priority down below the caller's so that it can keep control after signaling the Semaphore" (aProcess suspendingList isKindOf: Semaphore) ifTrue: [aProcess priority: Processor lowestPriority. aProcess suspendingList signal]. [aProcess suspend] on: Error do: [:ex | self suspendedProcesses removeKey: aProcess]. aProcess priority: priority. ! ! !ProcessBrowser class methodsFor: 'process control' stamp: 'nk 3/8/2001 13:25'! terminateProcess: aProcess aProcess ifNotNil: [ self suspendedProcesses removeKey: aProcess ifAbsent: []. aProcess terminate ]. ! ! !ProcessBrowser class methodsFor: 'process control' stamp: 'nk 3/8/2001 13:26'! wasProcessSuspendedByProcessBrowser: aProcess ^self suspendedProcesses includesKey: aProcess! ! !ProcessBrowser class methodsFor: 'CPU utilization' stamp: 'nk 3/14/2001 08:59'! dumpTallyOnTranscript: tally "tally is from ProcessorScheduler>>tallyCPUUsageFor: Dumps lines with percentage of time, hash of process, and a friendly name" tally sortedCounts do: [ :assoc | | procName | procName _ (self nameAndRulesFor: assoc value) first. Transcript print: (((assoc key / tally size) * 100.0) roundTo: 1); nextPutAll: '% '; print: assoc value identityHash; space; nextPutAll: procName; cr. ]. Transcript flush.! ! !ProcessBrowser class methodsFor: 'CPU utilization' stamp: 'nk 3/8/2001 12:49'! tallyCPUUsageFor: seconds "Compute CPU usage using a 10-msec sample for the given number of seconds, then dump the usage statistics on the Transcript. The UI is free to continue, meanwhile" "ProcessBrowser tallyCPUUsageFor: 10" ^self tallyCPUUsageFor: seconds every: 10! ! !ProcessBrowser class methodsFor: 'CPU utilization' stamp: 'nk 3/8/2001 18:29'! tallyCPUUsageFor: seconds every: msec "Compute CPU usage using a msec millisecond sample for the given number of seconds, then dump the usage statistics on the Transcript. The UI is free to continue, meanwhile" "ProcessBrowser tallyCPUUsageFor: 10 every: 100" | promise | promise _ Processor tallyCPUUsageFor: seconds every: msec. [ | tally | tally _ promise value. Smalltalk isMorphic ifTrue: [ WorldState addDeferredUIMessage: [ self dumpTallyOnTranscript: tally ] ] ifFalse: [ [ Transcript open ] forkAt: Processor userSchedulingPriority. [ (Delay forSeconds: 1) wait. self dumpTallyOnTranscript: tally ] forkAt: Processor userSchedulingPriority.] ] fork.! ! !ProcessorScheduler methodsFor: 'CPU usage tally' stamp: 'nk 3/8/2001 12:56'! nextReadyProcess quiescentProcessLists reverseDo: [ :list | list isEmpty ifFalse: [ | proc | proc _ list first. proc suspendedContext ifNotNil: [ ^proc ]]]. ^nil! ! !ProcessorScheduler methodsFor: 'CPU usage tally' stamp: 'nk 3/8/2001 12:48'! tallyCPUUsageFor: seconds "Start a high-priority process that will tally the next ready process for the given number of seconds. Answer a Block that will return the tally (a Bag) after the task is complete" ^self tallyCPUUsageFor: seconds every: 10 ! ! !ProcessorScheduler methodsFor: 'CPU usage tally' stamp: 'nk 3/17/2001 10:06'! tallyCPUUsageFor: seconds every: msec "Start a high-priority process that will tally the next ready process for the given number of seconds. Answer a Block that will return the tally (a Bag) after the task is complete" | tally sem delay endDelay | tally _ IdentityBag new: 200. delay _ Delay forMilliseconds: msec truncated. endDelay _ Delay forSeconds: seconds. endDelay schedule. sem _ Semaphore new. [ [ endDelay isExpired ] whileFalse: [ delay wait. tally add: Processor nextReadyProcess ]. sem signal. ] forkAt: self highestPriority. ^[ sem wait. tally ]! ! !ProcessBrowser class reorganize! ('instance creation' new open prototypicalToolWindow) ('process control' debugProcess: isUIProcess: nameAndRulesFor: resumeProcess: setProcess:toPriority: suspendProcess: suspendedProcesses terminateProcess: wasProcessSuspendedByProcessBrowser:) ('CPU utilization' dumpTallyOnTranscript: tallyCPUUsageFor: tallyCPUUsageFor:every:) ! !ProcessBrowser reorganize! ('accessing' processList processListIndex processListIndex: selectedMethod selectedSelector stackList stackListIndex stackListIndex: text) ('initialize-release' initialize startCPUWatcher stopCPUWatcher windowIsClosing) ('menus' selectedClass) ('message handling' perform:orSendTo:) ('process actions' changePriority chasePointers debugProcess inspectPointers nameAndRulesFor: nameAndRulesForSelectedProcess resumeProcess signalSemaphore suspendProcess terminateProcess wasProcessSuspendedByProcessBrowser:) ('process list' exploreProcess findContext inspectProcess nextContext notify:at:in: prettyNameForProcess: processListKey:from: processListMenu: processNameList updateProcessList) ('stack list' browseContext changeStackListTo: exploreContext exploreReceiver inspectContext inspectReceiver messageTally moreStack pcRange stackListMenu: stackNameList updateStackList updateStackList:) ('updating' isAutoUpdating setUpdateCallbackAfter: startAutoUpdate stopAutoUpdate toggleAutoUpdate) ('views' asPrototypeInWindow hasView openAsMVC openAsMorph stackListKey:from:) ! !CPUWatcher reorganize! ('process operations' debugProcess: debugProcess:fromMenu: resumeProcess:fromMenu: terminateProcess:fromMenu:) ('porcine capture' catchThePig: findThePig openMVCWindowForSuspendedProcess: openMorphicWindowForSuspendedProcess: openWindowForSuspendedProcess:) ('startup-shutdown' monitorProcessPeriod:sampleRate: startMonitoring stopMonitoring) ('accessing' isMonitoring tally threshold threshold: watcherProcess) !