'10/3/99 3:17:37 am'! '# # This file is encoded in (so called) SHIFT-JIS, # line delimitor is CR. # Scavenge Observer Goodies for VisualWorks 2.5, VisualWorks Non-Commercial 3.0a Copyleft 1999 NISHIHARA Satoshi Broken English description This goodies contains Mr. AOKI''s "Memory Observer". Memory Observer Goodies for VisualWorks 2.5 and VisualWorks 3.0 Copyright (C) 1995-1999 AOKI Atsushi 1999/02/28 http://www.sra.co.jp/people/aoki/SmalltalkGoodies/VisualWorks/MemoryObserver.st http://www.sra.co.jp/people/aoki/SmalltalkGoodies/VisualWorks/MemoryObserver.txt Summary: This goodies watches ObjectMemory''s scavenging as a polygon graph. This has simple GUI and you can modify the delay time and priority of watching process. Please evaluate below; "ScavengeObserver open" How to install: FileIn this goodies and makes a classes "ScavengeObserver" etc, in a category "Goodies-MemoryObserver". How to use: same as Memory Observer. And some menu items are added. ---------------------------------------------------------- 西原聡士 (NISHIHARA Satoshi) e-mail: mailto:nishis@zephyr.dti.ne.jp URL: http://www.zephyr.dti.ne.jp/~nishis/ ---------------------------------------------------------- '! SequenceableCollection subclass: #ScavengeObserverList instanceVariableNames: 'count max list limit ' classVariableNames: '' poolDictionaries: '' category: 'Goodies-MemoryObserver'! View subclass: #ScavengeObserverView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Goodies-MemoryObserver'! View subclass: #MemoryObserverView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Goodies-MemoryObserver'! ApplicationModel subclass: #MemoryObserver instanceVariableNames: 'dataEden dataSurvivorSpace dataLargeSpace dataOldSpace dataPermSpace dataTotal memoryObserverState memoryObserverProcess ' classVariableNames: '' poolDictionaries: '' category: 'Goodies-MemoryObserver'! MemoryObserver subclass: #ScavengeObserver instanceVariableNames: 'dataScavenge scavengeCount scavengeList delay priority ' classVariableNames: '' poolDictionaries: '' category: 'Goodies-MemoryObserver'! SequenceableCollection subclass: #ScavengeObserverList instanceVariableNames: 'count max list limit ' classVariableNames: '' poolDictionaries: '' category: 'Goodies-MemoryObserver'! !ScavengeObserverList methodsFor: 'initialize-release'! release max := nil. count := nil! ! !ScavengeObserverList methodsFor: 'accessing'! count ^count! list ^list! max ^max! size ^list size! ! !ScavengeObserverList methodsFor: 'adding'! add: aNumber max value: (max value max: aNumber). self size <= limit ifFalse: [list removeFirst]. list add: aNumber. count value: aNumber. self changed: #add: with: aNumber. ^aNumber! ! !ScavengeObserverList methodsFor: 'printing'! printOn: aStream aStream position + self maxPrint. aStream print: self class; nextPutAll: ' ('. aStream cr; tab. aStream nextPutAll: 'count: '. aStream nextPutAll: self count printString. aStream cr; tab. aStream nextPutAll: 'max: '. aStream nextPutAll: self max printString. aStream cr; tab. aStream nextPutAll: 'limit: '. aStream nextPutAll: limit printString. aStream cr; tab. aStream nextPutAll: self list printString! storeOn: aStream | noneYet | aStream nextPutAll: '(('. aStream store: self class. aStream nextPutAll: ' new: ' , limit printString , ')'. noneYet := true. list do: [:each | noneYet ifTrue: [noneYet := false] ifFalse: [aStream nextPut: $;]. aStream nextPutAll: ' add: '. aStream store: each]. noneYet ifFalse: [aStream nextPutAll: '; yourself']. aStream nextPut: $)! ! !ScavengeObserverList methodsFor: 'private'! setCollection: size list := OrderedCollection new: size. max := ValueHolder with: 0. count := ValueHolder with: 0. limit := size! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ScavengeObserverList class instanceVariableNames: ''! !ScavengeObserverList class methodsFor: 'copyright'! copyright ^'Copyleft 1999 NISHIHARA Satoshi.'! system ^'Goodies'! version ^'001'! ! !ScavengeObserverList class methodsFor: 'instance creation'! new ^self new: 10! new: size ^super new setCollection: size! ! View subclass: #ScavengeObserverView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Goodies-MemoryObserver'! !ScavengeObserverView methodsFor: 'controller accessing'! defaultControllerClass ^ControllerWithMenu! ! !ScavengeObserverView methodsFor: 'displaying'! displayOn: graphicsContext | points area | self isOpen ifFalse: [^nil]. Transcript space; show: #'#'. "self getEventHandler. ScheduledControllers checkForEvents." "Processor yield." area := self bounds. graphicsContext paint: (ColorValue brightness: 0.6). graphicsContext displayRectangle: area. points := self pointCollection. graphicsContext lineWidth: 1. graphicsContext paint: (ColorValue brightness: 0.4). graphicsContext displayPolygon: points. graphicsContext paint: (ColorValue black). graphicsContext displayPolyline: points! ! !ScavengeObserverView methodsFor: 'updating'! update: aSymbol ScheduledControllers checkForEvents. self displayOn: self graphicsContext! ! !ScavengeObserverView methodsFor: 'private'! pointCollection | scavengeList items point area points index width height location scavengeMax denominator anArray | area := self bounds. anArray := self model value. anArray isNil ifTrue: [scavengeMax := 0. scavengeList := Array new] ifFalse: [scavengeMax := anArray last first. scavengeList := anArray last at: 2]. items := scavengeList size. point := area bottomLeft. points := OrderedCollection new: 22. points add: area bottomLeft. index := 1. scavengeList do: [:y | denominator := (items - 1) max: 1. width := area width * (index - 1) / denominator. denominator := scavengeMax max: 1. height := area height * y / denominator. location := (point x + width @ (point y - height)) rounded. points add: location. index := index + 1]. points add: area bottomRight. ^points! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ScavengeObserverView class instanceVariableNames: ''! !ScavengeObserverView class methodsFor: 'copyright'! copyright ^'Copyleft 1999 NISHIHARA Satoshi.'! system ^'Goodies'! version ^'001'! ! View subclass: #MemoryObserverView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Goodies-MemoryObserver'! !MemoryObserverView methodsFor: 'controller accessing'! defaultControllerClass ^ControllerWithMenu! ! !MemoryObserverView methodsFor: 'displaying'! displayOn: graphicsContext | anArray aString stringWidth numeratorValue denominatorValue | self isOpen ifFalse: [^nil]. anArray := self model value. anArray isNil ifTrue: [^nil]. numeratorValue := anArray last last. denominatorValue := anArray last first. (numeratorValue isInteger not or: [denominatorValue isInteger not]) ifTrue: [numeratorValue := 0. denominatorValue := 0. anArray last do: [:each | numeratorValue := numeratorValue + each last. denominatorValue := denominatorValue + each first]]. self displayOn: graphicsContext numerator: numeratorValue denominator: denominatorValue with: anArray last. aString := anArray first. self displayOn: graphicsContext string: aString at: 2 @ 12. aString := (self convertToDisplayString: numeratorValue) , ' / ' , (self convertToDisplayString: denominatorValue). stringWidth := graphicsContext widthOfString: aString. self displayOn: graphicsContext string: aString at: self bounds width - (stringWidth + 2) @ 12! displayOn: graphicsContext numerator: numeratorValue denominator: denominatorValue with: anArray | barPosition barBox blankBox numeratorInteger leftPosition rightPosition boxCollection aBox | barPosition := (self bounds width * (numeratorValue / denominatorValue)) rounded. barBox := self bounds origin corner: self bounds left + barPosition @ self bounds bottom. blankBox := self bounds left + barPosition @ self bounds top corner: self bounds corner. graphicsContext paint: (ColorValue brightness: 0.4). graphicsContext displayRectangle: barBox. graphicsContext paint: (ColorValue brightness: 0.6). graphicsContext displayRectangle: blankBox. (anArray first isKindOf: Array) ifFalse: [^self]. boxCollection := OrderedCollection new: anArray size. numeratorInteger := 0. anArray do: [:each | leftPosition := (self bounds width - 1 * (numeratorInteger / denominatorValue)) rounded. numeratorInteger := numeratorInteger + each first. rightPosition := (self bounds width - 1 * (numeratorInteger / denominatorValue)) rounded. aBox := leftPosition @ (self bounds center y - 1) corner: rightPosition @ self bounds bottom. boxCollection add: aBox]. graphicsContext paint: ColorValue black. graphicsContext displayLineFrom: self bounds leftCenter - (0 @ 2) to: self bounds rightCenter - (0 @ 2). anArray with: boxCollection do: [:each :box | aBox := box insetBy: (1 @ 1 corner: 0 @ 1). barPosition := (aBox width * (each last / each first)) rounded. barBox := aBox origin corner: aBox left + barPosition @ aBox bottom. blankBox := aBox left + barPosition @ aBox top corner: aBox corner. graphicsContext paint: (ColorValue brightness: 0.4). graphicsContext displayRectangle: barBox. graphicsContext paint: (ColorValue brightness: 0.6). graphicsContext displayRectangle: blankBox. aBox := box insetBy: (0 @ 0 corner: 0 @ 1). graphicsContext paint: (ColorValue brightness: 1). graphicsContext displayRectangularBorder: aBox]! displayOn: graphicsContext string: aString at: aPoint graphicsContext font: (Screen default defaultFontPolicy findFont: ((TextAttributes styleNamed: #small ifAbsent: [TextAttributes default]) fontAt: nil)). graphicsContext paint: (ColorValue brightness: 0.1). graphicsContext displayString: aString at: aPoint + (1 @ 1). graphicsContext paint: (ColorValue brightness: 0.2). graphicsContext displayString: aString at: aPoint + (1 @ 0). graphicsContext paint: (ColorValue brightness: 0.3). graphicsContext displayString: aString at: aPoint + (0 @ 1). graphicsContext paint: (ColorValue brightness: 0.8). graphicsContext displayString: aString at: aPoint! ! !MemoryObserverView methodsFor: 'updating'! update: aSymbol "self halt." ScheduledControllers checkForEvents. self displayOn: self graphicsContext! ! !MemoryObserverView methodsFor: 'private'! convertToDisplayString: anInteger "MemoryObserverView new convertToDisplayString: 1234567890." | aString aStream | aString := anInteger printString. aStream := WriteStream on: (String new: aString size + 4). 1 to: aString size do: [:index | aStream nextPut: (aString at: aString size - index + 1). (index < aString size and: [index \\ 3 = 0]) ifTrue: [aStream nextPut: $,]]. ^aStream contents reverse! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! MemoryObserverView class instanceVariableNames: ''! !MemoryObserverView class methodsFor: 'copyright'! copyright ^'Copyleft 1999 NISHIHARA Satoshi.'! system ^'Goodies'! version ^'001'! ! ApplicationModel subclass: #MemoryObserver instanceVariableNames: 'dataEden dataSurvivorSpace dataLargeSpace dataOldSpace dataPermSpace dataTotal memoryObserverState memoryObserverProcess ' classVariableNames: '' poolDictionaries: '' category: 'Goodies-MemoryObserver'! !MemoryObserver methodsFor: 'initialize-release'! initialize super initialize. dataEden := ValueHolder with: nil. dataSurvivorSpace := ValueHolder with: nil. dataLargeSpace := ValueHolder with: nil. dataOldSpace := ValueHolder with: nil. dataPermSpace := ValueHolder with: nil. dataTotal := ValueHolder with: nil! release dataEden := nil. dataSurvivorSpace := nil. dataLargeSpace := nil. dataOldSpace := nil. dataPermSpace := nil. dataTotal := nil. super release! ! !MemoryObserver methodsFor: 'constructing'! compute: aBlock BlockValue block: aBlock arguments: (Array with: dataEden). BlockValue block: aBlock arguments: (Array with: dataSurvivorSpace). BlockValue block: aBlock arguments: (Array with: dataLargeSpace). BlockValue block: aBlock arguments: (Array with: dataOldSpace). BlockValue block: aBlock arguments: (Array with: dataPermSpace). BlockValue block: aBlock arguments: (Array with: dataTotal)! ! !MemoryObserver methodsFor: 'processing'! observe | anObjectMemory | anObjectMemory := ObjectMemory current. self observeEden: anObjectMemory. self observeSurvivorSpace: anObjectMemory. self observeLargeSpace: anObjectMemory. self observeOldSpace: anObjectMemory. self observePermSpace: anObjectMemory. self observeTotal: anObjectMemory! resume | nextTime | memoryObserverProcess notNil ifTrue: [^nil]. memoryObserverProcess := [memoryObserverState := true. [memoryObserverState] whileTrue: [Object errorSignal handle: [:exception | memoryObserverState := false. exception reject] do: [self observe]. nextTime := Time millisecondClockValue + self tickTime. nextTime := nextTime truncateTo: self tickTime. (Delay untilMilliseconds: nextTime) wait]. memoryObserverProcess := nil] newProcess. memoryObserverProcess priority: Processor activeProcess priority + 1. memoryObserverProcess resume. ^self! terminate memoryObserverState := false. memoryObserverProcess isNil ifTrue: [^nil]. ^self! ! !MemoryObserver methodsFor: 'events'! noticeOfWindowClose: aWindow self terminate. super noticeOfWindowClose: aWindow! ! !MemoryObserver methodsFor: 'interface opening'! createEdenView | aView | aView := MemoryObserverView new. aView model: dataEden. aView controller menuHolder: [self yellowButtonMenu]. aView controller performer: self. ^aView! createLargeSpaceView | aView | aView := MemoryObserverView new. aView model: dataLargeSpace. aView controller menuHolder: [self yellowButtonMenu]. aView controller performer: self. ^aView! createOldSpaceView | aView | aView := MemoryObserverView new. aView model: dataOldSpace. aView controller menuHolder: [self yellowButtonMenu]. aView controller performer: self. ^aView! createPermSpaceView | aView | aView := MemoryObserverView new. aView model: dataPermSpace. aView controller menuHolder: [self yellowButtonMenu]. aView controller performer: self. ^aView! createSurvivorSpaceView | aView | aView := MemoryObserverView new. aView model: dataSurvivorSpace. aView controller menuHolder: [self yellowButtonMenu]. aView controller performer: self. ^aView! createTotalView | aView | aView := MemoryObserverView new. aView model: dataTotal. aView controller menuHolder: [self yellowButtonMenu]. aView controller performer: self. ^aView! postOpenWith: aBuilder super postOpenWith: aBuilder. (aBuilder componentAt: #subCanvas) widget client: self spec: #subCanvasSpec. self resume! ! !MemoryObserver methodsFor: 'menu messages'! yellowButtonMenu | aMenu | aMenu := self class yellowButtonMenu. memoryObserverState ifTrue: [(aMenu menuItemLabeled: 'resume') disable. (aMenu menuItemLabeled: 'terminate') enable] ifFalse: [(aMenu menuItemLabeled: 'resume') enable. (aMenu menuItemLabeled: 'terminate') disable]. ^aMenu! ! !MemoryObserver methodsFor: 'private'! observeEden: anObjectMemory | denominatorValue numeratorValue dataEdenValue | denominatorValue := anObjectMemory edenBytes. numeratorValue := anObjectMemory edenUsedBytes. dataEdenValue := Array with: 'Eden' with: (Array with: denominatorValue with: numeratorValue). dataEden value = dataEdenValue ifFalse: [dataEden value: dataEdenValue]! observeLargeSpace: anObjectMemory | denominatorValue numeratorValue dataLargeSpaceValue | denominatorValue := anObjectMemory largeBytes. numeratorValue := anObjectMemory largeUsedBytes. dataLargeSpaceValue := Array with: 'LargeSpace' with: (Array with: denominatorValue with: numeratorValue). dataLargeSpace value = dataLargeSpaceValue ifFalse: [dataLargeSpace value: dataLargeSpaceValue]! observeOldSpace: anObjectMemory | anArray denominatorValue numeratorValue dataOldSpaceValue | anArray := Array new: anObjectMemory size // 3. 1 to: anObjectMemory size // 3 do: [:aNumber | denominatorValue := anObjectMemory basicAt: aNumber * 3 - 2. numeratorValue := (anObjectMemory basicAt: aNumber * 3) + (anObjectMemory otEntriesToBytes: (anObjectMemory basicAt: aNumber * 3 - 1)). anArray at: aNumber put: (Array with: denominatorValue with: numeratorValue)]. dataOldSpaceValue := Array with: 'OldSpace' with: anArray. dataOldSpace value = dataOldSpaceValue ifFalse: [dataOldSpace value: dataOldSpaceValue]! observePermSpace: anObjectMemory | denominatorValue numeratorValue dataPermSpaceValue | denominatorValue := anObjectMemory permBytes. numeratorValue := anObjectMemory permDataBytes + (anObjectMemory otEntriesToBytes: anObjectMemory permOTEs). dataPermSpaceValue := Array with: 'PermSpace' with: (Array with: denominatorValue with: numeratorValue). dataPermSpace value = dataPermSpaceValue ifFalse: [dataPermSpace value: dataPermSpaceValue]! observeSurvivorSpace: anObjectMemory | denominatorValue numeratorValue dataSurvivorSpaceValue | denominatorValue := anObjectMemory survBytes * 2. numeratorValue := anObjectMemory survUsedBytes. dataSurvivorSpaceValue := Array with: 'SurvivorSpace' with: (Array with: denominatorValue with: numeratorValue). dataSurvivorSpace value = dataSurvivorSpaceValue ifFalse: [dataSurvivorSpace value: dataSurvivorSpaceValue]! observeTotal: anObjectMemory | denominatorValue numeratorValue dataTotalValue | denominatorValue := 0. denominatorValue := denominatorValue + dataEden value last first. denominatorValue := denominatorValue + dataSurvivorSpace value last first. denominatorValue := denominatorValue + dataLargeSpace value last first. dataOldSpace value last do: [:each | denominatorValue := denominatorValue + each first]. denominatorValue := denominatorValue + dataPermSpace value last first. denominatorValue := denominatorValue + anObjectMemory stackBytes. denominatorValue := denominatorValue + anObjectMemory compCodeCacheBytes. numeratorValue := 0. numeratorValue := numeratorValue + dataEden value last last. numeratorValue := numeratorValue + dataSurvivorSpace value last last. numeratorValue := numeratorValue + dataLargeSpace value last last. dataOldSpace value last do: [:each | numeratorValue := numeratorValue + each last]. numeratorValue := numeratorValue + dataPermSpace value last last. numeratorValue := numeratorValue + anObjectMemory stackBytes. numeratorValue := numeratorValue + anObjectMemory compCodeCacheBytes. dataTotalValue := Array with: 'Total' with: (Array with: denominatorValue with: numeratorValue). dataTotal value = dataTotalValue ifFalse: [dataTotal value: dataTotalValue]! tickTime ^3000! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! MemoryObserver class instanceVariableNames: ''! !MemoryObserver class methodsFor: 'copyright'! copyright ^'Copyleft 1999 NISHIHARA Satoshi.'! system ^'Goodies'! version ^'001'! ! !MemoryObserver class methodsFor: 'instance creation'! new "MemoryObserver new." ^(super new) initialize; yourself! ! !MemoryObserver class methodsFor: 'interface specs'! subCanvasSpec "UIPainter new openOnClass: self andSelector: #subCanvasSpec" ^#(#FullSpec #window: #(#WindowSpec #label: 'Memory Observer' #min: #(#Point 250 170 ) #bounds: #(#Rectangle 100 100 350 270 ) ) #component: #(#SpecCollection #collection: #( #(#ArbitraryComponentSpec #layout: #(#LayoutFrame 1 0 1 0 -1 1 -1 0.142857 ) #name: #viewEden #component: #createEdenView ) #(#ArbitraryComponentSpec #layout: #(#LayoutFrame 1 0 1 0.142857 -1 1 -1 0.285714 ) #name: #viewSurvivorSpace #component: #createSurvivorSpaceView ) #(#ArbitraryComponentSpec #layout: #(#LayoutFrame 1 0 1 0.285714 -1 1 -1 0.428571 ) #name: #viewLargeSpace #component: #createLargeSpaceView ) #(#ArbitraryComponentSpec #layout: #(#LayoutFrame 1 0 1 0.428571 -1 1 -1 0.714286 ) #name: #viewOldSpace #component: #createOldSpaceView ) #(#ArbitraryComponentSpec #layout: #(#LayoutFrame 1 0 1 0.714286 -1 1 -1 0.857143 ) #name: #viewPermSpace #component: #createPermSpaceView ) #(#ArbitraryComponentSpec #layout: #(#LayoutFrame 1 0 1 0.857143 -1 1 -1 1 ) #name: #viewTotal #component: #createTotalView ) ) ) )! windowSpec "UIPainter new openOnClass: self andSelector: #windowSpec" ^#(#FullSpec #window: #(#WindowSpec #label: 'Memory Observer' #min: #(#Point 250 170 ) #bounds: #(#Rectangle 100 100 350 270 ) ) #component: #(#SpecCollection #collection: #( #(#SubCanvasSpec #layout: #(#LayoutFrame 1 0 1 0 -1 1 -1 1 ) #name: #subCanvas #flags: 0 ) ) ) )! ! !MemoryObserver class methodsFor: 'resources'! yellowButtonMenu "MenuEditor new openOnClass: self andSelector: #yellowButtonMenu" ^#(#Menu #( #(#MenuItem #rawLabel: 'resume' #value: #resume ) #(#MenuItem #rawLabel: 'terminate' #value: #terminate ) ) #(2 ) nil ) decodeAsLiteralArray! ! !MemoryObserver class methodsFor: 'saving'! save "MemoryObserver save." | encodingName fileName classCollection aStream | encodingName := #default. fileName := 'MemoryObserver.st'. classCollection := self saveClasses. aStream := (fileName asFilename withEncoding: encodingName) writeStream. [Cursor write showWhile: [| timeStamp | timeStamp := Date today shortPrintString , ' ' , Time now shortPrintString. aStream cr. aStream nextChunkPut: timeStamp printString. aStream cr; cr. (self comment isNil or: [self comment isEmpty]) ifFalse: [aStream nextChunkPut: self comment printString. aStream cr; cr]. classCollection do: [:aClass | aStream nextChunkPut: aClass definition. aStream cr; cr]. classCollection do: [:aClass | | sourceCodeStream | aStream nextPut: Character newPage. aStream cr. sourceCodeStream := SourceCodeStream on: aStream. aClass fileOutSourceOn: sourceCodeStream. aStream cr]]] valueNowOrOnUnwindDo: [aStream close]. ^classCollection! saveClasses "MemoryObserver saveClasses." | patternCollection classCollection | patternCollection := #('*MemoryObserver*'). classCollection := Smalltalk organization superclassOrder: self category. classCollection := classCollection select: [:aClass | | string something | string := aClass name asString. something := patternCollection detect: [:it | it match: string] ifNone: [nil]. something notNil]. ^classCollection! ! !MemoryObserver class methodsFor: 'examples'! example "MemoryObserver example." MemoryObserver open! example1 "MemoryObserver example1." | memoryObserver | memoryObserver := MemoryObserver new. memoryObserver compute: [:array | Transcript cr. Transcript nextPutAll: array printString. Transcript flush]. memoryObserver resume. [(Delay forSeconds: 30) wait. memoryObserver terminate] fork. ^memoryObserver! example2 "MemoryObserver example2." | memoryObserver | memoryObserver := MemoryObserver new. memoryObserver open. ^memoryObserver! ! MemoryObserver subclass: #ScavengeObserver instanceVariableNames: 'dataScavenge scavengeCount scavengeList delay priority ' classVariableNames: '' poolDictionaries: '' category: 'Goodies-MemoryObserver'! ScavengeObserver comment: '# # This file is encoded in (so called) SHIFT-JIS, # line delimitor is CR. # Scavenge Observer Goodies for VisualWorks 2.5, VisualWorks Non-Commercial 3.0a Copyleft 1999 NISHIHARA Satoshi Broken English description This goodies contains Mr. AOKI''s "Memory Observer". Memory Observer Goodies for VisualWorks 2.5 and VisualWorks 3.0 Copyright (C) 1995-1999 AOKI Atsushi 1999/02/28 http://www.sra.co.jp/people/aoki/SmalltalkGoodies/VisualWorks/MemoryObserver.st http://www.sra.co.jp/people/aoki/SmalltalkGoodies/VisualWorks/MemoryObserver.txt Summary: This goodies watches ObjectMemory''s scavenging as a polygon graph. This has simple GUI and you can modify the delay time and priority of watching process. Please evaluate below; "ScavengeObserver open" How to install: FileIn this goodies and makes a classes "ScavengeObserver" etc, in a category "Goodies-MemoryObserver". How to use: same as Memory Observer. And some menu items are added. ---------------------------------------------------------- 西原聡士 (NISHIHARA Satoshi) e-mail: mailto:nishis@zephyr.dti.ne.jp URL: http://www.zephyr.dti.ne.jp/~nishis/ ---------------------------------------------------------- '! !ScavengeObserver methodsFor: 'initialize-release'! initialize super initialize. delay := ValueHolder with: (super tickTime // 1000). priority := ValueHolder with: (Processor activeProcess priority + 1). dataScavenge := ValueHolder with: nil. scavengeCount := 0. scavengeList := ScavengeObserverList new: 20! release delay := nil. priority := nil. dataScavenge := nil. scavengeList release. scavengeList := nil. super release! ! !ScavengeObserver methodsFor: 'constructing'! compute: aBlock super compute: aBlock. BlockValue block: aBlock arguments: (Array with: dataScavenge)! ! !ScavengeObserver methodsFor: 'accessing'! delay ^delay! delay: second delay := second max: 1! priority ^priority! priority: anInteger priority := ((anInteger max: 1) min: 100) asInteger! scavengeList ^scavengeList! scavenges ^scavengeList count! scavengesMax ^scavengeList max! ! !ScavengeObserver methodsFor: 'processing'! observe super observe. self observeScavenge! resume self isScavengeNotificationListed ifFalse: [super resume. ObjectMemory addToScavengeNotificationList: self]. ^self! terminate ObjectMemory removeFromScavengeNotificationList: self. ^super terminate! ! !ScavengeObserver methodsFor: 'events'! noticeOfWindowClose: aWindow self dependents size <= 1 ifTrue: [super noticeOfWindowClose: aWindow]! ! !ScavengeObserver methodsFor: 'interface opening'! createScavengeView | aView | aView := ScavengeObserverView new. aView model: dataScavenge. aView controller menuHolder: [self yellowButtonMenu]. aView controller performer: self. ^aView! openFull ^self openInterface: #fullWindowSpec! openMemoryObserver ^self openInterface: #memoryObserverSpec! postOpenWith: aBuilder | memoryObserverSubCanvas subCanvas | memoryObserverSubCanvas := aBuilder componentAt: #memoryObserverSubCanvas. subCanvas := aBuilder componentAt: #subCanvas. (memoryObserverSubCanvas notNil and: [subCanvas isNil]) ifTrue: [memoryObserverSubCanvas widget client: self spec: #memoryObserverSubCanvasSpec. ^self resume]. super postOpenWith: aBuilder! ! !ScavengeObserver methodsFor: 'menu messages'! yellowButtonMenu | aMenu labels values | aMenu := super yellowButtonMenu. (aMenu menuItemLabeled: 'control' ifNone: [nil]) notNil ifTrue: [^aMenu]. labels := OrderedCollection new. values := OrderedCollection new. labels add: 'control'. values add: [:controller | self open]. labels add: 'Memory Observer'. values add: [:controller | self openMemoryObserver]. labels add: 'Memory && Scavenge Observer'. values add: [:controller | self openFull]. aMenu addItemGroupLabels: labels asArray values: values asArray. ^aMenu! ! !ScavengeObserver methodsFor: 'actions'! delayChange ^delay! priorityChange memoryObserverProcess notNil ifTrue: [memoryObserverProcess priority: priority value]. ^priority! ! !ScavengeObserver methodsFor: 'updating'! update: anAspectSymbol with: aParameter from: aSender anAspectSymbol == #ElementExpired ifTrue: [scavengeCount := scavengeCount + 1]! ! !ScavengeObserver methodsFor: 'testing'! isScavengeNotificationListed | aDependentsCollection | aDependentsCollection := (ObjectMemory classPool at: #ScavengeNotification) myDependents. (aDependentsCollection isKindOf: DependentsCollection) ifTrue: [^aDependentsCollection includes: self]. ^false! ! !ScavengeObserver methodsFor: 'private'! debug: anObject Transcript space; show: anObject printString! observeScavenge | count dataScavengeValue | count := scavengeCount. scavengeCount := 0. self scavengeList add: count. dataScavengeValue := Array with: 'Scavenge' with: (Array with: self scavengesMax value with: scavengeList list asArray). dataScavenge value: dataScavengeValue! tickTime ^delay value * 1000! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ScavengeObserver class instanceVariableNames: ''! !ScavengeObserver class methodsFor: 'copyright'! copyright ^'Copyleft 1999 NISHIHARA Satoshi.'! system ^'Goodies'! version ^'001'! ! !ScavengeObserver class methodsFor: 'instance creation'! new "ScavengeObserver new." ^(super new) initialize; yourself! ! !ScavengeObserver class methodsFor: 'interface specs'! controlSubCanvasSpec "UIPainter new openOnClass: self andSelector: #controlSubCanvasSpec" ^#(#FullSpec #window: #(#WindowSpec #label: 'Scavenge Observer' #min: #(#Point 250 40 ) #bounds: #(#Rectangle 257 230 507 270 ) ) #component: #(#SpecCollection #collection: #( #(#LabelSpec #layout: #(#Point 0 0 ) #label: 'Delay' #style: #default ) #(#LabelSpec #layout: #(#LayoutOrigin 0 0.5 0 0 ) #label: 'Priority' #style: #default ) #(#SliderSpec #layout: #(#LayoutFrame 1 0 20 0 -2 0.5 -1 1 ) #model: #delay #callbacksSpec: #(#UIEventCallbackSubSpec #valueChangeSelector: #delayChange ) #orientation: #horizontal #start: 1.0 #stop: 10.0 #step: 0.5 ) #(#SliderSpec #layout: #(#LayoutFrame 2 0.5 20 0 -1 1 -1 1 ) #model: #priority #callbacksSpec: #(#UIEventCallbackSubSpec #valueChangeSelector: #priorityChange ) #orientation: #horizontal #start: 40 #stop: 60 #step: 1 ) #(#InputFieldSpec #layout: #(#LayoutFrame 0 0.25 0 0 -4 0.5 20 0 ) #flags: 0 #model: #delayChange #tabable: false #alignment: #right #style: #default #isReadOnly: true #type: #number #formatString: '0.0' ) #(#InputFieldSpec #layout: #(#LayoutFrame 0 0.75 0 0 1 1 20 0 ) #flags: 0 #model: #priorityChange #tabable: false #alignment: #right #style: #default #isReadOnly: true #type: #number #formatString: '#,##0' ) ) ) )! fullWindowSpec "UIPainter new openOnClass: self andSelector: #fullWindowSpec" ^#(#FullSpec #window: #(#WindowSpec #label: 'Scavenge Observer' #min: #(#Point 250 260 ) #bounds: #(#Rectangle 100 100 350 360 ) #isEventDriven: true ) #component: #(#SpecCollection #collection: #( #(#SubCanvasSpec #layout: #(#LayoutFrame 1 0 1 0 -1 1 40 0 ) #name: #controlSubCanvas #flags: 0 #minorKey: #controlSubCanvasSpec ) #(#SubCanvasSpec #layout: #(#LayoutFrame 1 0 40 0 -1 1 -1 0.8 ) #name: #memoryObserverSubCanvas #flags: 0 #minorKey: #memoryObserverSubCanvasSpec ) #(#SubCanvasSpec #layout: #(#LayoutFrame 1 0 1 0.8 -1 1 -1 1 ) #name: #subCanvas #flags: 0 #minorKey: #subCanvasSpec ) ) ) )! memoryObserverSpec "UIPainter new openOnClass: self andSelector: #memoryObserverSpec" ^#(#FullSpec #window: #(#WindowSpec #label: 'Memory Observer' #min: #(#Point 250 170 ) #bounds: #(#Rectangle 100 100 350 270 ) #isEventDriven: true ) #component: #(#SpecCollection #collection: #( #(#SubCanvasSpec #layout: #(#LayoutFrame 1 0 1 0 -1 1 -1 1 ) #name: #memoryObserverSubCanvas #flags: 0 #minorKey: #memoryObserverSubCanvasSpec ) ) ) )! memoryObserverSubCanvasSpec ^super subCanvasSpec! subCanvasSpec "UIPainter new openOnClass: self andSelector: #subCanvasSpec" ^#(#FullSpec #window: #(#WindowSpec #label: 'Scavenge Observer' #min: #(#Point 250 50 ) #bounds: #(#Rectangle 100 100 350 150 ) ) #component: #(#SpecCollection #collection: #( #(#ArbitraryComponentSpec #layout: #(#LayoutFrame 1 0 20 0 -1 1 -1 1 ) #component: #createScavengeView ) #(#LabelSpec #layout: #(#LayoutFrame 0 0 0 0 0 0.332 20 0 ) #label: 'Scavenges:' #style: #default ) #(#LabelSpec #layout: #(#LayoutFrame 0 0.684 0 0 0 0.832 20 0 ) #label: 'max:' #style: #default ) #(#InputFieldSpec #layout: #(#LayoutFrame 0 0.832 0 0 0 1 20 0 ) #flags: 0 #model: #scavengesMax #tabable: false #alignment: #right #style: #default #isReadOnly: true #type: #number #formatString: '#,##0' ) #(#InputFieldSpec #layout: #(#LayoutFrame 0 0.332 0 0 0 0.484 20 0 ) #flags: 0 #model: #scavenges #tabable: false #alignment: #right #style: #default #isReadOnly: true #type: #number #formatString: '#,##0' ) ) ) )! windowSpec "UIPainter new openOnClass: self andSelector: #windowSpec" ^#(#FullSpec #window: #(#WindowSpec #label: 'Scavenge Observer' #min: #(#Point 250 90 ) #bounds: #(#Rectangle 100 100 350 190 ) #isEventDriven: true ) #component: #(#SpecCollection #collection: #( #(#SubCanvasSpec #layout: #(#LayoutFrame 1 0 1 0 -1 1 40 0 ) #name: #controlSubCanvas #flags: 0 #minorKey: #controlSubCanvasSpec ) #(#SubCanvasSpec #layout: #(#LayoutFrame 1 0 40 0 -1 1 -1 1 ) #name: #subCanvas #flags: 0 #minorKey: #subCanvasSpec ) ) ) )! ! !ScavengeObserver class methodsFor: 'saving'! save "ScavengeObserver save." | encodingName fileName classCollection aStream | encodingName := #default. fileName := 'Scavenge.st'. classCollection := self saveClasses. aStream := (fileName asFilename withEncoding: encodingName) writeStream. [Cursor write showWhile: [| timeStamp | timeStamp := Date today shortPrintString , ' ' , Time now shortPrintString. aStream cr. aStream nextChunkPut: timeStamp printString. aStream cr; cr. (self comment isNil or: [self comment isEmpty]) ifFalse: [aStream nextChunkPut: self comment printString. aStream cr; cr]. classCollection do: [:aClass | aStream nextChunkPut: aClass definition. aStream cr; cr]. classCollection do: [:aClass | | sourceCodeStream | aStream nextPut: Character newPage. aStream cr. sourceCodeStream := SourceCodeStream on: aStream. aClass fileOutSourceOn: sourceCodeStream. aStream cr]]] valueNowOrOnUnwindDo: [aStream close]. ^classCollection! saveClasses "ScavengeObserver saveClasses." | patternCollection classCollection | patternCollection := #('*MemoryObserver*' '*ScavengeObserver*'). classCollection := Smalltalk organization superclassOrder: self category. classCollection := classCollection select: [:aClass | | string something | string := aClass name asString. something := patternCollection detect: [:it | it match: string] ifNone: [nil]. something notNil]. ^classCollection! ! !ScavengeObserver class methodsFor: 'examples'! example1 "ScavengeObserver example1." ScavengeObserver open! example2 "ScavengeObserver example2." | scavengeObserver | scavengeObserver := ScavengeObserver new. scavengeObserver compute: [:array | Transcript cr. Transcript nextPutAll: array printString. Transcript flush]. scavengeObserver resume. [(Delay forSeconds: 30) wait. scavengeObserver terminate. Transcript cr; show: 'done!!'] fork. ^scavengeObserver! example3 "ScavengeObserver example3." | scavengeObserver | scavengeObserver := ScavengeObserver new. scavengeObserver openFull. ^scavengeObserver! example4 "ScavengeObserver example4." | performSymbols scavengeObserver | performSymbols := #(#open #openMemoryObserver #openFull). scavengeObserver := ScavengeObserver new. performSymbols do: [:performSymbol | scavengeObserver perform: performSymbol]. ^scavengeObserver! !