"

 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.

"

SimpleView subclass:#ProcessMonitor

	instanceVariableNames:'listView processes listUpdateDelay updateDelay updateBlock

		listUpdateBlock updateProcess hideDead runColor suspendedColor

		waitColor cpuUsages showDetail'

	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.

"

!

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; it exists for the processMonitor only)

	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 (this info is useless, since at

				    update time, its always the update process which is

				    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 (i.e. the maximum ever needed)

"

! !

!ProcessMonitor class methodsFor:'defaults'!

defaultIcon

    |i|

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

    i notNil ifTrue:[^ i].

    ^ StandardSystemView defaultIcon

!

defaultLabel

    ^ 'Process Monitor'

! !

!ProcessMonitor class methodsFor:'startup'!

open

    |top monitor|

    top := StandardSystemView new.

    monitor := self origin:0.0@0.0 corner:1.0@1.0 in:top.

    top extent:monitor preferredExtent.

    top label:self defaultLabel.

    top icon:self defaultIcon.

    top open

    "

     ProcessMonitor open

    "

! !

!ProcessMonitor methodsFor:'destroying'!

destroy

    updateBlock notNil ifTrue:[

	Processor removeTimedBlock:updateBlock.

	Processor removeTimedBlock:listUpdateBlock.

    ] ifFalse:[

	updateProcess notNil ifTrue:[updateProcess terminate]

    ].

    super destroy

! !

!ProcessMonitor methodsFor:'drawing'!

titleLine

    showDetail ifTrue:[

    ^ 'id  group  name                           state    prio usedStack    totalStack  current-segment      switch  where'.

    ].

    ^ 'id  group name                           state    prio usedStack  where'.

    "Modified: 3.7.1996 / 13:57:38 / stefan"

    "Modified: 24.7.1996 / 17:21:15 / cg"

!

updateList

    "update list of processes"

    |newList|

    shown ifTrue:[

        showDetail ifTrue:[

            newList := Process allInstances asOrderedCollection.

        ] 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 removeTimedBlock:listUpdateBlock.

        Processor addTimedBlock:listUpdateBlock afterSeconds:listUpdateDelay

    ].

    "Modified: 3.7.1996 / 13:37:29 / stefan"

!

updateStatus

    "update status display of processes"

    |oldList list line dIndex interrupted  

     aProcess nm st n found running sel space|

    space := Character space.

    shown ifTrue:[

        oldList := listView list.

        processes notNil ifTrue:[

            list := OrderedCollection new:(processes size + 2).

            list add:self titleLine.

            list add:(String new:self titleLine size withAll:$-).

            interrupted := Processor interruptedProcess.

            dIndex := 1.

            1 to:processes size do:[:index |

                |con c totalStack sender id gId|

                aProcess := processes at:index.

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

                        line := WriteStream on:(String new:200).

                        id printOn:line paddedTo:5.

                        gId := aProcess processGroupId.

                        gId == id ifTrue:[

                            "/ a group leader

                            '-    ' printOn:line.

                        ] ifFalse:[

                            gId printOn:line paddedTo:5.

                        ].

                        (nm := aProcess name) isNil ifFalse:[

                            nm := nm printStringPaddedTo:28.

                            nm size >= 29 ifTrue:[

                                nm := (nm contractTo:28).

                            ].

                            line nextPutAll:nm; nextPut:space.

                        ] ifTrue:[

                            line next:29 put:space.

                        ].

"/                        n := cpuUsages at:(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 := ' *'.

                            running := true.

                        ] ifFalse:[

                            c := '  '.

                            running := false.

                        ].

                        line nextPutAll:c; nextPutAll:(st printStringPaddedTo:9).

                        line nextPutAll:(aProcess priority printStringLeftPaddedTo:3).

                        line nextPutAll:(aProcess usedStackSize printStringLeftPaddedTo:11).

                        con := aProcess suspendedContext.

                        con isNil ifTrue:[

                            aProcess == Processor activeProcess ifTrue:[

                                con := thisContext

                            ]

                        ].

                        showDetail ifTrue:[

                            id == 0 ifTrue:[

                                line nextPutAll:('unlimited' leftPaddedTo:13).

                            ] ifFalse:[

                                n := aProcess numberOfStackSegments.

                                line nextPutAll:(aProcess totalStackSize printStringLeftPaddedTo:10).

                                line nextPut:$( ; nextPutAll:n printString; nextPut:$).

                            ].

                            con notNil ifTrue:[

                                line nextPutAll:'    '.

                                line nextPutAll:(((ObjectMemory addressOf:con) printStringRadix:16) leftPaddedTo:8 with:$0).

                                line nextPutAll:' .. '.

                                c := con.

                                [(sender := c sender) notNil] whileTrue:[

                                    c := sender

                                ].

                                line nextPutAll:(((ObjectMemory addressOf:c) printStringRadix:16) leftPaddedTo:8 with:$0).

                            ] ifFalse:[

                                line next:20 put:space.

                            ].

                            line nextPut:space.

                            line nextPutAll:(aProcess numberOfStackBoundaryHits printStringLeftPaddedTo:6).

                        ].

                        con notNil ifTrue:[

                            c := con.

                            found := false.

                            running ifFalse:[

                                "/ search for a semaphore-wait in the top 10 contexts

                                1 to:10 do:[:n |

                                    found ifFalse:[

                                        c notNil ifTrue:[

                                            (c receiver class == Semaphore) ifTrue:[

                                                c selector == #wait ifTrue:[

                                                    found := true.

                                                ]

                                            ].

                                            c := c sender.

                                        ]

                                    ]

                                ].

                            ].    

                            found ifFalse:[

                                "/ search for a non-processor receiver in the top 10 contexts

                                c := con.

                                1 to:10 do:[:n |

                                    |r|

                                    found ifFalse:[

                                        c notNil ifTrue:[

                                            ((r := c receiver) ~~ Processor 

                                             and:[r class ~~ Process]) ifTrue:[

                                                found := true.

                                            ] ifFalse:[

                                                c := c sender.

                                            ]

                                        ]

                                    ]

                                ]

                            ].

                            found ifFalse:[

                                c := con

                            ].

                            [c notNil and:[c isBlockContext]] whileTrue:[

                                c := c home

                            ].

                            c notNil ifTrue:[

                                sel := c selector.

                                sel isNil ifTrue:[

                                    sel := '* unknown *'

                                ].

                                line nextPutAll:'  '.

                                line nextPutAll:c receiver class name.

                                line nextPutAll:'>>'; nextPutAll:sel.

                            ]

                        ].

                        list add:line contents.

                        processes at:dIndex put:aProcess.

                        dIndex := dIndex + 1

                    ]

                ].

            ].

            dIndex to:processes size do:[:index |

                processes at:index put:nil

            ]

        ].

        "avoid flicker"

        (oldList notNil and:[oldList size == list size]) ifTrue:[

            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.

        ].

        listView flush

    ].

    updateBlock notNil ifTrue:[

        Processor removeTimedBlock:updateBlock.

        Processor addTimedBlock:updateBlock afterSeconds:updateDelay

    ]

    "Modified: 3.7.1996 / 13:56:01 / stefan"

    "Modified: 18.7.1996 / 20:19:59 / cg"

