"

 COPYRIGHT (c) 1993 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

StandardSystemView subclass:#ProcessMonitor

	 instanceVariableNames:'listView processes listUpdateDelay updateDelay 

				updateBlock listUpdateBlock updateProcess hideDead

				runColor suspendedColor waitColor cpuUsages'

	 classVariableNames:''

	 poolDictionaries:''

	 category:'Interface-Tools'

!

!ProcessMonitor class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1993 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

version

"

"

!

documentation

"

    This view shows smalltalks (light-weight) processes, and also offers

    a popup menu for various useful operations on them.

    Especially 'debug' is useful, to see what a process is currently

    doing.

    The information shown is:

	id         - the numeric id of the process

	name       - the name (if any) of the process

		     (the name has no semantic meaning; its for the processMonitor)

	state      - what is it doing;

			wait      - waiting on a semaphore

			eventWait - waiting on a view-event semaphore

			ioWait    - waiting on an io-semaphore

			timeWait  - waiting for a time-semaphore

			run       - run, but currently not scheduled

			active    - really running 

			suspended - suspended; not waiting on a semaphore

			light     - not yet started (i.e. has no stack yet)

	prio       - the processes priority (1..30)

	usedStack  - the current stack use

	totalStack - the stack currently allocated

"

! !

!ProcessMonitor class methodsFor:'defaults'!

defaultLabel

    ^ 'Process Monitor'

!

defaultIcon

    |i|

    i := Image fromFile:'bitmaps/ProcMon.xbm'.

    i notNil ifTrue:[^ i].

    ^ super defaultIcon

! !

!ProcessMonitor methodsFor:'initialization'!

initialize

    |v menu|

    super initialize.

    hideDead := true.

    self extent:(font widthOf:'name/id                       state     prio   usedStack  maxStack')

		+ 40 @

		100.

    v := ScrollableView for:SelectionInListView in:self.

    v origin:0.0@0.0 corner:1.0@1.0.

    listView := v scrolledView.

    listView font:font.

    menu := (PopUpMenu 

		labels:#(

"/ hideDead functionality no longer needed; 

"/ since ProcSched knownProcesses only returns living ones

"/

"/                         '\c hide dead'

"/                         '-'

			 'inspect' 

			 'debug'  

			 '-'  

			 'resume'  

			 'suspend'  

			 'terminate'

			 '-'  

			 'raise prio'  

			 'lower prio'  

			)

	     selectors:#(

"/                         hideDead:

"/                         nil

			 inspectProcess  

			 debugProcess  

			 nil  

			 resumeProcess  

			 suspendProcess  

			 terminateProcess

			 nil  

			 raisePrio

			 lowerPrio

			)

		receiver:self

		     for:listView).

"/    menu checkToggleAt:#hideDead: put:hideDead.

    listView middleButtonMenu:menu. 

    listView multipleSelectOk:true.

    listView keyboardHandler:self.

    updateDelay := 0.5.

    listUpdateDelay := 5.

    "/ true 

    ProcessorScheduler isPureEventDriven

    ifTrue:[

	updateBlock := [self updateStatus].

	listUpdateBlock := [self updateList].

    ].

    device hasColors ifTrue:[

	runColor := Color green.

	suspendedColor := Color yellow.

	waitColor := Color red.

    ] ifFalse:[

	runColor := suspendedColor := waitColor := Color black

    ]

    "

     ProcessMonitor open

    "

!

realize

    super realize.

    updateBlock notNil ifTrue:[

	Processor addTimedBlock:updateBlock afterSeconds:updateDelay.

	Processor addTimedBlock:listUpdateBlock afterSeconds:listUpdateDelay.

    ] ifFalse:[

	updateProcess := [

	    |id cnt|

	    "

	     every 20ms, we look which process runs;

	     every half second, the status is updated.

	     every 5 seconds, the list of processes is

	     built up again

	    "

	    [true] whileTrue:[

		1 to:9 do:[:i |

"/                    cpuUsages := IdentityDictionary new.

"/                    1 to:25 do:[:i |

"/                        (Delay forSeconds:0.02) wait.

"/                        id := Processor interruptedProcess id.

"/                        cnt := cpuUsages at:id ifAbsent:[0].

"/                        cpuUsages at:id put:cnt + 1.

"/                    ].

		    (Delay forSeconds:0.5) wait.

		    self updateStatus.

		].

		(Delay forSeconds:0.5) wait.

		self updateList.

	    ]

	]  forkAt:(Processor userSchedulingPriority + 1).

	updateProcess name:'process update'.

	"

	 raise my own priority

	"

	Processor activeProcess priority:(Processor userSchedulingPriority + 2)

    ].

    waitColor := waitColor on:device.

    runColor := runColor on:device.

    suspendedColor := suspendedColor on:device.

!

mapped

    super mapped.

    self updateStatus.

    self updateList.

! !

!ProcessMonitor methodsFor:'destroying'!

destroy

    updateBlock notNil ifTrue:[

	Processor removeTimedBlock:updateBlock.

	Processor removeTimedBlock:listUpdateBlock.

    ] ifFalse:[

	updateProcess terminate

    ].

    super destroy

! !

!ProcessMonitor methodsFor:'private'!

selectedProcessesDo:aBlock

    |p nr sel|

    sel := listView selection.

    sel isNil ifTrue:[^ self].

    (sel isKindOf:Collection) ifTrue:[

	sel do:[:n |

	    nr := n - 2.   "for headlines"

	    nr notNil ifTrue:[

		nr > 0 ifTrue:[

		    p := processes at:nr.

		    p notNil ifTrue:[

		       aBlock value:p

		    ]

		]

	    ]

	]

    ] ifFalse:[

	nr := sel - 2.     "for headlines"

	nr notNil ifTrue:[

	    nr > 0 ifTrue:[

		p := processes at:nr.

		p notNil ifTrue:[

		   aBlock value:p

		]

	    ]

	]

    ].

