8 be provided or otherwise made available to, or used by, any |
8 be provided or otherwise made available to, or used by, any |
9 other person. No title to or ownership of the software is |
9 other person. No title to or ownership of the software is |
10 hereby transferred. |
10 hereby transferred. |
11 " |
11 " |
12 |
12 |
13 'From Smalltalk/X, Version:2.10.5 on 22-mar-1995 at 7:43:35 am'! |
|
14 |
|
15 StandardSystemView subclass:#MemoryMonitor |
13 StandardSystemView subclass:#MemoryMonitor |
16 instanceVariableNames:'updateInterval updateBlock myProcess oldData newData freeData |
14 instanceVariableNames:'updateInterval updateBlock myProcess oldData newData freeData |
17 updateIndex org maxTotal minTotal dX newColor freeColor oldColor |
15 updateIndex org maxTotal minTotal dX newColor freeColor oldColor |
18 prevTotal prevFree prevFree2 prevOld scale' |
16 prevTotal prevFree prevFree2 prevOld scale' |
19 classVariableNames:'' |
17 classVariableNames:'' |
20 poolDictionaries:'' |
18 poolDictionaries:'' |
21 category:'Interface-Tools' |
19 category:'Interface-Tools' |
22 ! |
20 ! |
23 |
21 |
24 !MemoryMonitor class methodsFor:'documentation'! |
22 !MemoryMonitor class methodsFor:'documentation'! |
25 |
23 |
26 copyright |
24 copyright |
94 |
88 |
95 defaultExtent |
89 defaultExtent |
96 ^ (200 @ 280) |
90 ^ (200 @ 280) |
97 ! |
91 ! |
98 |
92 |
99 defaultLabel |
|
100 ^ 'Memory Monitor' |
|
101 ! |
|
102 |
|
103 defaultIcon |
93 defaultIcon |
104 |i| |
94 |i| |
105 |
95 |
106 i := Image fromFile:'MemMonitor.xbm'. |
96 i := Image fromFile:'MemMonitor.xbm'. |
107 i notNil ifTrue:[^ i]. |
97 i notNil ifTrue:[^ i]. |
108 ^ super defaultIcon |
98 ^ super defaultIcon |
|
99 ! |
|
100 |
|
101 defaultLabel |
|
102 ^ 'Memory Monitor' |
|
103 ! ! |
|
104 |
|
105 !MemoryMonitor methodsFor:'destroying'! |
|
106 |
|
107 destroy |
|
108 updateBlock notNil ifTrue:[ |
|
109 Processor removeTimedBlock:updateBlock. |
|
110 ] ifFalse:[ |
|
111 myProcess terminate. |
|
112 myProcess := nil |
|
113 ]. |
|
114 oldData := newData := freeData := nil. |
|
115 super destroy |
109 ! ! |
116 ! ! |
110 |
117 |
111 !MemoryMonitor methodsFor:'drawing'! |
118 !MemoryMonitor methodsFor:'drawing'! |
112 |
119 |
113 updateDisplay |
120 redraw |
114 "update picture; trigger next update" |
121 "redraw all" |
115 |
122 |
116 |total oldSpaceUsed newSpaceUsed freeMem oldSpaceSize |
123 self clear. |
117 gWidth shift scaleChange margin mustWait| |
124 self redrawX:0 y:0 width:width height:height |
118 |
|
119 shown ifTrue:[ |
|
120 oldSpaceUsed := ObjectMemory oldSpaceUsed + ObjectMemory symSpaceUsed. |
|
121 newSpaceUsed := ObjectMemory newSpaceUsed. |
|
122 freeMem := ObjectMemory freeListSpace + (ObjectMemory oldSpaceSize - ObjectMemory oldSpaceUsed). |
|
123 oldSpaceSize := ObjectMemory oldSpaceSize + ObjectMemory symSpaceSize. |
|
124 total := oldSpaceSize + ObjectMemory newSpaceSize. |
|
125 |
|
126 scaleChange := false. |
|
127 |
|
128 ((total - freeMem) < minTotal) ifTrue:[ |
|
129 minTotal := total - freeMem. |
|
130 scaleChange := true |
|
131 ]. |
|
132 (total > maxTotal) ifTrue:[ |
|
133 maxTotal := total. |
|
134 scaleChange := true |
|
135 ]. |
|
136 |
|
137 oldData at:updateIndex put:oldSpaceSize. "/ oldSpaceUsed. |
|
138 newData at:updateIndex put:newSpaceUsed. |
|
139 freeData at:updateIndex put:freeMem. |
|
140 updateIndex := updateIndex + 1. |
|
141 |
|
142 scaleChange ifTrue:[ |
|
143 scale := height asFloat / (maxTotal + 100000). |
|
144 self redraw |
|
145 ]. |
|
146 |
|
147 gWidth := width - org. |
|
148 margin := 1. |
|
149 |
|
150 mustWait := false. |
|
151 ((updateIndex-1) >= (gWidth - margin)) ifTrue:[ |
|
152 "on slow displays, use:" |
|
153 "/ shift := gWidth // 4. |
|
154 |
|
155 "for smooth display, use:" |
|
156 shift := 1. |
|
157 |
|
158 oldData replaceFrom:1 with:oldData startingAt:shift+1. |
|
159 newData replaceFrom:1 with:newData startingAt:shift+1. |
|
160 freeData replaceFrom:1 with:freeData startingAt:shift+1. |
|
161 |
|
162 updateIndex := updateIndex - shift. |
|
163 dX := dX + shift. |
|
164 |
|
165 self catchExpose. |
|
166 self copyFrom:self |
|
167 x:(org + shift) y:0 |
|
168 toX:org y:0 |
|
169 width:(gWidth - shift - margin) |
|
170 height:height. |
|
171 self clearRectangleX:(width - margin - shift) y:0 |
|
172 width:shift height:height. |
|
173 mustWait := true. |
|
174 ]. |
|
175 |
|
176 self updateLineX:(updateIndex - 1 + org - 1) |
|
177 total:total |
|
178 old:oldSpaceSize "/ oldSpaceUsed |
|
179 new:newSpaceUsed |
|
180 free:freeMem. |
|
181 |
|
182 self updateNumbers. |
|
183 mustWait ifTrue:[ |
|
184 self waitForExpose. |
|
185 ] |
|
186 |
|
187 ]. |
|
188 |
|
189 updateBlock notNil ifTrue:[ |
|
190 Processor addTimedBlock:updateBlock afterSeconds:updateInterval |
|
191 ]. |
|
192 ! |
125 ! |
193 |
126 |
194 redrawX:x y:y width:w height:h |
127 redrawX:x y:y width:w height:h |
195 "redraw data" |
128 "redraw data" |
196 |
129 |
240 x < org ifTrue:[ |
173 x < org ifTrue:[ |
241 prevFree := prevFree2 := prevOld := prevTotal := nil. |
174 prevFree := prevFree2 := prevOld := prevTotal := nil. |
242 |
175 |
243 self updateNumbers. |
176 self updateNumbers. |
244 ] |
177 ] |
|
178 ! |
|
179 |
|
180 updateDisplay |
|
181 "update picture; trigger next update" |
|
182 |
|
183 |total oldSpaceUsed newSpaceUsed freeMem oldSpaceSize |
|
184 gWidth shift scaleChange margin mustWait| |
|
185 |
|
186 shown ifTrue:[ |
|
187 oldSpaceUsed := ObjectMemory oldSpaceUsed + ObjectMemory symSpaceUsed. |
|
188 newSpaceUsed := ObjectMemory newSpaceUsed. |
|
189 freeMem := ObjectMemory freeListSpace + (ObjectMemory oldSpaceSize - ObjectMemory oldSpaceUsed). |
|
190 oldSpaceSize := ObjectMemory oldSpaceSize + ObjectMemory symSpaceSize. |
|
191 total := oldSpaceSize + ObjectMemory newSpaceSize. |
|
192 |
|
193 scaleChange := false. |
|
194 |
|
195 ((total - freeMem) < minTotal) ifTrue:[ |
|
196 minTotal := total - freeMem. |
|
197 scaleChange := true |
|
198 ]. |
|
199 (total > maxTotal) ifTrue:[ |
|
200 maxTotal := total. |
|
201 scaleChange := true |
|
202 ]. |
|
203 |
|
204 oldData at:updateIndex put:oldSpaceSize. "/ oldSpaceUsed. |
|
205 newData at:updateIndex put:newSpaceUsed. |
|
206 freeData at:updateIndex put:freeMem. |
|
207 updateIndex := updateIndex + 1. |
|
208 |
|
209 scaleChange ifTrue:[ |
|
210 scale := height asFloat / (maxTotal + 100000). |
|
211 self redraw |
|
212 ]. |
|
213 |
|
214 gWidth := width - org. |
|
215 margin := 1. |
|
216 |
|
217 mustWait := false. |
|
218 ((updateIndex-1) >= (gWidth - margin)) ifTrue:[ |
|
219 "on slow displays, use:" |
|
220 "/ shift := gWidth // 4. |
|
221 |
|
222 "for smooth display, use:" |
|
223 shift := 1. |
|
224 |
|
225 oldData replaceFrom:1 with:oldData startingAt:shift+1. |
|
226 newData replaceFrom:1 with:newData startingAt:shift+1. |
|
227 freeData replaceFrom:1 with:freeData startingAt:shift+1. |
|
228 |
|
229 updateIndex := updateIndex - shift. |
|
230 dX := dX + shift. |
|
231 |
|
232 self catchExpose. |
|
233 self copyFrom:self |
|
234 x:(org + shift) y:0 |
|
235 toX:org y:0 |
|
236 width:(gWidth - shift - margin) |
|
237 height:height. |
|
238 self clearRectangleX:(width - margin - shift) y:0 |
|
239 width:shift height:height. |
|
240 mustWait := true. |
|
241 ]. |
|
242 |
|
243 self updateLineX:(updateIndex - 1 + org - 1) |
|
244 total:total |
|
245 old:oldSpaceSize "/ oldSpaceUsed |
|
246 new:newSpaceUsed |
|
247 free:freeMem. |
|
248 |
|
249 self updateNumbers. |
|
250 self flush. |
|
251 mustWait ifTrue:[ |
|
252 self waitForExpose. |
|
253 ] |
|
254 |
|
255 ]. |
|
256 |
|
257 updateBlock notNil ifTrue:[ |
|
258 Processor addTimedBlock:updateBlock afterSeconds:updateInterval |
|
259 ]. |
|
260 |
|
261 "Modified: 18.12.1995 / 15:21:10 / cg" |
245 ! |
262 ! |
246 |
263 |
247 updateLineX:x total:total old:oldSpaceSize new:newSpaceUsed free:freeMem |
264 updateLineX:x total:total old:oldSpaceSize new:newSpaceUsed free:freeMem |
248 |hNew hOld hFree y1 y2 y3| |
265 |hNew hOld hFree y1 y2 y3| |
249 |
266 |
408 s := (ObjectMemory scavengeCount printStringLeftPaddedTo:6) |
425 s := (ObjectMemory scavengeCount printStringLeftPaddedTo:6) |
409 , (n printStringLeftPaddedTo:3) , '%'. |
426 , (n printStringLeftPaddedTo:3) , '%'. |
410 self displayOpaqueString:s x:0 y:y. |
427 self displayOpaqueString:s x:0 y:y. |
411 |
428 |
412 "Created: 7.11.1995 / 14:48:16 / cg" |
429 "Created: 7.11.1995 / 14:48:16 / cg" |
413 ! |
|
414 |
|
415 redraw |
|
416 "redraw all" |
|
417 |
|
418 self clear. |
|
419 self redrawX:0 y:0 width:width height:height |
|
420 ! ! |
|
421 |
|
422 !MemoryMonitor methodsFor:'destroying'! |
|
423 |
|
424 destroy |
|
425 updateBlock notNil ifTrue:[ |
|
426 Processor removeTimedBlock:updateBlock. |
|
427 ] ifFalse:[ |
|
428 myProcess terminate. |
|
429 myProcess := nil |
|
430 ]. |
|
431 oldData := newData := freeData := nil. |
|
432 super destroy |
|
433 ! ! |
430 ! ! |
434 |
431 |
435 !MemoryMonitor methodsFor:'events'! |
432 !MemoryMonitor methodsFor:'events'! |
|
433 |
|
434 keyPress:key x:x y:y |
|
435 key == $f ifTrue:[ |
|
436 "faster" |
|
437 updateInterval := updateInterval / 2 |
|
438 ]. |
|
439 key == $s ifTrue:[ |
|
440 "slower" |
|
441 updateInterval := updateInterval * 2 |
|
442 ]. |
|
443 key == $r ifTrue:[ |
|
444 "reset max" |
|
445 maxTotal := prevTotal. |
|
446 scale := height asFloat / (maxTotal + 100000). |
|
447 self resetStatisticValues. |
|
448 self redraw. |
|
449 ] |
|
450 |
|
451 "Modified: 7.11.1995 / 17:45:13 / cg" |
|
452 ! |
436 |
453 |
437 sizeChanged:how |
454 sizeChanged:how |
438 |nn no nf delta oldSize newSize| |
455 |nn no nf delta oldSize newSize| |
439 |
456 |
440 super sizeChanged:how. |
457 super sizeChanged:how. |
466 |
483 |
467 scale := height asFloat / (maxTotal + 100000). |
484 scale := height asFloat / (maxTotal + 100000). |
468 ]. |
485 ]. |
469 self clear. |
486 self clear. |
470 self redraw. |
487 self redraw. |
471 ! |
|
472 |
|
473 keyPress:key x:x y:y |
|
474 key == $f ifTrue:[ |
|
475 "faster" |
|
476 updateInterval := updateInterval / 2 |
|
477 ]. |
|
478 key == $s ifTrue:[ |
|
479 "slower" |
|
480 updateInterval := updateInterval * 2 |
|
481 ]. |
|
482 key == $r ifTrue:[ |
|
483 "reset max" |
|
484 maxTotal := prevTotal. |
|
485 scale := height asFloat / (maxTotal + 100000). |
|
486 self resetStatisticValues. |
|
487 self redraw. |
|
488 ] |
|
489 |
|
490 "Modified: 7.11.1995 / 17:45:13 / cg" |
|
491 ! ! |
488 ! ! |
492 |
489 |
493 !MemoryMonitor methodsFor:'initialization'! |
490 !MemoryMonitor methodsFor:'initialization'! |
|
491 |
|
492 initialize |
|
493 super initialize. |
|
494 |
|
495 updateInterval := 0.5. |
|
496 ProcessorScheduler isPureEventDriven ifTrue:[ |
|
497 updateBlock := [self updateDisplay]. |
|
498 ]. |
|
499 oldData := Array new:1000. |
|
500 newData := Array new:1000. |
|
501 freeData := Array new:1000. |
|
502 |
|
503 updateIndex := 1. |
|
504 org := font widthOf:'max 99999k'. |
|
505 level := 0. |
|
506 |
|
507 maxTotal := minTotal := ObjectMemory oldSpaceSize |
|
508 + ObjectMemory symSpaceSize |
|
509 + ObjectMemory newSpaceSize. |
|
510 |
|
511 viewBackground := Black. |
|
512 |
|
513 device hasColors ifTrue:[ |
|
514 newColor := Color orange. "/ yellow. |
|
515 freeColor := Color green. |
|
516 oldColor := Color white. |
|
517 ] ifFalse:[ |
|
518 newColor := Color grey:67. |
|
519 freeColor := Color grey:33. |
|
520 oldColor := Color white. |
|
521 ]. |
|
522 |
|
523 self font:(Font family:'courier' face:'medium' style:'roman' size:10). |
|
524 |
|
525 self model:self. |
|
526 self menu:#memoryMenu |
|
527 |
|
528 " |
|
529 MemoryMonitor open |
|
530 " |
|
531 ! |
494 |
532 |
495 memoryMenu |
533 memoryMenu |
496 |labels selectors| |
534 |labels selectors| |
497 |
535 |
498 device ctrlDown ifTrue:[ |
536 device ctrlDown ifTrue:[ |
560 newColor := newColor on:device. |
598 newColor := newColor on:device. |
561 freeColor := freeColor on:device. |
599 freeColor := freeColor on:device. |
562 oldColor := oldColor on:device. |
600 oldColor := oldColor on:device. |
563 |
601 |
564 font := font on:device. |
602 font := font on:device. |
565 ! |
|
566 |
|
567 initialize |
|
568 super initialize. |
|
569 |
|
570 updateInterval := 0.5. |
|
571 ProcessorScheduler isPureEventDriven ifTrue:[ |
|
572 updateBlock := [self updateDisplay]. |
|
573 ]. |
|
574 oldData := Array new:1000. |
|
575 newData := Array new:1000. |
|
576 freeData := Array new:1000. |
|
577 |
|
578 updateIndex := 1. |
|
579 org := font widthOf:'max 99999k'. |
|
580 level := 0. |
|
581 |
|
582 maxTotal := minTotal := ObjectMemory oldSpaceSize |
|
583 + ObjectMemory symSpaceSize |
|
584 + ObjectMemory newSpaceSize. |
|
585 |
|
586 viewBackground := Black. |
|
587 |
|
588 device hasColors ifTrue:[ |
|
589 newColor := Color orange. "/ yellow. |
|
590 freeColor := Color green. |
|
591 oldColor := Color white. |
|
592 ] ifFalse:[ |
|
593 newColor := Color grey:67. |
|
594 freeColor := Color grey:33. |
|
595 oldColor := Color white. |
|
596 ]. |
|
597 |
|
598 self font:(Font family:'courier' face:'medium' style:'roman' size:10). |
|
599 |
|
600 self model:self. |
|
601 self menu:#memoryMenu |
|
602 |
|
603 " |
|
604 MemoryMonitor open |
|
605 " |
|
606 ! ! |
603 ! ! |
607 |
604 |
608 !MemoryMonitor methodsFor:'menu functions'! |
605 !MemoryMonitor methodsFor:'menu functions'! |
|
606 |
|
607 backgroundCollect |
|
608 "start a background (non disturbing) incremental GC. |
|
609 Since the GC is performed at a low priority, it may not make progress if higher |
|
610 prio processes are running" |
|
611 |
|
612 [ |
|
613 ObjectMemory incrementalGC |
|
614 ] forkAt:5 |
|
615 ! |
609 |
616 |
610 cleanupMemory |
617 cleanupMemory |
611 "let all classes release unneeded, cached |
618 "let all classes release unneeded, cached |
612 data ..." |
619 data ..." |
613 |
620 |
622 finally, compress |
629 finally, compress |
623 " |
630 " |
624 ObjectMemory verboseGarbageCollect. |
631 ObjectMemory verboseGarbageCollect. |
625 ! |
632 ! |
626 |
633 |
627 resetStatisticValues |
634 compressSources |
628 ObjectMemory resetMaxInterruptLatency. |
635 Smalltalk compressSources. |
629 ObjectMemory resetMinScavengeReclamation. |
636 ObjectMemory markAndSweep |
630 |
637 ! |
631 "Created: 7.11.1995 / 17:44:59 / cg" |
638 |
|
639 compressingGarbageCollect |
|
640 "perform a blocking compressing garbage collect." |
|
641 |
|
642 ObjectMemory verboseGarbageCollect |
632 ! |
643 ! |
633 |
644 |
634 garbageCollect |
645 garbageCollect |
635 "perform a blocking (non compressing) garbage collect" |
646 "perform a blocking (non compressing) garbage collect" |
636 |
647 |
640 garbageCollectAndSymbols |
651 garbageCollectAndSymbols |
641 "perform a blocking (non compressing) garbage collect |
652 "perform a blocking (non compressing) garbage collect |
642 and reclaim unreferenced symbols." |
653 and reclaim unreferenced symbols." |
643 |
654 |
644 ObjectMemory reclaimSymbols |
655 ObjectMemory reclaimSymbols |
645 ! |
|
646 |
|
647 compressingGarbageCollect |
|
648 "perform a blocking compressing garbage collect." |
|
649 |
|
650 ObjectMemory verboseGarbageCollect |
|
651 ! |
|
652 |
|
653 scavenge |
|
654 "perform a blocking newspace garbage collect. |
|
655 (this is for debugging only - the system does this automatically)" |
|
656 |
|
657 ObjectMemory scavenge |
|
658 ! |
|
659 |
|
660 tenure |
|
661 "empty the newSpace, by aging all new objects immediately and transfering them |
|
662 into oldSpace. |
|
663 (this is for debugging only - the system does this automatically)" |
|
664 |
|
665 ObjectMemory tenure |
|
666 ! |
|
667 |
|
668 compressSources |
|
669 Smalltalk compressSources. |
|
670 ObjectMemory markAndSweep |
|
671 ! |
656 ! |
672 |
657 |
673 incrementalCollect |
658 incrementalCollect |
674 "start an incremental GC which does not disturb too much, but is guaranteed to |
659 "start an incremental GC which does not disturb too much, but is guaranteed to |
675 make progress. |
660 make progress. |
679 [ |
664 [ |
680 [ObjectMemory gcStep] whileFalse:[(Delay forMilliseconds:1) wait] |
665 [ObjectMemory gcStep] whileFalse:[(Delay forMilliseconds:1) wait] |
681 ] forkAt:Processor highestPriority |
666 ] forkAt:Processor highestPriority |
682 ! |
667 ! |
683 |
668 |
684 backgroundCollect |
669 resetStatisticValues |
685 "start a background (non disturbing) incremental GC. |
670 ObjectMemory resetMaxInterruptLatency. |
686 Since the GC is performed at a low priority, it may not make progress if higher |
671 ObjectMemory resetMinScavengeReclamation. |
687 prio processes are running" |
672 |
688 |
673 "Created: 7.11.1995 / 17:44:59 / cg" |
689 [ |
674 ! |
690 ObjectMemory incrementalGC |
675 |
691 ] forkAt:5 |
676 scavenge |
692 ! ! |
677 "perform a blocking newspace garbage collect. |
|
678 (this is for debugging only - the system does this automatically)" |
|
679 |
|
680 ObjectMemory scavenge |
|
681 ! |
|
682 |
|
683 tenure |
|
684 "empty the newSpace, by aging all new objects immediately and transfering them |
|
685 into oldSpace. |
|
686 (this is for debugging only - the system does this automatically)" |
|
687 |
|
688 ObjectMemory tenure |
|
689 ! ! |
|
690 |
|
691 !MemoryMonitor class methodsFor:'documentation'! |
|
692 |
|
693 version |
|
694 ^ '$Header: /cvs/stx/stx/libtool/MemoryMonitor.st,v 1.29 1995-12-18 14:23:08 cg Exp $' |
|
695 ! ! |