!

updateView

    self updateList.

    self updateStatus

! !

!ProcessMonitor methodsFor:'events'!

canHandle:key

    ^ key == #InspectIt

!

keyPress:key x:x y:y

    <resource: #keyboard ( #InspectIt ) >

    key == #InspectIt ifTrue:[

	^ self inspectProcess.

    ].

    ^ super keyPress:key x:x y:y

! !

!ProcessMonitor methodsFor:'initialization'!

initialize

    |v|

    super initialize.

    hideDead := true.

    showDetail := Smalltalk at:#SystemDebugging ifAbsent:false.

    v := HVScrollableView for:SelectionInListView miniScrollerH:true in:self.

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

"/    self extent:(font widthOf:self titleLine) + v scrollBar width @ 100.

    listView := v scrolledView.

    listView font:font.

    listView menuHolder:self; menuPerformer:self; menuMessage:#processMenu. 

    listView multipleSelectOk:true.

    listView delegate:(KeyboardForwarder toView:self).

    listView doubleClickAction:[:line | self debugProcess].

    updateDelay := 0.5.

    listUpdateDelay := 5.

    "/ event mode is no longer used;

    "/ this event support may vanish

    Processor 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

    "

    "Modified: 13.4.1996 / 20:34:25 / cg"

!

mapped

    super mapped.

    self updateStatus.

    self updateList.

!

realize

    super realize.

    waitColor := waitColor on:device.

    runColor := runColor on:device.

    suspendedColor := suspendedColor on:device.

    self startUpdateProcess.

!

reinitialize

    updateProcess := nil.

    super reinitialize.

    self startUpdateProcess.

    "Created: 22.12.1995 / 22:48:37 / cg"

    "Modified: 22.12.1995 / 22:51:14 / cg"

!

startUpdateProcess

    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 waitForSeconds:0.5.

                        self updateStatus.

                    ].

                    Delay waitForSeconds:0.5.

                    self updateList.

                ]

            ] valueOnUnwindDo:[

                updateProcess := nil

            ]

        ]  forkAt:(Processor userSchedulingPriority + 1).

        updateProcess name:'monitor [' , 

                           Processor activeProcess id printString ,

                           '] update'.

        "

         raise my own priority

        "

        Processor activeProcess priority:(Processor userSchedulingPriority + 2)

    ].

    "Modified: 12.6.1996 / 19:53:13 / cg"

! !

!ProcessMonitor methodsFor:'menu actions'!

abortProcess

    "abort (raise AbortSignal in) the selected process"

    self selectedProcessesDo:[:p |