! !

!ProcessMonitor methodsFor:'menu actions'!

hideDead:aBoolean

    hideDead := aBoolean

!

debugProcess

    self selectedProcessesDo:[:p |

       Debugger openOn:p

    ]

! 

inspectProcess

    self selectedProcessesDo:[:p |

       p inspect

    ]

! 

terminateProcess

    self selectedProcessesDo:[:p |

       p terminate

    ]

! 

resumeProcess

    self selectedProcessesDo:[:p |

       p resume

    ]

! 

suspendProcess

    self selectedProcessesDo:[:p |

       p suspend

    ]

! 

raisePrio

    self selectedProcessesDo:[:p |

       p priority:(p priority + 1)

    ]

! 

lowerPrio

    self selectedProcessesDo:[:p |

       p priority:(p priority - 1)

    ]

! !

!ProcessMonitor methodsFor:'events'!

canHandle:key

    ^ key == #InspectIt

!

keyPress:key x:x y:y

    key == #InspectIt ifTrue:[

	^ self inspectProcess.

    ].

    ^ super keyPress:key x:x y:y

! !

!ProcessMonitor methodsFor:'drawing'!

updateList

    "update list of processes"

    |newList|

    shown ifTrue:[

	(Smalltalk at:#SystemDebugging ifAbsent:[false]) ifTrue:[

	    newList := Process allInstances.

	] ifFalse:[

	    newList := ProcessorScheduler knownProcesses asOrderedCollection.

	].

	"sort by id - take care of nil ids of dead processes"

	newList sort:[:p1 :p2 |

			 |id1 id2|

			 (p1 isNil or:[(id1 := p1 id) isNil])

			     ifTrue:[true]

			     ifFalse:[

				 (p2 isNil or:[(id2 := p2 id) isNil])

				     ifTrue:[false]

				     ifFalse:[id1 < id2]

			 ]

		     ].

	newList ~= processes ifTrue:[

	    processes := WeakArray withAll:newList.

	    self updateStatus

	].

    ].

    updateBlock notNil ifTrue:[

	Processor addTimedBlock:listUpdateBlock afterSeconds:listUpdateDelay

    ].

!

updateStatus

    "update status display of processes"

    |oldList list line dIndex con interrupted|

    shown ifTrue:[

	oldList := listView list.

	processes notNil ifTrue:[

	    list := OrderedCollection new.

"/            list add:'id   name                         cpu state    prio   usedStack  totalStack'.

	    list add:'id   name                           state    prio   usedStack  totalStack'.

	    list add:'--------------------------------------------------------------------------'.

	    interrupted := Processor interruptedProcess.

	    dIndex := 1.

	    1 to:processes size do:[:index |

		|aProcess nm st c n|

		aProcess := processes at:index.

		aProcess notNil ifTrue:[

		    (aProcess id notNil or:[hideDead not]) ifTrue:[

			line := aProcess id printStringPaddedTo:5.

			(nm := aProcess name) isNil ifFalse:[

			    nm := nm printString

			] ifTrue:[

			    nm := ' '

			].

			nm size >= 29 ifTrue:[

			    nm := (nm contractTo:28) , ' '

			] ifFalse:[

			    nm := (nm printStringPaddedTo:29).

			].

			line := line , nm.

"/                        n := cpuUsages at:(aProcess id) ifAbsent:[0].

"/                        n ~~ 0 ifTrue:[

"/                            line := line , ((n * 4) printStringLeftPaddedTo:3)

"/                        ] ifFalse:[

"/                            line := line , '   '

"/                        ].

			st := aProcess state.

			(st == #run

			 and:[aProcess == interrupted]) ifTrue:[

			    c := ' *'.

			] ifFalse:[

			    c := '  '.

			].

			line := line , c , (st printStringPaddedTo:9).

			line := line , (aProcess priority printStringLeftPaddedTo:3).

			line := line , (aProcess usedStackSize printStringLeftPaddedTo:11).

			line := line , (aProcess totalStackSize printStringLeftPaddedTo:10).

			line := line , '(' , aProcess numberOfStackSegments printString , ')'.

			(Smalltalk at:#SystemDebugging ifAbsent:[false]) ifTrue:[

			    con := aProcess suspendedContext.

			    con isNil ifTrue:[

				aProcess == Processor activeProcess ifTrue:[

				    con := thisContext

				]

			    ].

			    con notNil ifTrue:[

				line := line , '    '.

				line := line , ((ObjectMemory addressOf:con) printStringRadix:16).

				line := line , ' .. '.

				[con sender notNil] whileTrue:[

				    con := con sender

				].

				line := line , ((ObjectMemory addressOf:con) printStringRadix:16).

			    ]

			].

			list add:line.

			processes at:dIndex put:aProcess.

			dIndex := dIndex + 1

		    ]

		].

	    ].

	    dIndex to:processes size do:[:index |

		processes at:index put:nil

	    ]

	].

	list ~= oldList ifTrue:[

	    "avoid flicker"

		list keysAndValuesDo:[:idx :entry |

		    (oldList at:idx) ~= entry ifTrue:[

			listView at:idx put:entry

		    ]

		]

	    ] ifFalse:[

		listView setList:list.

		"the first two entries cannot be selected"

		listView attributeAt:1 put:#disabled.

		listView attributeAt:2 put:#disabled.

	    ]

	].

    ].

    updateBlock notNil ifTrue:[

	Processor addTimedBlock:updateBlock afterSeconds:updateDelay

    ]

! !