ObjectMemory.st
author Claus Gittinger <cg@exept.de>
Tue, 14 Nov 1995 20:02:34 +0100
changeset 544 d78012b20769
parent 532 2511c99de912
child 615 e9d0e782206d
permissions -rw-r--r--
*** empty log message ***
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     1
"
5
67342904af11 *** empty log message ***
claus
parents: 3
diff changeset
     2
 COPYRIGHT (c) 1992 by Claus Gittinger
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
     3
	      All Rights Reserved
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
     4
a27a279701f8 Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
a27a279701f8 Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
a27a279701f8 Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
a27a279701f8 Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
a27a279701f8 Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
a27a279701f8 Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
a27a279701f8 Initial revision
claus
parents:
diff changeset
    11
"
a27a279701f8 Initial revision
claus
parents:
diff changeset
    12
a27a279701f8 Initial revision
claus
parents:
diff changeset
    13
Object subclass:#ObjectMemory
a27a279701f8 Initial revision
claus
parents:
diff changeset
    14
       instanceVariableNames:''
2
claus
parents: 1
diff changeset
    15
       classVariableNames:'InternalErrorHandler UserInterruptHandler TimerInterruptHandler
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
    16
			   SpyInterruptHandler StepInterruptHandler ExceptionInterruptHandler
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
    17
			   ErrorInterruptHandler MemoryInterruptHandler SignalInterruptHandler
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
    18
			   ChildSignalInterruptHandler DisposeInterruptHandler
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
    19
			   RecursionInterruptHandler IOInterruptHandler
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
    20
			   CustomInterruptHandler
345
claus
parents: 339
diff changeset
    21
			   RegisteredErrorInterruptHandlers
496
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
    22
			   InterruptLatencyMonitor
2
claus
parents: 1
diff changeset
    23
464
83af924c8cff differenciate between object-allocation-failure and malloc-allocation-failure
Claus Gittinger <cg@exept.de>
parents: 458
diff changeset
    24
			   AllocationFailureSignal MallocFailureSignal LowSpaceSemaphore
310
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
    25
			   IncrementalGCLimit FreeSpaceGCLimit FreeSpaceGCAmount 
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
    26
			   BackgroundCollectProcess BackgroundFinalizationProcess
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
    27
			   FinalizationSemaphore
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
    28
			   Dependents
525
5d725316fd4a allow setting the change-file-name
Claus Gittinger <cg@exept.de>
parents: 510
diff changeset
    29
			   ImageName ChangeFileName
493
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
    30
496
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
    31
			   MaxInterruptLatency InterruptLatencyGoal'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
    32
       poolDictionaries:''
a27a279701f8 Initial revision
claus
parents:
diff changeset
    33
       category:'System-Support'
a27a279701f8 Initial revision
claus
parents:
diff changeset
    34
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
    35
2
claus
parents: 1
diff changeset
    36
!ObjectMemory class methodsFor:'documentation'!
claus
parents: 1
diff changeset
    37
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    38
copyright
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    39
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    40
 COPYRIGHT (c) 1992 by Claus Gittinger
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
    41
	      All Rights Reserved
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    42
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    43
 This software is furnished under a license and may be used
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    44
 only in accordance with the terms of that license and with the
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    45
 inclusion of the above copyright notice.   This software may not
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    46
 be provided or otherwise made available to, or used by, any
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    47
 other person.  No title to or ownership of the software is
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    48
 hereby transferred.
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    49
"
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    50
!
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    51
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    52
version
532
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
    53
    ^ '$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.77 1995-11-13 09:08:12 stefan Exp $'
88
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    54
!
81dacba7a63a *** empty log message ***
claus
parents: 85
diff changeset
    55
2
claus
parents: 1
diff changeset
    56
documentation
claus
parents: 1
diff changeset
    57
"
403
claus
parents: 384
diff changeset
    58
    This class contains access methods to the system memory and the VM.
claus
parents: 384
diff changeset
    59
claus
parents: 384
diff changeset
    60
    In previous ST/X versions, this stuff used to be in the Smalltalk class.
claus
parents: 384
diff changeset
    61
    It has been separated for better overall class structure and modularisation.
229
210ee6865aa3 commenting
claus
parents: 216
diff changeset
    62
    There are no instances of ObjectMemory - all is done in class methods.
403
claus
parents: 384
diff changeset
    63
    (this is a functional interface).
claus
parents: 384
diff changeset
    64
claus
parents: 384
diff changeset
    65
    Many methods here are for debuging purposes, for developers
claus
parents: 384
diff changeset
    66
    or experimental, and therefore not standard.
68
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
    67
    Do not depend on them being there - some may vanish ...
59faa75185ba *** empty log message ***
claus
parents: 56
diff changeset
    68
    (especially those, that depend on a specific GC implementation)
403
claus
parents: 384
diff changeset
    69
    Most of the stuff found here is not available, or different or called
claus
parents: 384
diff changeset
    70
    different in other smalltalk implementations. Be aware, that using these
claus
parents: 384
diff changeset
    71
    interfaces (especially: depending on them) may make your application
claus
parents: 384
diff changeset
    72
    non portable.
claus
parents: 384
diff changeset
    73
claus
parents: 384
diff changeset
    74
    See more documentation in -> caching
claus
parents: 384
diff changeset
    75
			      -> interrupts
claus
parents: 384
diff changeset
    76
			      -> garbageCollection
2
claus
parents: 1
diff changeset
    77
229
210ee6865aa3 commenting
claus
parents: 216
diff changeset
    78
    Class variables:
2
claus
parents: 1
diff changeset
    79
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
    80
	InternalErrorHandler            gets informed (by VM), when some runtime
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
    81
					error occurs (usually fatal)
2
claus
parents: 1
diff changeset
    82
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
    83
	UserInterruptHandler            gets informed (by VM) when CNTL-C is pressed
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
    84
	TimerInterruptHandler           gets alarm timer interrupts (from VM)
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
    85
	SpyInterruptHandler             another alarm timer (from VM)
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
    86
	StepInterruptHandler            gets single step interrupts (from VM)
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
    87
	ExceptionInterruptHandler       gets floating point exceptions (from VM)
345
claus
parents: 339
diff changeset
    88
	ErrorInterruptHandler           gets primitive errors (from VM)
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
    89
	MemoryInterruptHandler          gets soon-out-of-memory conditions (from VM)
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
    90
	SignalInterruptHandler          gets unix signals (from VM)
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
    91
	ChildSignalInterruptHandler     gets child death signals (from VM)
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
    92
	DisposeInterruptHandler         gets informed, when an object is disposed from 
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
    93
					a shadowArray (from VM)
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
    94
	RecursionInterruptHandler       gets recursion limit violations (from VM)
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
    95
	IOInterruptHandler              gets SIGIO unix signals (from VM)
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
    96
	CustomInterruptHandler          gets custom interrupts (from VM)
2
claus
parents: 1
diff changeset
    97
504
ac74e0dfe630 typo fixed
Claus Gittinger <cg@exept.de>
parents: 503
diff changeset
    98
	InterruptLatencyMonitor         if nonNil, that one will be notified (by the VM)
ac74e0dfe630 typo fixed
Claus Gittinger <cg@exept.de>
parents: 503
diff changeset
    99
					with an interruptLatency:millis message for every 
493
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
   100
					interrupt and gets the delay time
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
   101
					(between the time when the signal arrived and
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
   102
					 when it was really delivered) as argument.
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
   103
					This can be used to create a statistic for
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
   104
					realtime systems.
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
   105
345
claus
parents: 339
diff changeset
   106
	RegisteredErrorInterruptHandlers
claus
parents: 339
diff changeset
   107
					associates errorID (as passed from primitive
claus
parents: 339
diff changeset
   108
					to the __errorInterruptWithID() function)
claus
parents: 339
diff changeset
   109
					with handlers.
claus
parents: 339
diff changeset
   110
270
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
   111
	IncrementalGCLimit              number of bytes, that must be allocated since
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
   112
					last full garbage collect to turn the incremental
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
   113
					collector on (at idle time).
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
   114
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
   115
	FreeSpaceGCLimit                low limit on freeSpace at which incremental
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
   116
					gc starts to run at idle time.
270
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
   117
310
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
   118
	FreeSpaceGCAmount               amount to allocate once freeSpace drops
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
   119
					below FreeSpaceGCLimit
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
   120
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
   121
	Dependents                      keep my dependents locally (its faster) for
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
   122
					all those registries
270
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
   123
213
3b56a17534fd *** empty log message ***
claus
parents: 211
diff changeset
   124
	LowSpaceSemaphore               a semaphore signalled whenever the system is
3b56a17534fd *** empty log message ***
claus
parents: 211
diff changeset
   125
					running in low memory (i.e. the memory manager
3b56a17534fd *** empty log message ***
claus
parents: 211
diff changeset
   126
					ran into memory shortage and feels that it
3b56a17534fd *** empty log message ***
claus
parents: 211
diff changeset
   127
					may soon be no longer grant allocation requests).
3b56a17534fd *** empty log message ***
claus
parents: 211
diff changeset
   128
					You can have a process waiting on this semaphore
3b56a17534fd *** empty log message ***
claus
parents: 211
diff changeset
   129
					which starts to remove (i.e. nil-out) objects
3b56a17534fd *** empty log message ***
claus
parents: 211
diff changeset
   130
					or preform other cleanup actions.
3b56a17534fd *** empty log message ***
claus
parents: 211
diff changeset
   131
                                        
3b56a17534fd *** empty log message ***
claus
parents: 211
diff changeset
   132
	AllocationFailureSignal         signal raised when a new fails (see Behavior)
3b56a17534fd *** empty log message ***
claus
parents: 211
diff changeset
   133
					When this signal is raised, the meomory manager
3b56a17534fd *** empty log message ***
claus
parents: 211
diff changeset
   134
					is really in trouble (i.e. above feelings where
3b56a17534fd *** empty log message ***
claus
parents: 211
diff changeset
   135
					correct)
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
   136
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
   137
	BackgroundCollectProcess        created by startBackgroundCollectorAt:
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
   138
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
   139
	BackgroundFinalizationProcess   created by startBackgroundFinalizationAt:
403
claus
parents: 384
diff changeset
   140
claus
parents: 384
diff changeset
   141
    Warning:
claus
parents: 384
diff changeset
   142
      The InterruptHandler variables are known by the runtime system -
claus
parents: 384
diff changeset
   143
      they are the objects that get an interrupt message when the event
claus
parents: 384
diff changeset
   144
      occurs. You may not remove any of them.
2
claus
parents: 1
diff changeset
   145
"
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   146
!
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   147
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   148
caching
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   149
"
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   150
    The system uses various caches to speed up method-lookup.
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   151
    Currently, there is a three-level cache hierarchy:
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   152
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
   153
	inline-cache            keeps the target of the last send at the caller-
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
   154
				side (i.e. every send goes through its private 
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
   155
				1-slot inline-cache, where the address of the last
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
   156
				called function at this call location is kept.)
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   157
229
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   158
	polymorph-inline-cache  keeps a limited list of all targets ever reached 
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   159
				at this call location. The list is automatically 
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   160
				flushed if it grows too large, or the overall number
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   161
				of poly-chache entries exceeds a limit.
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   162
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
   163
	method-lookup-cache     a global cache. Hashes on class-selector pairs,
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
   164
				returning the target method.
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   165
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   166
    Whenever methods are added or removed from the system, or the inheritance 
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   167
    hierarchy changes, some or all caches have to be flushed.
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
   168
    The flushXXX methods perform the task of flushing various caches.
207
claus
parents: 202
diff changeset
   169
    All standard methods in Behavior call for cache flushing, when things change;
229
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   170
    however, if you use the low level access methods in Behavior
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   171
    (for example: #setSuperclass:) special care has to be taken.
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   172
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   173
    In some situations, not all caches need flushing, for example a change
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   174
    in an interpreted method (currently) needs no flushing of the inline caches.
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   175
    Also, flushing can be limited to entries for a specific class for most changes.
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   176
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
   177
    To be 'on the brigth side of live', use ObjectMemory>>flushCaches (which
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
   178
    flushes all of them), when in doubt of which caches should be flushed. 
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
   179
    It is better flush too much - otherwise you may end up in a wrong method after 
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
   180
    a send.
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   181
"
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   182
!
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   183
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   184
interrupts
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   185
"
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   186
    Handling of interrupts (i.e. unix-signals) is done via handler objects, which
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   187
    get a #XXXInterrupt-message sent. This is more flexible than (say) signalling
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   188
    a semaphore, since the handler-object may do anything to react on the signal
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   189
    (of course, it can also signal a semaphore to emulate the above behavior).
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   190
229
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   191
    Another reason for having handler objects is that they allow interrupt handling
207
claus
parents: 202
diff changeset
   192
    without any context switch, for high speed interrupt response.
403
claus
parents: 384
diff changeset
   193
    However, if you do this, special care is needed, since it is not defined, 
claus
parents: 384
diff changeset
   194
    which process gets the interrupt and will do the processing (therefore,
claus
parents: 384
diff changeset
   195
    the default setup installs handlers which simply signal a semaphore and
claus
parents: 384
diff changeset
   196
    continue the running process).
claus
parents: 384
diff changeset
   197
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   198
    Typically, the handlers are set during early initialization of the system
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
   199
    by sending 'ObjectMemory XXXInterruptHandler:aHandler' and not changed later.
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
   200
    (see Smalltalk>>initialize or ProcessorScheduler>>initialize).
207
claus
parents: 202
diff changeset
   201
    To setup your own handler, create some object which responds to #xxxInterrupt,
claus
parents: 202
diff changeset
   202
    and make it the handler using the above method.
claus
parents: 202
diff changeset
   203
claus
parents: 202
diff changeset
   204
    Interrupt messages sent to handlers are:
claus
parents: 202
diff changeset
   205
	internalError:<someString>      - internal interpreter/GC errors
claus
parents: 202
diff changeset
   206
	userInterrupt                   - ^C interrupt
claus
parents: 202
diff changeset
   207
	customInterrupt                 - custom interrupt
claus
parents: 202
diff changeset
   208
	ioInterrupt                     - SIGIO interrupt
229
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   209
	timerInterrupt                  - alarm timer (SIGALRM)
345
claus
parents: 339
diff changeset
   210
	errorInterrupt:<id>             - errors from other primitives/subsystems
claus
parents: 339
diff changeset
   211
					  (DisplayError)
229
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   212
	spyInterrupt                    - spy timer interrupt (SIGVTALARM)
207
claus
parents: 202
diff changeset
   213
	stepInterrupt                   - single step interrupt
claus
parents: 202
diff changeset
   214
	disposeInterrupt                - finalization required
claus
parents: 202
diff changeset
   215
	recursionInterrupt              - recursion (stack) overflow
claus
parents: 202
diff changeset
   216
	memoryInterrupt                 - soon running out of memory
229
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   217
	fpExceptionInterrupt            - floating point exception (SIGFPE)
207
claus
parents: 202
diff changeset
   218
	childSignalInterrupt            - death of a child process (SIGCHILD)
claus
parents: 202
diff changeset
   219
	signalInterrupt:<number>        - unix signal (if other than above signals)
403
claus
parents: 384
diff changeset
   220
claus
parents: 384
diff changeset
   221
    To avoid frustration in case of badly set handlers, these messages
claus
parents: 384
diff changeset
   222
    are also implemented in the Object class - thus anything can be defined
claus
parents: 384
diff changeset
   223
    as interrupt handler. However, the VM will not send any
claus
parents: 384
diff changeset
   224
    interrupt message, if the corresonding handler object is nil
claus
parents: 384
diff changeset
   225
    (which means that nil is a bad choice, if you are interrested in the event).
claus
parents: 384
diff changeset
   226
claus
parents: 384
diff changeset
   227
    Interrupt processing is not immediately after the event arrives: there
claus
parents: 384
diff changeset
   228
    are certain ``save-places'' at which this handling is performed
claus
parents: 384
diff changeset
   229
    (message send, method return and loop-heads).
claus
parents: 384
diff changeset
   230
    If not explicitely enabled, primitive code is never interrupted.
claus
parents: 384
diff changeset
   231
claus
parents: 384
diff changeset
   232
    Interrupts may be disabled (OperatingSystem blockInterrupts) and reenabled
claus
parents: 384
diff changeset
   233
    (unblockInterrupts) to allow for critical data to be manipulated.
claus
parents: 384
diff changeset
   234
    Every process has its own interrupt-enable state which is switched
claus
parents: 384
diff changeset
   235
    when processes switch control (i.e. you cannot block interrupts across
claus
parents: 384
diff changeset
   236
    a suspend, delay etc.). However, the state will be restored after a resume.
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   237
"
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   238
!
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   239
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   240
garbageCollection
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   241
"
403
claus
parents: 384
diff changeset
   242
    Currently, Smalltalk/X uses a two-level memory hierachy (actually, there
claus
parents: 384
diff changeset
   243
    are more memory regions used for stack, permanent objects, symbols etc.
claus
parents: 384
diff changeset
   244
    but for the following discussion, these are not of interrest).
claus
parents: 384
diff changeset
   245
claus
parents: 384
diff changeset
   246
  newSpace:
claus
parents: 384
diff changeset
   247
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   248
    Objects are created in a so-called newSpace, which is relatively small.
403
claus
parents: 384
diff changeset
   249
    This newSpace is cleaned by a so called ``scavenge''-operation, whenever 
claus
parents: 384
diff changeset
   250
    becoming full. Scavenging means, that all still-live objects (i.e. referenced
claus
parents: 384
diff changeset
   251
    by some other) are copied over to another memory area, leaving all unreachable
claus
parents: 384
diff changeset
   252
    objects as garbage behind. Thus, the newSpace actually consists of two semispaces,
claus
parents: 384
diff changeset
   253
    of whih only one is active - the other being used only while objects are
claus
parents: 384
diff changeset
   254
    copied.
claus
parents: 384
diff changeset
   255
    After this copying, these two semispaces exchange their roles - i.e. reachable
claus
parents: 384
diff changeset
   256
    objects are copied ping-pong like between these semispaces.
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
   257
    Once an object survives enough of these copying operations, the next scavenge 
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   258
    will move it into the so called oldSpace, which is much larger, and not
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
   259
    processed by the scavenger. 
403
claus
parents: 384
diff changeset
   260
    This movement of an object from newSpace to oldSpace is called ``tenure''.
claus
parents: 384
diff changeset
   261
    (this avoids objects being copied around forever).
claus
parents: 384
diff changeset
   262
    Once tenured, an object is no longer contained in the newSpace, and
claus
parents: 384
diff changeset
   263
    thus ceases to create any scavenging overhead after that.
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
   264
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   265
    Scavenging occurs automatically, and is usually done fast enough to go 
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   266
    unnoticed (typically, it takes some 5 to 50ms to perform a scavenge, 
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   267
    depending on how many live objects are in the newspace).
403
claus
parents: 384
diff changeset
   268
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   269
    Interrestingly, the scavenger performs better, if many garbage objects
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   270
    are to be reclaimed, since less object-copying has to be done. Therefore,
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   271
    the best-case scavenge time is almost zero, if there is only garbage in
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   272
    the newSpace. In contrast, the worst-case is when all newSpace objects are still
403
claus
parents: 384
diff changeset
   273
    living. Thus, from a newSpace collectors viewPoint, it makes sense to get
claus
parents: 384
diff changeset
   274
    objects out of the way as fast as possible. However the oldSpace is
claus
parents: 384
diff changeset
   275
    collected much less frequently and the cost to reclaim an oldspace object
claus
parents: 384
diff changeset
   276
    is much higher (actually, the cost to reclaim a newspace object is zero -
claus
parents: 384
diff changeset
   277
    its the survival of objects which we have to pay for).
claus
parents: 384
diff changeset
   278
    Therefore, from an oldSpace collectors point of view, its preferable to
claus
parents: 384
diff changeset
   279
    keep objects in the newSpace as long as possible.
claus
parents: 384
diff changeset
   280
claus
parents: 384
diff changeset
   281
    To honor this conflicting situation, the system uses an adaptive tenure-count,
207
claus
parents: 202
diff changeset
   282
    which adjusts the number of scavenges required for tenure (the so called 
claus
parents: 202
diff changeset
   283
    'tenureAge') according to the fill-grade of the newSpace.
403
claus
parents: 384
diff changeset
   284
    If the newSpace is relatively empty, it tries to keep objects longer there.
claus
parents: 384
diff changeset
   285
    The controlling parameters of the tenure age can be changed dynamically,
claus
parents: 384
diff changeset
   286
    detailed information is available upon request.
claus
parents: 384
diff changeset
   287
claus
parents: 384
diff changeset
   288
    The exact speed of the scavenger depends mostly on the speed of your memory
claus
parents: 384
diff changeset
   289
    interface (and, since most of todays memories have access times in the order
claus
parents: 384
diff changeset
   290
    of 50-100ns, the raw CPU speed does not correlate linear with the GC speed).
claus
parents: 384
diff changeset
   291
    Measurements give roughly 40-70ms for a full 400k newSpace 
claus
parents: 384
diff changeset
   292
    (i.e. all objects survive).
claus
parents: 384
diff changeset
   293
    The upper bounds of the scavenge blocking time can be controlled by changing
claus
parents: 384
diff changeset
   294
    the size of the newSpace - ether via acommand line argument, or even dynamically
claus
parents: 384
diff changeset
   295
    by Objectmemory>>newSpaceSize:. Smaller sizes lead to shorter blocking periods,
claus
parents: 384
diff changeset
   296
    but greater absolute GC overhead. The default (400k) seems to be a good compromise.
claus
parents: 384
diff changeset
   297
    (if you are not happy with it, try playing around with the settings)
claus
parents: 384
diff changeset
   298
claus
parents: 384
diff changeset
   299
  oldSpace:
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   300
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   301
    To reclaim oldspace, the system uses three algorithms: mark&sweep, a copying
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   302
    (and compressing) baker-type collector and an incremental mark&sweep.
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   303
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   304
    The mark&sweep runs whenever the oldspace becomes full, putting dead objects
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   305
    onto a free list. If a memory request cannot be served from this freelist,
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   306
    and the total size of objects on the freelist exceeds a threshold, the system
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   307
    will compress the oldspace to make the free-space into one big area.
207
claus
parents: 202
diff changeset
   308
    This compress is done by copying all live objects into a newly allocated
claus
parents: 202
diff changeset
   309
    area, and freeing the previous memory afterwards (baker collector).
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   310
    Since a compressing oldspace collect leads to a noticable pause of the system,
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   311
    the memory manager tries hard to avoid oldspace compression.
207
claus
parents: 202
diff changeset
   312
    (actually, if enough real memory is available to hold both spaces in physical
claus
parents: 202
diff changeset
   313
     memory, the compress is pretty fast).
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
   314
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   315
    The incremental mark&sweep runs in the background, whenever the system is idle
403
claus
parents: 384
diff changeset
   316
    (see ProcessorSceduler>>waitForEventOrTimeout), or alternatively as a low or high
claus
parents: 384
diff changeset
   317
    priority background process (see ObjectMemory>>startBackgroundCollector). 
362
claus
parents: 360
diff changeset
   318
    Like the normal mark&sweep, this incremental collector follows object references 
claus
parents: 360
diff changeset
   319
    and marks reachable objects on its way. However, this is done 'a few objects-at-a-time',
claus
parents: 360
diff changeset
   320
    to not disrupt the system noticably. Currently, there are some (theoretical) and in
403
claus
parents: 384
diff changeset
   321
    practice never occurring situations, in which the incremental GC still creates noticable
claus
parents: 384
diff changeset
   322
    delays. A current project is involved with this and a future versions of ST/X (ST/X-RT)
claus
parents: 384
diff changeset
   323
    will be available which shows deterministic worst case behavior in its GC pauses 
claus
parents: 384
diff changeset
   324
    (this will be provided as an additional add-on option - certainly not for free ;-).
claus
parents: 384
diff changeset
   325
    Currently, incremental GC blockings are in the order of 10-70ms.
claus
parents: 384
diff changeset
   326
    There is one catch with low priority background IGC: if there is never any idle
claus
parents: 384
diff changeset
   327
    time available (i.e. all processes run all the time), it would never get a chance
claus
parents: 384
diff changeset
   328
    to do any collection work. To handle this case, a background IGC can also be started
claus
parents: 384
diff changeset
   329
    as a high priority process, which gives up the cpu (by delaying on the time) after
claus
parents: 384
diff changeset
   330
    every IGC step. A high priority background collector will always make progress
claus
parents: 384
diff changeset
   331
    and eventually finish a GC cycle. However, it may have more of an influence on 
claus
parents: 384
diff changeset
   332
    the other processes. So, its up to you, to decide ...
362
claus
parents: 360
diff changeset
   333
claus
parents: 360
diff changeset
   334
    Incremental garbage collection is controlled by the variables 
claus
parents: 360
diff changeset
   335
    'IncrementalGCLimit', 'FreeSpaceGCLimit' and 'FreeSpaceGCAmount':
310
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
   336
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
   337
      the ProcessorScheduler will perform incremental GC steps at idle time, 
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
   338
      if the total space allocated since the last full collect exceeds 
362
claus
parents: 360
diff changeset
   339
      'IncrementalGCLimit',
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
   340
      or if there are less than 'FreeSpaceGCLimit' bytes available in free store.
362
claus
parents: 360
diff changeset
   341
      If after the incrementalGC, less than 'FreeSpaceGCLimi't bytes are available,
310
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
   342
      'FreeSpaceGCAmount' more bytes are requested from the memory manager.
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
   343
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
   344
    The defaults are set in ObjectMemory>>initialize and can be changed in your 
403
claus
parents: 384
diff changeset
   345
    startup 'smalltalk.rc'-file. Setting them to nil turns incremental GC off.
270
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
   346
362
claus
parents: 360
diff changeset
   347
    For example, setting 'IncrementalGCLimit' to 500000 will start the background collector
207
claus
parents: 202
diff changeset
   348
    whenever 500k bytes have been allocated - usually very seldom. Setting it to some
claus
parents: 202
diff changeset
   349
    small number (say 10000) will have it run very often.
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
   350
362
claus
parents: 360
diff changeset
   351
    Setting 'FreeSpaceGCAmount' to (say) 1meg lets the system try to always keep
403
claus
parents: 384
diff changeset
   352
    1meg of freeSpace. If less memory is available, more oldSpace will be allocated.
claus
parents: 384
diff changeset
   353
    Keeping some memory in the pocket may prevent the system from running into a blocking
claus
parents: 384
diff changeset
   354
    GC if memory is allocated in peaks (but only, if the incremental GC can keep up with 
claus
parents: 384
diff changeset
   355
    allocation rate). The trigger level 'FreeSpaceGCLimit' should be below that amount;
310
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
   356
    to avoid excessive incremental GC activity (say 1/4 if the amount).
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
   357
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
   358
    Having the background GC running often should not hurt the performance of your 
362
claus
parents: 360
diff changeset
   359
    smalltalk processes, since the IGC only runs at times when no ST processes are runnable. 
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
   360
    (there are some short delays in event processing, since the IGC's steps may take 
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
   361
    some XX ms.) 
270
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
   362
    However, if you are not alone on your machine (i.e. a timesharing system) or 
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
   363
    you have other Unix processes to run, you should not run the IGC too often, 
362
claus
parents: 360
diff changeset
   364
    since it may hurt OTHER users/unix processes.
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   365
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   366
    Since this collector only runs at idle times, even a low priority background 
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   367
    process will prevent it from doing its work. You may want to start a somewhat
207
claus
parents: 202
diff changeset
   368
    higher priority background collect (say at prio 4), which also preempts these
claus
parents: 202
diff changeset
   369
    background processes. (see ObjectMemory>>startBackgroundCollectorAt:).
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
   370
325
claus
parents: 324
diff changeset
   371
    Beginning with 2.10.4, a third space, called symSpace has been added.
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   372
    Objects in this space are never moved or garbage collected.
325
claus
parents: 324
diff changeset
   373
    This space is used for (some) symbols only.
claus
parents: 324
diff changeset
   374
claus
parents: 324
diff changeset
   375
    Beginning with 2.10.5, a fourth space, called fixSpace has been added.
claus
parents: 324
diff changeset
   376
    Objects in this space are never moved or garbage collected.
claus
parents: 324
diff changeset
   377
    This space is used for constant objects (true, false, some basic classes etc.).
229
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   378
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   379
    A plan for 2.11 is to offer an arbitrary number of spaces, which can be
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   380
    attached and detached at runtime. This will allow easy share of object
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   381
    with remote systems and separating objects into a per application/package
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   382
    space. (be prepared for changes in the future and make your application
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   383
    independ of the VM internals)
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   384
403
claus
parents: 384
diff changeset
   385
  default setup:
claus
parents: 384
diff changeset
   386
claus
parents: 384
diff changeset
   387
    The following table lists some default settings and means for changing them:
claus
parents: 384
diff changeset
   388
claus
parents: 384
diff changeset
   389
	    what        default     change by           
claus
parents: 384
diff changeset
   390
				    command line arg    dynamically
claus
parents: 384
diff changeset
   391
    -----------------------------------------------------------------------
claus
parents: 384
diff changeset
   392
	newSpace size     400k      -Mnew nnn           newSpaceSize:nnn
claus
parents: 384
diff changeset
   393
claus
parents: 384
diff changeset
   394
	oldSpace size    3000k      -Mold nnn           moreOldSpace:
claus
parents: 384
diff changeset
   395
							announceSpaceNeed:
claus
parents: 384
diff changeset
   396
							collectGarbage
claus
parents: 384
diff changeset
   397
claus
parents: 384
diff changeset
   398
	max tenure age     29                           lockTenure:
claus
parents: 384
diff changeset
   399
							avoidTenure:
claus
parents: 384
diff changeset
   400
							(sets it to infinity)
claus
parents: 384
diff changeset
   401
        
claus
parents: 384
diff changeset
   402
	adaptive tenure                                 tenureParameters
claus
parents: 384
diff changeset
   403
claus
parents: 384
diff changeset
   404
	oldSpace
claus
parents: 384
diff changeset
   405
	compressor      enabled     -Msingle            -
claus
parents: 384
diff changeset
   406
claus
parents: 384
diff changeset
   407
	limit for
claus
parents: 384
diff changeset
   408
	old-compress     8000k      -                   oldSpaceCompressLimit:
claus
parents: 384
diff changeset
   409
claus
parents: 384
diff changeset
   410
	chunk size
claus
parents: 384
diff changeset
   411
	to increase
claus
parents: 384
diff changeset
   412
	oldpPace          256k      -                   oldSpaceIncrement:
claus
parents: 384
diff changeset
   413
        
claus
parents: 384
diff changeset
   414
	prefer moreOld
claus
parents: 384
diff changeset
   415
	to doing GC      false      -                   fastMoreOldSpaceAllocation:
claus
parents: 384
diff changeset
   416
claus
parents: 384
diff changeset
   417
	limit for
claus
parents: 384
diff changeset
   418
	above                -      -                   fastMoreOldSpaceLimit:
claus
parents: 384
diff changeset
   419
claus
parents: 384
diff changeset
   420
	keep size for        -      -                   freeSpaceGCAmount:
claus
parents: 384
diff changeset
   421
	IGC
claus
parents: 384
diff changeset
   422
claus
parents: 384
diff changeset
   423
	low water
claus
parents: 384
diff changeset
   424
	trigger for IGC      -      -                   freeSpaceGCLimit:
claus
parents: 384
diff changeset
   425
claus
parents: 384
diff changeset
   426
	allocated
claus
parents: 384
diff changeset
   427
	trigger for IGC   500k      -                   incrementalGCLimit
claus
parents: 384
diff changeset
   428
claus
parents: 384
diff changeset
   429
        
claus
parents: 384
diff changeset
   430
    By default, no incremental GC activity is started.
claus
parents: 384
diff changeset
   431
    You have to change your startup files to do this. A suggested configuration
claus
parents: 384
diff changeset
   432
    (used by the author) is:
claus
parents: 384
diff changeset
   433
claus
parents: 384
diff changeset
   434
	' keep 1meg in the pocket '
claus
parents: 384
diff changeset
   435
claus
parents: 384
diff changeset
   436
	ObjectMemory freeSpaceGCAmount:1000000. 
claus
parents: 384
diff changeset
   437
claus
parents: 384
diff changeset
   438
	' start incrementalGC when freespace drops below 250k '
claus
parents: 384
diff changeset
   439
	' or 500k of oldSpace has been allocated              '
claus
parents: 384
diff changeset
   440
claus
parents: 384
diff changeset
   441
	ObjectMemory freeSpaceGCLimit:250000.                 '
claus
parents: 384
diff changeset
   442
	ObjectMemory incrementalGCLimit:500000.               '
claus
parents: 384
diff changeset
   443
claus
parents: 384
diff changeset
   444
	' collect as a background process (the default is: at idle times)
claus
parents: 384
diff changeset
   445
	' this means that running cubes or other demo processes are suspended
claus
parents: 384
diff changeset
   446
	' for the collect; change the prio to below 4 if you want them to continue
claus
parents: 384
diff changeset
   447
claus
parents: 384
diff changeset
   448
	ObjectMemory startBackgroundCollectorAt:5.            '
claus
parents: 384
diff changeset
   449
	ObjectMemory startBackgroundFinalizationAt:5.         '
claus
parents: 384
diff changeset
   450
claus
parents: 384
diff changeset
   451
	' quickly allocate more space (i.e. avoid blocking collects)
claus
parents: 384
diff changeset
   452
	' up to 8meg - then start to collect if more memory is needed.
claus
parents: 384
diff changeset
   453
claus
parents: 384
diff changeset
   454
	ObjectMemory fastMoreOldSpaceLimit:8*1024*1024.       '
claus
parents: 384
diff changeset
   455
	ObjectMemory fastMoreOldSpaceAllocation:true.         '
claus
parents: 384
diff changeset
   456
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
   457
  hints & tricks:
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
   458
213
3b56a17534fd *** empty log message ***
claus
parents: 211
diff changeset
   459
    normally, there is no need to call for an explicit garbage collection, or
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   460
    modify the default parameters.
213
3b56a17534fd *** empty log message ***
claus
parents: 211
diff changeset
   461
    The memory system should adapt reasonable and provide good performance 
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
   462
    for a wide range of allocation patterns (see Example3 below for an exception).
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
   463
207
claus
parents: 202
diff changeset
   464
    However, there may be situations, in which hints and/or explicit
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
   465
    control over allocation can speedup your programs; but please:
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   466
207
claus
parents: 202
diff changeset
   467
      - if you think you have to play around with the memory policies,
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
   468
	first check your program - you may find useless allocations
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
   469
	or bad uses of collections. A typical error that is made is to
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
   470
	create large collections using the #, (comma) concatenation method,
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
   471
	which shows square behavior, since it allocates many, many temporary
213
3b56a17534fd *** empty log message ***
claus
parents: 211
diff changeset
   472
	collections. Also, watch out for #copyWith:, #add: etc.
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
   473
	All of these create a new collection. Remember, that most collections
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
   474
	offer methods to preallocate some space; for example, 'Set new:' creates
229
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   475
	an empty set, but preallocates space to avoid resizing over and over.
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   476
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   477
	An especially bad performace dog is to use #add: on fix-size collection
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   478
	objects (such as Strings or Arrays), since in addition to allocating
229
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   479
	lots of garbage, a #become: operation is required for EACH element
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   480
	added. NEVER use Arrays for growing/shrinking data - use OrderedCollection
229
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   481
	instead. (if you really need an array, use asArray afterwards)
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
   482
207
claus
parents: 202
diff changeset
   483
      - if you are going to allocate huge data structures, think about
claus
parents: 202
diff changeset
   484
	optimizing space. For example, if you allocate a million instances of
213
3b56a17534fd *** empty log message ***
claus
parents: 211
diff changeset
   485
	some object, each added instance variable makes up 4Mb of additional 
3b56a17534fd *** empty log message ***
claus
parents: 211
diff changeset
   486
	memory need.
207
claus
parents: 202
diff changeset
   487
	Also, for Byte-valued, Integer-valued and Float like objects, special
claus
parents: 202
diff changeset
   488
	collections are provided, which store their values directly inside (instead
claus
parents: 202
diff changeset
   489
	of a reference to the object). A FloatArray consisting of 1 million floats
213
3b56a17534fd *** empty log message ***
claus
parents: 211
diff changeset
   490
	requires about 4mb of memory, while an Array of Floats requires 4mb for the
3b56a17534fd *** empty log message ***
claus
parents: 211
diff changeset
   491
	references to the floats, PLUS 20Mb for the floats themself.
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   492
207
claus
parents: 202
diff changeset
   493
      - check if you really need fast access to all of these objects; you may
claus
parents: 202
diff changeset
   494
	try to only keep some subset in memory, and use binary storage or
claus
parents: 202
diff changeset
   495
	(if this is too slow) optimized store/retrieve methods and keep the bigger
229
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   496
	part in a file. 
362
claus
parents: 360
diff changeset
   497
	(How about a DiskArray class, which does this transparently ?
229
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   498
	 See the FileText class for some ideas and something to start with ...)
207
claus
parents: 202
diff changeset
   499
claus
parents: 202
diff changeset
   500
claus
parents: 202
diff changeset
   501
    Hint / Example 1: 
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   502
      you are about to allocate a huge data structure, which is known to
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   503
      survive long. In this case, it is better to have these objects move into the
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   504
      oldspace sooner, to avoid the copying overhead during scavenges.
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   505
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   506
      To do this, you can call ObjectMemory>>tenure after allocation, which
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   507
      forces all new-objects immediately into the oldspace. 
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   508
      Make certain, that not to many (ideally no) short-living objects are in the
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   509
      newspace when doing this.
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   510
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   511
      Another alternative is to tell the system that all allocation should be
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   512
      done directly in the oldspace. This completely avoids the scavenging overhead
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   513
      for these objects. To do so, use ObjectMemory>>turnGarbageCollectorOff
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   514
      before the allocation, and ObjectMemory>>turnGarbageCollectorOn afterwards.
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
   515
      Keep in mind, that do-loops may allocate block-objects and other temporaries,
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
   516
      so there is a danger of making things worse due to having all those temporaries
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   517
      in the oldspace afterwards. (which is not a fatal situation, but will
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
   518
      force the system to do an oldspace collect earlier, which may not be your
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
   519
      intention).
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   520
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
   521
207
claus
parents: 202
diff changeset
   522
   Hint / Example 2:
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   523
      you know in advance, that a certain (big) amount of memory will be needed.
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   524
      For example, the fileBrowser wants to show a huge file in its text-view.
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
   525
      In this case, it is better to tell the memory system in advance, how much
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   526
      memory will be needed, since otherwise many compresses and reallocations will
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
   527
      occur (the memory system will allocate additional memory in chunks of smaller
433d44af1630 more GC control
claus
parents: 93
diff changeset
   528
      256k pieces, if a compress failes. Thus, if you are going to allocate (say) 1Mb of 
433d44af1630 more GC control
claus
parents: 93
diff changeset
   529
      strings, it will perform 5 compressing GC's).
433d44af1630 more GC control
claus
parents: 93
diff changeset
   530
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
   531
      This is done using ObjectMemory>>moreOldSpace: or ObjectMemory announceSpaceNeed:.
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
   532
      In the above example, you would do 'ObjectMemory announceSpaceNeed:500000', which 
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
   533
      avoids those annoying 5 compressing GC's.
207
claus
parents: 202
diff changeset
   534
      BTW: if you have other smalltalk processes (threads) running which should not be
claus
parents: 202
diff changeset
   535
      paused if possible, it is better to use #announceSpaceNeed. This tries to avoid 
claus
parents: 202
diff changeset
   536
      pausing in other processes and sometimes succeeds, while moreOldSpace will always 
claus
parents: 202
diff changeset
   537
      block the whole system for a while. However, there is no 'no-pause' guarantee.
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
   538
433d44af1630 more GC control
claus
parents: 93
diff changeset
   539
      The amount of automatic increase (in case the oldSpace becomes full) is 256k by
433d44af1630 more GC control
claus
parents: 93
diff changeset
   540
      default. This number can be changed with ObjectMemory>>oldSpaceIncrement:.
433d44af1630 more GC control
claus
parents: 93
diff changeset
   541
207
claus
parents: 202
diff changeset
   542
claus
parents: 202
diff changeset
   543
    Hint / Example3:
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
   544
      There are rare cases, when an explicit GC makes a difference: since
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
   545
      object finalization is done at GC time, objects which keep operatingSystem
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
   546
      resources may be finalized late. This is normally no problem, except if
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
   547
      the system is running out of resources. For example, allocating new colors
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
   548
      may fail if many colors have already been allocated in the past - even
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
   549
      though these colors are actually free. The Depth8Image calls for an
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
   550
      explicit GC, whenever it fails to allocate a color for a bitmap, to force
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
   551
      finalization of free, but not yet finalized colors.
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
   552
207
claus
parents: 202
diff changeset
   553
claus
parents: 202
diff changeset
   554
    Hint 4:
claus
parents: 202
diff changeset
   555
      If you run in too small of physical memory, the incremental GC may have a
claus
parents: 202
diff changeset
   556
      bad effect on your working set: since it touches pages (which may otherwise
claus
parents: 202
diff changeset
   557
      not be needed at the moment, the operating system is forced to steal other
claus
parents: 202
diff changeset
   558
      (possibly more useful) pages from your set of incore pages.
claus
parents: 202
diff changeset
   559
      You may get better performance, if you turn off the incremental GC while
claus
parents: 202
diff changeset
   560
      processing a big data structure.
claus
parents: 202
diff changeset
   561
claus
parents: 202
diff changeset
   562
229
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   563
    Warning: many of the methods found here are not standard and may not even be available in
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
   564
    future versions of ST/X. Use them only in very special situations or experiments.
229
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   565
207
claus
parents: 202
diff changeset
   566
    Let me know about additional special features you think are useful, and about
claus
parents: 202
diff changeset
   567
    special features you are using - this provides the feedback required to decide
403
claus
parents: 384
diff changeset
   568
    which methods are to be removed, kept or enhanced in future versions.
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   569
"
2
claus
parents: 1
diff changeset
   570
! !
claus
parents: 1
diff changeset
   571
claus
parents: 1
diff changeset
   572
!ObjectMemory class methodsFor:'initialization'!
claus
parents: 1
diff changeset
   573
claus
parents: 1
diff changeset
   574
initialize
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
   575
    "initialize the class"
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
   576
2
claus
parents: 1
diff changeset
   577
    AllocationFailureSignal isNil ifTrue:[
302
1f76060d58a4 *** empty log message ***
claus
parents: 293
diff changeset
   578
	AllocationFailureSignal := ErrorSignal newSignalMayProceed:true.
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
   579
	AllocationFailureSignal nameClass:self message:#allocationFailureSignal.
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
   580
	AllocationFailureSignal notifierString:'allocation failure'.
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
   581
465
fdc81f5887a1 made mallocFailureSignal a child of allocationFailureSignal
Claus Gittinger <cg@exept.de>
parents: 464
diff changeset
   582
	MallocFailureSignal := AllocationFailureSignal newSignalMayProceed:true.
464
83af924c8cff differenciate between object-allocation-failure and malloc-allocation-failure
Claus Gittinger <cg@exept.de>
parents: 458
diff changeset
   583
	MallocFailureSignal nameClass:self message:#mallocFailureSignal.
83af924c8cff differenciate between object-allocation-failure and malloc-allocation-failure
Claus Gittinger <cg@exept.de>
parents: 458
diff changeset
   584
	MallocFailureSignal notifierString:'(malloc) allocation failure'.
83af924c8cff differenciate between object-allocation-failure and malloc-allocation-failure
Claus Gittinger <cg@exept.de>
parents: 458
diff changeset
   585
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
   586
	LowSpaceSemaphore := Semaphore new.
2
claus
parents: 1
diff changeset
   587
    ].
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
   588
    DisposeInterruptHandler := self.
2
claus
parents: 1
diff changeset
   589
    IncrementalGCLimit := 500000.
310
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
   590
    FreeSpaceGCLimit := FreeSpaceGCAmount := nil.
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   591
    MemoryInterruptHandler := self
2
claus
parents: 1
diff changeset
   592
! !
claus
parents: 1
diff changeset
   593
345
claus
parents: 339
diff changeset
   594
!ObjectMemory class methodsFor:'Signal constants'!
2
claus
parents: 1
diff changeset
   595
claus
parents: 1
diff changeset
   596
allocationFailureSignal
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   597
    "return the signal raised when an object allocation failed"
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   598
2
claus
parents: 1
diff changeset
   599
    ^ AllocationFailureSignal
464
83af924c8cff differenciate between object-allocation-failure and malloc-allocation-failure
Claus Gittinger <cg@exept.de>
parents: 458
diff changeset
   600
!
83af924c8cff differenciate between object-allocation-failure and malloc-allocation-failure
Claus Gittinger <cg@exept.de>
parents: 458
diff changeset
   601
83af924c8cff differenciate between object-allocation-failure and malloc-allocation-failure
Claus Gittinger <cg@exept.de>
parents: 458
diff changeset
   602
mallocFailureSignal
83af924c8cff differenciate between object-allocation-failure and malloc-allocation-failure
Claus Gittinger <cg@exept.de>
parents: 458
diff changeset
   603
    "return the signal raised when malloc memory allocation failed.
83af924c8cff differenciate between object-allocation-failure and malloc-allocation-failure
Claus Gittinger <cg@exept.de>
parents: 458
diff changeset
   604
     (usually, this kind of memory is used with I/O buffers or other temporary
83af924c8cff differenciate between object-allocation-failure and malloc-allocation-failure
Claus Gittinger <cg@exept.de>
parents: 458
diff changeset
   605
      non-Object storage)"
83af924c8cff differenciate between object-allocation-failure and malloc-allocation-failure
Claus Gittinger <cg@exept.de>
parents: 458
diff changeset
   606
83af924c8cff differenciate between object-allocation-failure and malloc-allocation-failure
Claus Gittinger <cg@exept.de>
parents: 458
diff changeset
   607
    ^ MallocFailureSignal
2
claus
parents: 1
diff changeset
   608
! !
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   609
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
   610
!ObjectMemory class methodsFor:'semaphore access'!
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
   611
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
   612
lowSpaceSemaphore
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
   613
    "return the semaphore that is signalled when the system detects a
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
   614
     low space condition. Usually, some time after this, an allocationFailure
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
   615
     will happen. You can have a cleanup process sitting in that semaphore and
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
   616
     start to release object."
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
   617
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
   618
    ^ LowSpaceSemaphore
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
   619
! !
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
   620
375
claus
parents: 370
diff changeset
   621
!ObjectMemory class methodsFor:'VM messages'!
claus
parents: 370
diff changeset
   622
claus
parents: 370
diff changeset
   623
infoPrinting:aBoolean
claus
parents: 370
diff changeset
   624
    "turn on/off various informational printouts in the VM.
claus
parents: 370
diff changeset
   625
     For example, the GC activity messages are controlled by
claus
parents: 370
diff changeset
   626
     this flags setting.
claus
parents: 370
diff changeset
   627
     The default is true, since (currently) those messages
claus
parents: 370
diff changeset
   628
     are useful for ST/X developers."
claus
parents: 370
diff changeset
   629
claus
parents: 370
diff changeset
   630
%{  /* NOCONTEXT */
claus
parents: 370
diff changeset
   631
    extern int __infoPrinting;
claus
parents: 370
diff changeset
   632
claus
parents: 370
diff changeset
   633
    __infoPrinting = (aBoolean == true);
claus
parents: 370
diff changeset
   634
%}
claus
parents: 370
diff changeset
   635
!
claus
parents: 370
diff changeset
   636
claus
parents: 370
diff changeset
   637
infoPrinting
claus
parents: 370
diff changeset
   638
    "return true, if various informational printouts in the VM
claus
parents: 370
diff changeset
   639
     are turned on, false of off."
claus
parents: 370
diff changeset
   640
claus
parents: 370
diff changeset
   641
%{  /* NOCONTEXT */
claus
parents: 370
diff changeset
   642
    extern int __infoPrinting;
claus
parents: 370
diff changeset
   643
claus
parents: 370
diff changeset
   644
    RETURN (__infoPrinting ? true : false);
claus
parents: 370
diff changeset
   645
%}
claus
parents: 370
diff changeset
   646
!
claus
parents: 370
diff changeset
   647
claus
parents: 370
diff changeset
   648
debugPrinting:aBoolean
claus
parents: 370
diff changeset
   649
    "turn on/off various debug printouts in the VM
claus
parents: 370
diff changeset
   650
     in case of an error. For example, a double-notUnderstood
claus
parents: 370
diff changeset
   651
     leads to a VM context dump if debugPrinting is on.
claus
parents: 370
diff changeset
   652
     If off, those messages are suppressed.
claus
parents: 370
diff changeset
   653
     The default is on, since these messages are only printed for
claus
parents: 370
diff changeset
   654
     severe errors."
claus
parents: 370
diff changeset
   655
claus
parents: 370
diff changeset
   656
%{  /* NOCONTEXT */
claus
parents: 370
diff changeset
   657
    extern int __debugPrinting;
claus
parents: 370
diff changeset
   658
claus
parents: 370
diff changeset
   659
    __debugPrinting = (aBoolean == true);
claus
parents: 370
diff changeset
   660
%}
claus
parents: 370
diff changeset
   661
!
claus
parents: 370
diff changeset
   662
claus
parents: 370
diff changeset
   663
debugPrinting
claus
parents: 370
diff changeset
   664
    "return true, if various debug printouts in the VM
claus
parents: 370
diff changeset
   665
     are turned on, false of off."
claus
parents: 370
diff changeset
   666
claus
parents: 370
diff changeset
   667
%{  /* NOCONTEXT */
claus
parents: 370
diff changeset
   668
    extern int __debugPrinting;
claus
parents: 370
diff changeset
   669
claus
parents: 370
diff changeset
   670
    RETURN (__debugPrinting ? true : false);
claus
parents: 370
diff changeset
   671
%}
claus
parents: 370
diff changeset
   672
! !
claus
parents: 370
diff changeset
   673
10
claus
parents: 5
diff changeset
   674
!ObjectMemory class methodsFor:'dependents access'!
claus
parents: 5
diff changeset
   675
claus
parents: 5
diff changeset
   676
dependents
claus
parents: 5
diff changeset
   677
    "return the colleciton of my dependents"
claus
parents: 5
diff changeset
   678
claus
parents: 5
diff changeset
   679
    ^ Dependents
claus
parents: 5
diff changeset
   680
!
claus
parents: 5
diff changeset
   681
claus
parents: 5
diff changeset
   682
dependents:aCollection
claus
parents: 5
diff changeset
   683
    "set the dependents collection"
claus
parents: 5
diff changeset
   684
claus
parents: 5
diff changeset
   685
    Dependents := aCollection
282
94f5c3a6230d *** empty log message ***
claus
parents: 270
diff changeset
   686
!
94f5c3a6230d *** empty log message ***
claus
parents: 270
diff changeset
   687
94f5c3a6230d *** empty log message ***
claus
parents: 270
diff changeset
   688
dependentsDo:aBlock
94f5c3a6230d *** empty log message ***
claus
parents: 270
diff changeset
   689
    "evaluate aBlock for all of my dependents.
94f5c3a6230d *** empty log message ***
claus
parents: 270
diff changeset
   690
     Since this is performed at startup time (under the scheduler),
94f5c3a6230d *** empty log message ***
claus
parents: 270
diff changeset
   691
     this is redefined here to catch abort signals.
94f5c3a6230d *** empty log message ***
claus
parents: 270
diff changeset
   692
     Thus, if any error occurs in a #returnFromSnapshot,
94f5c3a6230d *** empty log message ***
claus
parents: 270
diff changeset
   693
     the user can press abort to continue."
94f5c3a6230d *** empty log message ***
claus
parents: 270
diff changeset
   694
94f5c3a6230d *** empty log message ***
claus
parents: 270
diff changeset
   695
    |deps|
94f5c3a6230d *** empty log message ***
claus
parents: 270
diff changeset
   696
94f5c3a6230d *** empty log message ***
claus
parents: 270
diff changeset
   697
    deps := Dependents.
94f5c3a6230d *** empty log message ***
claus
parents: 270
diff changeset
   698
    deps notNil ifTrue:[
94f5c3a6230d *** empty log message ***
claus
parents: 270
diff changeset
   699
	deps do:[:each |
94f5c3a6230d *** empty log message ***
claus
parents: 270
diff changeset
   700
	    AbortSignal handle:[:ex |
94f5c3a6230d *** empty log message ***
claus
parents: 270
diff changeset
   701
		ex return       
94f5c3a6230d *** empty log message ***
claus
parents: 270
diff changeset
   702
	    ] do:[
94f5c3a6230d *** empty log message ***
claus
parents: 270
diff changeset
   703
		aBlock value:each
94f5c3a6230d *** empty log message ***
claus
parents: 270
diff changeset
   704
	    ]
94f5c3a6230d *** empty log message ***
claus
parents: 270
diff changeset
   705
	]
94f5c3a6230d *** empty log message ***
claus
parents: 270
diff changeset
   706
    ]
10
claus
parents: 5
diff changeset
   707
! !
claus
parents: 5
diff changeset
   708
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   709
!ObjectMemory class methodsFor:'cache management'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   710
a27a279701f8 Initial revision
claus
parents:
diff changeset
   711
flushInlineCachesForClass:aClass
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   712
    "flush inlinecaches for calls to aClass."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   713
a27a279701f8 Initial revision
claus
parents:
diff changeset
   714
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   715
    __flushInlineCachesFor(aClass);
a27a279701f8 Initial revision
claus
parents:
diff changeset
   716
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   717
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   718
a27a279701f8 Initial revision
claus
parents:
diff changeset
   719
flushInlineCachesWithArgs:nargs
a27a279701f8 Initial revision
claus
parents:
diff changeset
   720
    "flush inlinecaches for calls with nargs arguments"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   721
a27a279701f8 Initial revision
claus
parents:
diff changeset
   722
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   723
    __flushInlineCaches(_intVal(nargs));
a27a279701f8 Initial revision
claus
parents:
diff changeset
   724
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   725
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   726
a27a279701f8 Initial revision
claus
parents:
diff changeset
   727
flushInlineCachesFor:aClass withArgs:nargs
a27a279701f8 Initial revision
claus
parents:
diff changeset
   728
    "flush inlinecaches for calls to aClass with nargs arguments"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   729
a27a279701f8 Initial revision
claus
parents:
diff changeset
   730
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   731
    __flushInlineCachesForAndNargs(aClass, _intVal(nargs));
a27a279701f8 Initial revision
claus
parents:
diff changeset
   732
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   733
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   734
332
claus
parents: 329
diff changeset
   735
flushInlineCachesForSelector:aSelector
claus
parents: 329
diff changeset
   736
    "flush inlinecaches for sends of aSelector"
claus
parents: 329
diff changeset
   737
claus
parents: 329
diff changeset
   738
%{  /* NOCONTEXT */
claus
parents: 329
diff changeset
   739
    __flushInlineCachesForSelector(aSelector);
claus
parents: 329
diff changeset
   740
%}
claus
parents: 329
diff changeset
   741
!
claus
parents: 329
diff changeset
   742
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   743
flushInlineCaches
a27a279701f8 Initial revision
claus
parents:
diff changeset
   744
    "flush all inlinecaches"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   745
a27a279701f8 Initial revision
claus
parents:
diff changeset
   746
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   747
    __flushAllInlineCaches();
a27a279701f8 Initial revision
claus
parents:
diff changeset
   748
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   749
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   750
a27a279701f8 Initial revision
claus
parents:
diff changeset
   751
flushMethodCacheFor:aClass
a27a279701f8 Initial revision
claus
parents:
diff changeset
   752
    "flush the method cache for sends to aClass"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   753
a27a279701f8 Initial revision
claus
parents:
diff changeset
   754
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   755
    __flushMethodCacheFor(aClass);
a27a279701f8 Initial revision
claus
parents:
diff changeset
   756
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   757
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   758
332
claus
parents: 329
diff changeset
   759
flushMethodCacheForSelector:aSelector
claus
parents: 329
diff changeset
   760
    "flush the method cache for sends of aSelector"
claus
parents: 329
diff changeset
   761
claus
parents: 329
diff changeset
   762
%{  /* NOCONTEXT */
claus
parents: 329
diff changeset
   763
    __flushMethodCacheForSelector(aSelector);
claus
parents: 329
diff changeset
   764
%}
claus
parents: 329
diff changeset
   765
!
claus
parents: 329
diff changeset
   766
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   767
flushMethodCache
a27a279701f8 Initial revision
claus
parents:
diff changeset
   768
    "flush the method cache"
a27a279701f8 Initial revision
claus
parents:
diff changeset
   769
a27a279701f8 Initial revision
claus
parents:
diff changeset
   770
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   771
    __flushMethodCache();
a27a279701f8 Initial revision
claus
parents:
diff changeset
   772
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
   773
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
   774
2
claus
parents: 1
diff changeset
   775
flushCachesFor:aClass
claus
parents: 1
diff changeset
   776
    "flush method and inline caches for aClass"
claus
parents: 1
diff changeset
   777
claus
parents: 1
diff changeset
   778
%{  /* NOCONTEXT */
claus
parents: 1
diff changeset
   779
    __flushMethodCacheFor(aClass);
claus
parents: 1
diff changeset
   780
    __flushInlineCachesFor(aClass);
claus
parents: 1
diff changeset
   781
%}
claus
parents: 1
diff changeset
   782
!
claus
parents: 1
diff changeset
   783
332
claus
parents: 329
diff changeset
   784
flushCachesForSelector:aSelector
440
claus
parents: 438
diff changeset
   785
    "flush method and inline caches for aSelector"
332
claus
parents: 329
diff changeset
   786
claus
parents: 329
diff changeset
   787
%{  /* NOCONTEXT */
claus
parents: 329
diff changeset
   788
    __flushMethodCacheForSelector(aSelector);
claus
parents: 329
diff changeset
   789
    __flushInlineCachesForSelector(aSelector);
claus
parents: 329
diff changeset
   790
%}
claus
parents: 329
diff changeset
   791
!
claus
parents: 329
diff changeset
   792
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   793
flushCaches
2
claus
parents: 1
diff changeset
   794
    "flush method and inline caches for all classes"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   795
a27a279701f8 Initial revision
claus
parents:
diff changeset
   796
%{  /* NOCONTEXT */
a27a279701f8 Initial revision
claus
parents:
diff changeset
   797
    __flushMethodCache();
a27a279701f8 Initial revision
claus
parents:
diff changeset
   798
    __flushAllInlineCaches();
a27a279701f8 Initial revision
claus
parents:
diff changeset
   799
%}
532
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   800
!
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   801
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   802
trapRestrictedMethods:trap
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   803
    "Allow/Deny execution of restricted Methods (see Method>>>restricted:)
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   804
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   805
     Notice: method restriction is a nonstandard feature, not supported
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   806
     by other smalltalk implementations and not specified in the ANSI spec.
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   807
     This is EXPERIMENTAL - and being evaluated for usability.
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   808
     It may change or even vanish (if it shows to be not useful)."
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   809
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   810
    |oldTrap|
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   811
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   812
%{ 
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   813
	if (__setTrapRestrictedMethods(trap == true))
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   814
	    oldTrap = true;
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   815
	else
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   816
	    oldTrap = false;
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   817
%}.
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   818
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   819
    (trap and:[oldTrap not]) ifTrue:[
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   820
	self flushCaches
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   821
    ].
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   822
    ^ oldTrap
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   823
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   824
    "
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   825
	ObjectMemory trapRestrictedMethods:true
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   826
	ObjectMemory trapRestrictedMethods:false
2511c99de912 New code to trap restricted (RT) methods.
Stefan Vogel <sv@exept.de>
parents: 530
diff changeset
   827
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   828
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   829
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
   830
!ObjectMemory class methodsFor:'enumerating'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   831
a27a279701f8 Initial revision
claus
parents:
diff changeset
   832
allObjectsDo:aBlock
85
claus
parents: 77
diff changeset
   833
    "evaluate the argument, aBlock for all objects in the system.
claus
parents: 77
diff changeset
   834
     There is one caveat: if a compressing oldSpace collect
claus
parents: 77
diff changeset
   835
     occurs while looping over the objects, the loop cannot be
claus
parents: 77
diff changeset
   836
     continued (for some internal reasons). In this case, false
claus
parents: 77
diff changeset
   837
     is returned."
2
claus
parents: 1
diff changeset
   838
claus
parents: 1
diff changeset
   839
    |work|
22
847106305963 *** empty log message ***
claus
parents: 13
diff changeset
   840
847106305963 *** empty log message ***
claus
parents: 13
diff changeset
   841
%{  /* NOREGISTER - work may not be placed into a register here */
326
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
   842
    __nonTenuringScavenge(__context);
2
claus
parents: 1
diff changeset
   843
    /*
claus
parents: 1
diff changeset
   844
     * allObjectsDo needs a temporary to hold newSpace objects
claus
parents: 1
diff changeset
   845
     */
369
claus
parents: 362
diff changeset
   846
    if (__allInstancesOfDo((OBJ *)0, &aBlock, &work COMMA_CON) < 0) {
claus
parents: 362
diff changeset
   847
	RETURN (false);
claus
parents: 362
diff changeset
   848
    }
claus
parents: 362
diff changeset
   849
%}.
claus
parents: 362
diff changeset
   850
    ^ true
claus
parents: 362
diff changeset
   851
!
claus
parents: 362
diff changeset
   852
claus
parents: 362
diff changeset
   853
allInstancesOf:aClass do:aBlock
claus
parents: 362
diff changeset
   854
    "evaluate the argument, aBlock for all instances of aClass in the system.
claus
parents: 362
diff changeset
   855
     There is one caveat: if a compressing oldSpace collect
claus
parents: 362
diff changeset
   856
     occurs while looping over the objects, the loop cannot be
claus
parents: 362
diff changeset
   857
     continued (for some internal reasons). In this case, false
claus
parents: 362
diff changeset
   858
     is returned."
claus
parents: 362
diff changeset
   859
claus
parents: 362
diff changeset
   860
    |work|
claus
parents: 362
diff changeset
   861
claus
parents: 362
diff changeset
   862
%{  /* NOREGISTER - work may not be placed into a register here */
claus
parents: 362
diff changeset
   863
    __nonTenuringScavenge(__context);
claus
parents: 362
diff changeset
   864
    /*
claus
parents: 362
diff changeset
   865
     * allInstancesDo needs a temporary to hold newSpace objects
claus
parents: 362
diff changeset
   866
     */
claus
parents: 362
diff changeset
   867
    if (__allInstancesOfDo(&aClass, &aBlock, &work COMMA_CON) < 0) {
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
   868
	RETURN (false);
85
claus
parents: 77
diff changeset
   869
    }
claus
parents: 77
diff changeset
   870
%}.
claus
parents: 77
diff changeset
   871
    ^ true
2
claus
parents: 1
diff changeset
   872
!
claus
parents: 1
diff changeset
   873
claus
parents: 1
diff changeset
   874
allOldObjectsDo:aBlock
claus
parents: 1
diff changeset
   875
    "evaluate the argument, aBlock for all old objects in the system.
claus
parents: 1
diff changeset
   876
     For debugging and tests only - do not use"
claus
parents: 1
diff changeset
   877
%{
369
claus
parents: 362
diff changeset
   878
    if (__allInstancesOfDo((OBJ *)0, &aBlock, (OBJ *)0 COMMA_CON) < 0) {
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
   879
	RETURN (false);
85
claus
parents: 77
diff changeset
   880
    }
claus
parents: 77
diff changeset
   881
%}. 
claus
parents: 77
diff changeset
   882
    ^ true
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
   883
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
   884
229
210ee6865aa3 commenting
claus
parents: 216
diff changeset
   885
!ObjectMemory class methodsFor:'interrupt handler access'!
2
claus
parents: 1
diff changeset
   886
claus
parents: 1
diff changeset
   887
internalErrorHandler
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   888
    "return the handler for ST/X internal errors.
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   889
     An internal error is reported for example when a methods
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   890
     bytecode is not a ByteArray, the selector table is not an Array
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   891
     etc.  
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
   892
     Those should not occur in normal circumstances."
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   893
2
claus
parents: 1
diff changeset
   894
    ^ InternalErrorHandler
claus
parents: 1
diff changeset
   895
!
claus
parents: 1
diff changeset
   896
claus
parents: 1
diff changeset
   897
userInterruptHandler
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   898
    "return the handler for CNTL-C interrupt handling"
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   899
2
claus
parents: 1
diff changeset
   900
    ^ UserInterruptHandler
claus
parents: 1
diff changeset
   901
!
claus
parents: 1
diff changeset
   902
claus
parents: 1
diff changeset
   903
userInterruptHandler:aHandler
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   904
    "set the handler for CNTL-C interrupt handling"
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   905
2
claus
parents: 1
diff changeset
   906
    UserInterruptHandler := aHandler
claus
parents: 1
diff changeset
   907
!
claus
parents: 1
diff changeset
   908
claus
parents: 1
diff changeset
   909
timerInterruptHandler
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   910
    "return the handler for timer interrupts"
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   911
2
claus
parents: 1
diff changeset
   912
    ^ TimerInterruptHandler
claus
parents: 1
diff changeset
   913
!
claus
parents: 1
diff changeset
   914
10
claus
parents: 5
diff changeset
   915
timerInterruptHandler:aHandler
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   916
    "set the handler for timer interrupts"
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   917
10
claus
parents: 5
diff changeset
   918
    TimerInterruptHandler := aHandler
claus
parents: 5
diff changeset
   919
!
claus
parents: 5
diff changeset
   920
2
claus
parents: 1
diff changeset
   921
spyInterruptHandler
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   922
    "return the handler for spy-timer interrupts"
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   923
2
claus
parents: 1
diff changeset
   924
    ^ SpyInterruptHandler
claus
parents: 1
diff changeset
   925
!
claus
parents: 1
diff changeset
   926
claus
parents: 1
diff changeset
   927
spyInterruptHandler:aHandler
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   928
    "set the handler for spy-timer interrupts"
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   929
2
claus
parents: 1
diff changeset
   930
    SpyInterruptHandler := aHandler
claus
parents: 1
diff changeset
   931
!
claus
parents: 1
diff changeset
   932
claus
parents: 1
diff changeset
   933
stepInterruptHandler
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   934
    "return the handler for single step interrupts"
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   935
2
claus
parents: 1
diff changeset
   936
    ^ StepInterruptHandler
claus
parents: 1
diff changeset
   937
!
claus
parents: 1
diff changeset
   938
claus
parents: 1
diff changeset
   939
stepInterruptHandler:aHandler
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   940
    "set the handler for single step interrupts"
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   941
2
claus
parents: 1
diff changeset
   942
    StepInterruptHandler := aHandler
claus
parents: 1
diff changeset
   943
!
claus
parents: 1
diff changeset
   944
claus
parents: 1
diff changeset
   945
exceptionInterruptHandler
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   946
    "return the handler for floating point exception interrupts"
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   947
2
claus
parents: 1
diff changeset
   948
    ^ ExceptionInterruptHandler
claus
parents: 1
diff changeset
   949
!
claus
parents: 1
diff changeset
   950
claus
parents: 1
diff changeset
   951
errorInterruptHandler
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   952
    "return the handler for display error interrupts"
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   953
2
claus
parents: 1
diff changeset
   954
    ^ ErrorInterruptHandler
claus
parents: 1
diff changeset
   955
!
claus
parents: 1
diff changeset
   956
claus
parents: 1
diff changeset
   957
errorInterruptHandler:aHandler
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   958
    "set the handler for display error interrupts"
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   959
2
claus
parents: 1
diff changeset
   960
    ErrorInterruptHandler := aHandler
claus
parents: 1
diff changeset
   961
!
claus
parents: 1
diff changeset
   962
345
claus
parents: 339
diff changeset
   963
registeredErrorInterruptHandlers
claus
parents: 339
diff changeset
   964
    "return registered handlers"
claus
parents: 339
diff changeset
   965
claus
parents: 339
diff changeset
   966
    ^ RegisteredErrorInterruptHandlers
claus
parents: 339
diff changeset
   967
!
claus
parents: 339
diff changeset
   968
claus
parents: 339
diff changeset
   969
registerErrorInterruptHandler:aHandler forID:errorIDSymbol
claus
parents: 339
diff changeset
   970
    "register a handler"
claus
parents: 339
diff changeset
   971
claus
parents: 339
diff changeset
   972
    RegisteredErrorInterruptHandlers isNil ifTrue:[
claus
parents: 339
diff changeset
   973
	RegisteredErrorInterruptHandlers := IdentityDictionary new
claus
parents: 339
diff changeset
   974
    ].
claus
parents: 339
diff changeset
   975
    RegisteredErrorInterruptHandlers at:errorIDSymbol put:aHandler
claus
parents: 339
diff changeset
   976
!
claus
parents: 339
diff changeset
   977
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   978
signalInterruptHandler
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   979
    "return the handler for UNIX-signal interrupts"
2
claus
parents: 1
diff changeset
   980
claus
parents: 1
diff changeset
   981
    ^ SignalInterruptHandler
claus
parents: 1
diff changeset
   982
!
claus
parents: 1
diff changeset
   983
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   984
signalInterruptHandler:aHandler
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   985
    "set the handler for UNIX-signal interrupts"
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   986
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   987
    SignalInterruptHandler := aHandler
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   988
!
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   989
2
claus
parents: 1
diff changeset
   990
childSignalInterruptHandler
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   991
    "return the handler for UNIX-death-of-a-childprocess-signal interrupts"
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   992
2
claus
parents: 1
diff changeset
   993
    ^ ChildSignalInterruptHandler
claus
parents: 1
diff changeset
   994
!
claus
parents: 1
diff changeset
   995
claus
parents: 1
diff changeset
   996
disposeInterruptHandler
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   997
    "return the handler for object disposal interrupts"
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
   998
2
claus
parents: 1
diff changeset
   999
    ^ DisposeInterruptHandler
claus
parents: 1
diff changeset
  1000
!
claus
parents: 1
diff changeset
  1001
claus
parents: 1
diff changeset
  1002
disposeInterruptHandler:aHandler
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1003
    "set the handler for object disposal interrupts"
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1004
2
claus
parents: 1
diff changeset
  1005
    DisposeInterruptHandler := aHandler
claus
parents: 1
diff changeset
  1006
!
claus
parents: 1
diff changeset
  1007
claus
parents: 1
diff changeset
  1008
recursionInterruptHandler
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1009
    "return the handler for recursion/stack overflow interrupts"
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1010
2
claus
parents: 1
diff changeset
  1011
    ^ RecursionInterruptHandler
claus
parents: 1
diff changeset
  1012
!
claus
parents: 1
diff changeset
  1013
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1014
recursionInterruptHandler:aHandler
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1015
    "set the handler for recursion/stack overflow interrupts"
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1016
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1017
    RecursionInterruptHandler := aHandler
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1018
!
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1019
2
claus
parents: 1
diff changeset
  1020
ioInterruptHandler
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1021
    "return the handler for I/O available signal interrupts (SIGIO/SIGPOLL)"
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1022
2
claus
parents: 1
diff changeset
  1023
    ^ IOInterruptHandler
claus
parents: 1
diff changeset
  1024
!
claus
parents: 1
diff changeset
  1025
claus
parents: 1
diff changeset
  1026
ioInterruptHandler:aHandler
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1027
    "set the handler for I/O available signal interrupts (SIGIO/SIGPOLL)"
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1028
2
claus
parents: 1
diff changeset
  1029
    IOInterruptHandler := aHandler
85
claus
parents: 77
diff changeset
  1030
!
claus
parents: 77
diff changeset
  1031
claus
parents: 77
diff changeset
  1032
customInterruptHandler
claus
parents: 77
diff changeset
  1033
    "return the handler for custom interrupts"
claus
parents: 77
diff changeset
  1034
claus
parents: 77
diff changeset
  1035
    ^ CustomInterruptHandler
claus
parents: 77
diff changeset
  1036
!
claus
parents: 77
diff changeset
  1037
claus
parents: 77
diff changeset
  1038
customInterruptHandler:aHandler
claus
parents: 77
diff changeset
  1039
    "set the handler for custom interrupts"
claus
parents: 77
diff changeset
  1040
claus
parents: 77
diff changeset
  1041
    CustomInterruptHandler := aHandler
504
ac74e0dfe630 typo fixed
Claus Gittinger <cg@exept.de>
parents: 503
diff changeset
  1042
! !
ac74e0dfe630 typo fixed
Claus Gittinger <cg@exept.de>
parents: 503
diff changeset
  1043
ac74e0dfe630 typo fixed
Claus Gittinger <cg@exept.de>
parents: 503
diff changeset
  1044
!ObjectMemory class methodsFor:'interrupt statistics'!
493
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1045
496
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1046
interruptLatencyMonitor
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1047
    "return the interrupt-latency-monitor if any. 
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1048
     See comment in #interruptLatencyMonitor:.
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1049
     This is a non-standard debugging/realtime instrumentation entry."
494
794a64b1c6b9 renamed interruptDelayTimer to interruptDelayMonitor - sorry
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1050
504
ac74e0dfe630 typo fixed
Claus Gittinger <cg@exept.de>
parents: 503
diff changeset
  1051
    ^ InterruptLatencyMonitor
494
794a64b1c6b9 renamed interruptDelayTimer to interruptDelayMonitor - sorry
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1052
!
794a64b1c6b9 renamed interruptDelayTimer to interruptDelayMonitor - sorry
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1053
496
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1054
interruptLatencyMonitor:aHandler
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1055
    "set the interrupt latency monitor. If non-nil, this one will be sent
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1056
     an interruptLatency: message with the millisecond delay between
493
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1057
     the interrupt and its handling.
496
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1058
     This is a non-standard debugging/realtime instrumentation entry."
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1059
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1060
    InterruptLatencyMonitor := aHandler
504
ac74e0dfe630 typo fixed
Claus Gittinger <cg@exept.de>
parents: 503
diff changeset
  1061
!
493
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1062
510
89ddf1eb2ebd additional arg to latencyMonitor: searchclass
Claus Gittinger <cg@exept.de>
parents: 504
diff changeset
  1063
interruptLatency:ms receiver:rec class:cls selector:sel vmActivity:vmActivity
496
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1064
    "example implementation of latencyTime monitoring:
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1065
     This method simply measures the max-latency time.
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1066
     You may want to use some other handler (see #interruptLatencyMonitor:)
493
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1067
     and extract more information (blocking context).
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1068
     DEMO Example."
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1069
496
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1070
    ms > MaxInterruptLatency ifTrue:[
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1071
	MaxInterruptLatency := ms.
503
4df58bb2c1d1 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 502
diff changeset
  1072
	'IRQ-LATENCY: ' infoPrint. rec class infoPrint. ' ' infoPrint. sel infoPrint. '(' infoPrint. vmActivity infoPrint . ') ---> ' infoPrint. ms infoPrintNL.
496
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1073
    ].
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1074
    (InterruptLatencyGoal notNil and:[ms > InterruptLatencyGoal]) ifTrue:[
500
e5fd4f3c9f37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 499
diff changeset
  1075
	'*** IRQ REALTIME-DEADLINE MISSED: ' errorPrint. 
503
4df58bb2c1d1 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 502
diff changeset
  1076
	rec isBehavior ifTrue:[
4df58bb2c1d1 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 502
diff changeset
  1077
	    rec name errorPrint. 'class' errorPrint.
4df58bb2c1d1 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 502
diff changeset
  1078
	] ifFalse:[     
4df58bb2c1d1 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 502
diff changeset
  1079
	    rec class errorPrint
4df58bb2c1d1 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 502
diff changeset
  1080
	].
4df58bb2c1d1 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 502
diff changeset
  1081
	' ' errorPrint. sel errorPrint. '(' errorPrint. vmActivity errorPrint . ') ---> ' errorPrint. 
4df58bb2c1d1 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 502
diff changeset
  1082
	ms errorPrintNL.
496
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1083
    ].
493
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1084
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1085
    "to enable the demo handler:
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1086
496
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1087
     ObjectMemory resetMaxInterruptLatency.
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1088
     ObjectMemory interruptLatencyMonitor:ObjectMemory.
493
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1089
    "
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1090
    "to disable timing statistics:
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1091
496
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1092
     ObjectMemory interruptLatencyMonitor:nil.
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1093
     ObjectMemory maxInterruptLatency printNL.
493
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1094
    "
503
4df58bb2c1d1 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 502
diff changeset
  1095
4df58bb2c1d1 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 502
diff changeset
  1096
    "Created: 7.11.1995 / 21:05:50 / cg"
4df58bb2c1d1 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 502
diff changeset
  1097
    "Modified: 7.11.1995 / 21:13:33 / cg"
493
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1098
!
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1099
496
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1100
resetMaxInterruptLatency
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1101
    "reset the maximum accumulated interrupt latency probe time.
493
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1102
     DEMO Example."
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1103
496
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1104
    MaxInterruptLatency := 0
493
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1105
!
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1106
497
8ca9c965c607 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 496
diff changeset
  1107
interruptLatencyGoal:millis
8ca9c965c607 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 496
diff changeset
  1108
    "setup to report an error message, whenever a realtime goal could not be
8ca9c965c607 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 496
diff changeset
  1109
     met due to blocked interrupts or long primitives or GC activity.
8ca9c965c607 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 496
diff changeset
  1110
     An argument of nil clears the check.
493
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1111
     DEMO Example."
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1112
497
8ca9c965c607 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 496
diff changeset
  1113
    InterruptLatencyGoal := millis.
8ca9c965c607 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 496
diff changeset
  1114
    millis isNil ifTrue:[
499
64355a66d2bd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 498
diff changeset
  1115
	InterruptLatencyMonitor := nil.
498
3ec97c46dbe8 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 497
diff changeset
  1116
    ] ifFalse:[
499
64355a66d2bd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 498
diff changeset
  1117
	MaxInterruptLatency := 0.
64355a66d2bd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 498
diff changeset
  1118
	InterruptLatencyMonitor := self.
497
8ca9c965c607 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 496
diff changeset
  1119
    ]
500
e5fd4f3c9f37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 499
diff changeset
  1120
e5fd4f3c9f37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 499
diff changeset
  1121
    "
e5fd4f3c9f37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 499
diff changeset
  1122
     ObjectMemory interruptLatencyGoal:50
e5fd4f3c9f37 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 499
diff changeset
  1123
    "
496
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1124
!
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1125
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1126
maxInterruptLatency
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1127
    "return the maximum accumulated interrupt latency in millis.
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1128
     DEMO Example."
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1129
f0cd83f93146 sorry stefan - renamed again (if its not done now ...)
Claus Gittinger <cg@exept.de>
parents: 495
diff changeset
  1130
    ^ MaxInterruptLatency
2
claus
parents: 1
diff changeset
  1131
! !
claus
parents: 1
diff changeset
  1132
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1133
!ObjectMemory class methodsFor:'queries'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1134
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1135
newSpaceSize
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1136
    "return the total size of the new space - this is usually fix"
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1137
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1138
%{  /* NOCONTEXT */
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1139
    extern unsigned __newSpaceSize();
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1140
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1141
    RETURN ( _MKSMALLINT(__newSpaceSize()) );
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1142
%}
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1143
    "
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1144
     ObjectMemory newSpaceSize
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1145
    "
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1146
!
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1147
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1148
oldSpaceSize
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1149
    "return the total size of the old space. - may grow slowly"
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1150
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1151
%{  /* NOCONTEXT */
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1152
    extern unsigned __oldSpaceSize();
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1153
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1154
    RETURN ( _MKSMALLINT(__oldSpaceSize()) );
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1155
%}
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1156
    "
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1157
     ObjectMemory oldSpaceSize
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1158
    "
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1159
!
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1160
325
claus
parents: 324
diff changeset
  1161
symSpaceSize
claus
parents: 324
diff changeset
  1162
    "return the total size of the sym space."
claus
parents: 324
diff changeset
  1163
claus
parents: 324
diff changeset
  1164
%{  /* NOCONTEXT */
claus
parents: 324
diff changeset
  1165
    extern unsigned __symSpaceSize();
claus
parents: 324
diff changeset
  1166
claus
parents: 324
diff changeset
  1167
    RETURN ( _MKSMALLINT(__symSpaceSize()) );
claus
parents: 324
diff changeset
  1168
%}
claus
parents: 324
diff changeset
  1169
    "
claus
parents: 324
diff changeset
  1170
     ObjectMemory symSpaceSize
claus
parents: 324
diff changeset
  1171
    "
claus
parents: 324
diff changeset
  1172
!
claus
parents: 324
diff changeset
  1173
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1174
fixSpaceSize
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1175
    "return the total size of the fix space."
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1176
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1177
%{  /* NOCONTEXT */
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1178
    extern unsigned __fixSpaceSize();
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1179
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1180
    RETURN ( _MKSMALLINT(__fixSpaceSize()) );
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1181
%}
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1182
    "
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1183
     ObjectMemory fixSpaceSize
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1184
    "
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1185
!
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1186
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1187
newSpaceUsed
10
claus
parents: 5
diff changeset
  1188
    "return the number of bytes allocated for new objects.
claus
parents: 5
diff changeset
  1189
     The returned value is usually obsolete as soon as you do
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1190
     something with it ..."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1191
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1192
%{  /* NOCONTEXT */
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1193
    extern unsigned __newSpaceUsed();
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1194
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1195
    RETURN ( _MKSMALLINT(__newSpaceUsed()) );
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1196
%}
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1197
    "
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1198
     ObjectMemory newSpaceUsed   
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1199
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1200
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1201
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1202
oldSpaceUsed
10
claus
parents: 5
diff changeset
  1203
    "return the number of bytes allocated for old objects.
claus
parents: 5
diff changeset
  1204
     (This includes the free lists)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1205
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1206
%{  /* NOCONTEXT */
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1207
    extern unsigned __oldSpaceUsed();
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1208
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1209
    RETURN ( _MKSMALLINT(__oldSpaceUsed()) );
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1210
%}
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1211
    "
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1212
     ObjectMemory oldSpaceUsed  
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1213
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1214
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1215
325
claus
parents: 324
diff changeset
  1216
symSpaceUsed
claus
parents: 324
diff changeset
  1217
    "return the number of bytes allocated for old objects in sym space."
claus
parents: 324
diff changeset
  1218
claus
parents: 324
diff changeset
  1219
%{  /* NOCONTEXT */
claus
parents: 324
diff changeset
  1220
    extern unsigned __symSpaceUsed();
claus
parents: 324
diff changeset
  1221
claus
parents: 324
diff changeset
  1222
    RETURN ( _MKSMALLINT(__symSpaceUsed()) );
claus
parents: 324
diff changeset
  1223
%}
claus
parents: 324
diff changeset
  1224
    "
claus
parents: 324
diff changeset
  1225
     ObjectMemory symSpaceUsed
claus
parents: 324
diff changeset
  1226
    "
claus
parents: 324
diff changeset
  1227
!
claus
parents: 324
diff changeset
  1228
216
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1229
fixSpaceUsed
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1230
    "return the number of bytes allocated for old objects in fix space."
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1231
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1232
%{  /* NOCONTEXT */
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1233
    extern unsigned __fixSpaceUsed();
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1234
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1235
    RETURN ( _MKSMALLINT(__fixSpaceUsed()) );
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1236
%}
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1237
    "
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1238
     ObjectMemory fixSpaceUsed
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1239
    "
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1240
!
a8abff749575 *** empty log message ***
claus
parents: 213
diff changeset
  1241
270
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1242
freeSpace
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1243
    "return the number of bytes in the compact free area.
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1244
     (oldSpaceUsed + freeSpaceSize = oldSpaceSize)"
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1245
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1246
%{  /* NOCONTEXT */
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1247
    extern unsigned __oldSpaceSize(), __oldSpaceUsed();
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1248
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1249
    RETURN ( _MKSMALLINT(__oldSpaceSize() - __oldSpaceUsed()) );
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1250
%}
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1251
    "
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1252
     ObjectMemory freeSpace
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1253
    "
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1254
!
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1255
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1256
freeListSpace
10
claus
parents: 5
diff changeset
  1257
    "return the number of bytes in the free lists.
claus
parents: 5
diff changeset
  1258
     (which is included in oldSpaceUsed)"
claus
parents: 5
diff changeset
  1259
claus
parents: 5
diff changeset
  1260
%{  /* NOCONTEXT */
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1261
    extern unsigned __freeListSpace();
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1262
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1263
    RETURN ( _MKSMALLINT(__freeListSpace()) );
10
claus
parents: 5
diff changeset
  1264
%}
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1265
    "
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1266
     ObjectMemory freeListSpace
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1267
    "
10
claus
parents: 5
diff changeset
  1268
!
claus
parents: 5
diff changeset
  1269
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1270
bytesUsed
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1271
    "return the number of bytes allocated for objects -
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1272
     this number is not exact, since some objects may already be dead
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1273
     (i.e. not yet reclaimed by the garbage collector).
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1274
     If you need the exact number, you have to loop over all
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1275
     objects and ask for the bytesize using ObjectMemory>>sizeOf:."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1276
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1277
%{  /* NOCONTEXT */
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1278
    extern unsigned __oldSpaceUsed(), __newSpaceUsed(), __freeListSpace();
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1279
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1280
    RETURN ( _MKSMALLINT(__oldSpaceUsed() + __newSpaceUsed() - __freeListSpace()) );
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1281
%}
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1282
    "
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1283
     ObjectMemory bytesUsed  
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1284
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1285
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1286
2
claus
parents: 1
diff changeset
  1287
oldSpaceAllocatedSinceLastGC
claus
parents: 1
diff changeset
  1288
    "return the number of bytes allocated for old objects since the
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1289
     last oldspace garbage collect occured. This information is used
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1290
     by ProcessorScheduler to decide when to start the incremental
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1291
     background GC."
2
claus
parents: 1
diff changeset
  1292
claus
parents: 1
diff changeset
  1293
%{  /* NOCONTEXT */
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1294
    extern unsigned __oldSpaceAllocatedSinceLastGC();
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1295
2
claus
parents: 1
diff changeset
  1296
    RETURN ( _MKSMALLINT(__oldSpaceAllocatedSinceLastGC()) );
claus
parents: 1
diff changeset
  1297
%}
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1298
    "
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1299
     ObjectMemory oldSpaceAllocatedSinceLastGC   
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1300
    "
2
claus
parents: 1
diff changeset
  1301
!
claus
parents: 1
diff changeset
  1302
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1303
tenureAge
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1304
    "return the current tenure age - thats the number of times
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1305
     an object has to survive scavenges to be moved into oldSpace.
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1306
     For statistic/debugging only - this method may vanish"
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1307
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1308
%{  /* NOCONTEXT */
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1309
    extern unsigned __tenureAge();
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1310
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1311
    RETURN ( _MKSMALLINT(__tenureAge()) );
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1312
%}
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1313
!
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1314
362
claus
parents: 360
diff changeset
  1315
lastScavengeReclamation
194
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1316
    "returns the number of bytes replacimed by the last scavenge.
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1317
     For statistic only - this may vanish."
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1318
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1319
%{  /* NOCONTEXT */
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1320
    extern int __newSpaceReclaimed();
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1321
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1322
    RETURN ( _MKSMALLINT(__newSpaceReclaimed()) );
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1323
%}
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1324
    "percentage of reclaimed objects is returned by:
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1325
362
claus
parents: 360
diff changeset
  1326
     ((ObjectMemory lastScavengeReclamation)
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1327
      / (ObjectMemory newSpaceSize)) * 100.0  
194
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1328
    "
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1329
!
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1330
362
claus
parents: 360
diff changeset
  1331
resetMinScavengeReclamation
claus
parents: 360
diff changeset
  1332
    "resets the number of bytes replacimed by the least effective scavenge.
claus
parents: 360
diff changeset
  1333
     For statistic only - this may vanish."
claus
parents: 360
diff changeset
  1334
claus
parents: 360
diff changeset
  1335
%{  /* NOCONTEXT */
claus
parents: 360
diff changeset
  1336
    extern int __resetNewSpaceReclaimedMin();
claus
parents: 360
diff changeset
  1337
claus
parents: 360
diff changeset
  1338
    __resetNewSpaceReclaimedMin();
claus
parents: 360
diff changeset
  1339
%}.
claus
parents: 360
diff changeset
  1340
    ^ self
claus
parents: 360
diff changeset
  1341
    "
claus
parents: 360
diff changeset
  1342
     ObjectMemory resetMinScavengeReclamation.
claus
parents: 360
diff changeset
  1343
     ObjectMemory minScavengeReclamation
claus
parents: 360
diff changeset
  1344
    "
claus
parents: 360
diff changeset
  1345
!
claus
parents: 360
diff changeset
  1346
claus
parents: 360
diff changeset
  1347
minScavengeReclamation
claus
parents: 360
diff changeset
  1348
    "returns the number of bytes replacimed by the least effective scavenge.
claus
parents: 360
diff changeset
  1349
     For statistic only - this may vanish."
claus
parents: 360
diff changeset
  1350
claus
parents: 360
diff changeset
  1351
%{  /* NOCONTEXT */
claus
parents: 360
diff changeset
  1352
    extern int __newSpaceReclaimedMin();
claus
parents: 360
diff changeset
  1353
claus
parents: 360
diff changeset
  1354
    RETURN ( _MKSMALLINT(__newSpaceReclaimedMin()) );
claus
parents: 360
diff changeset
  1355
%}
claus
parents: 360
diff changeset
  1356
    "
claus
parents: 360
diff changeset
  1357
     ObjectMemory minScavengeReclamation
claus
parents: 360
diff changeset
  1358
    "
claus
parents: 360
diff changeset
  1359
!
claus
parents: 360
diff changeset
  1360
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1361
runsSingleOldSpace
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1362
    "return true, if the system runs in a single oldSpace or
326
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1363
     false if not.
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1364
     The memory system will always drop the second semispace when 
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1365
     running out of virtual memory, or the baker-limit is reached.
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1366
     OBSOLETE: 
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1367
	 the system may now decide at any time to switch between
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1368
	 single and double-space algorithms, depending on the overall memory
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1369
	 size. You will now almost always get false as result, since the
326
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1370
	 second semispace is only allocated when needed, and released
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1371
	 immediately afterwards.
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1372
    "
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1373
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1374
%{  /* NOCONTEXT */
357
claus
parents: 356
diff changeset
  1375
    extern int __runsSingleOldSpace();
claus
parents: 356
diff changeset
  1376
claus
parents: 356
diff changeset
  1377
    RETURN ( (__runsSingleOldSpace() ? true : false) );
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1378
%}
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1379
    "
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1380
     ObjectMemory runsSingleOldSpace 
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1381
    "
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1382
!
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1383
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1384
incrementalGCPhase
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1385
    "returns the internal state of the incremental GC.
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1386
     The meaning of those numbers is a secret :-).
326
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1387
     (for the curious: (currently)
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1388
      2 is idle, 3..11 are various mark phases,
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1389
      12 is the sweep phase. 0 and 1 are cleanup phases when the
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1390
      incr. GC gets interrupted by a full GC).
356
claus
parents: 345
diff changeset
  1391
     Do not depend on the values - there may be additional phases in
claus
parents: 345
diff changeset
  1392
     future versions (incremental compact ;-).
326
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1393
     This is for debugging and monitoring only - and may change or vanish"
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1394
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1395
%{  /* NOCONTEXT */
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1396
    extern int __incrGCphase();
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1397
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1398
    RETURN (_MKSMALLINT(__incrGCphase()));
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1399
%}
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1400
!
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1401
270
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1402
scavengeCount
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1403
    "return the number of scavenges that occurred since startup"
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1404
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1405
%{  /* NOCONTEXT */
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1406
    extern int __scavengeCount();
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1407
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1408
    RETURN (_MKSMALLINT(__scavengeCount()));
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1409
%}
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1410
    "
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1411
     ObjectMemory scavengeCount 
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1412
    "
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1413
!
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1414
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1415
markAndSweepCount
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1416
    "return the number of mark&sweep collects that occurred since startup"
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1417
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1418
%{  /* NOCONTEXT */
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1419
    extern int __markAndSweepCount();
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1420
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1421
    RETURN (_MKSMALLINT(__markAndSweepCount()));
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1422
%}
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1423
    "
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1424
     ObjectMemory markAndSweepCount 
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1425
    "
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1426
!
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1427
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1428
garbageCollectCount
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1429
    "return the number of compressing collects that occurred since startup"
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1430
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1431
%{  /* NOCONTEXT */
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1432
    extern int __garbageCollectCount();
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1433
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1434
    RETURN (_MKSMALLINT(__garbageCollectCount()));
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1435
%}
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1436
    "
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1437
     ObjectMemory garbageCollectCount 
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1438
    "
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1439
!
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1440
443
Claus Gittinger <cg@exept.de>
parents: 440
diff changeset
  1441
incrementalGCCount
Claus Gittinger <cg@exept.de>
parents: 440
diff changeset
  1442
    "return the number of incremental collects that occurred since startup"
Claus Gittinger <cg@exept.de>
parents: 440
diff changeset
  1443
Claus Gittinger <cg@exept.de>
parents: 440
diff changeset
  1444
%{  /* NOCONTEXT */
Claus Gittinger <cg@exept.de>
parents: 440
diff changeset
  1445
    extern int __incrementalGCCount();
Claus Gittinger <cg@exept.de>
parents: 440
diff changeset
  1446
Claus Gittinger <cg@exept.de>
parents: 440
diff changeset
  1447
    RETURN (_MKSMALLINT(__incrementalGCCount()));
Claus Gittinger <cg@exept.de>
parents: 440
diff changeset
  1448
%}
Claus Gittinger <cg@exept.de>
parents: 440
diff changeset
  1449
    "
Claus Gittinger <cg@exept.de>
parents: 440
diff changeset
  1450
     ObjectMemory incrementalGCCount
Claus Gittinger <cg@exept.de>
parents: 440
diff changeset
  1451
    "
Claus Gittinger <cg@exept.de>
parents: 440
diff changeset
  1452
!
Claus Gittinger <cg@exept.de>
parents: 440
diff changeset
  1453
362
claus
parents: 360
diff changeset
  1454
rememberedSetSize
369
claus
parents: 362
diff changeset
  1455
    "return the number of old objects referencing new ones.
claus
parents: 362
diff changeset
  1456
     This is a VM debugging interface and may vanish without notice."
362
claus
parents: 360
diff changeset
  1457
claus
parents: 360
diff changeset
  1458
%{  /* NOCONTEXT */
claus
parents: 360
diff changeset
  1459
    extern int __rememberedSetSize();
claus
parents: 360
diff changeset
  1460
claus
parents: 360
diff changeset
  1461
    RETURN (_MKSMALLINT(__rememberedSetSize()));
claus
parents: 360
diff changeset
  1462
%}
claus
parents: 360
diff changeset
  1463
    "
claus
parents: 360
diff changeset
  1464
     ObjectMemory rememberedSetSize
claus
parents: 360
diff changeset
  1465
    "
claus
parents: 360
diff changeset
  1466
!
claus
parents: 360
diff changeset
  1467
369
claus
parents: 362
diff changeset
  1468
lifoRememberedSetSize
claus
parents: 362
diff changeset
  1469
    "return the size of the lifoRemSet.
claus
parents: 362
diff changeset
  1470
     This is a VM debugging interface and may vanish without notice."
claus
parents: 362
diff changeset
  1471
claus
parents: 362
diff changeset
  1472
%{  /* NOCONTEXT */
claus
parents: 362
diff changeset
  1473
    extern int __lifoRememberedSetSize();
claus
parents: 362
diff changeset
  1474
claus
parents: 362
diff changeset
  1475
    RETURN (_MKSMALLINT(__lifoRememberedSetSize()));
claus
parents: 362
diff changeset
  1476
%}
claus
parents: 362
diff changeset
  1477
    "
claus
parents: 362
diff changeset
  1478
     ObjectMemory lifoRememberedSetSize
claus
parents: 362
diff changeset
  1479
    "
claus
parents: 362
diff changeset
  1480
!
claus
parents: 362
diff changeset
  1481
claus
parents: 362
diff changeset
  1482
lifoRememberedSet
claus
parents: 362
diff changeset
  1483
    "return the lifoRemSet.
claus
parents: 362
diff changeset
  1484
     This is pure VM debugging and will vanish without notice."
claus
parents: 362
diff changeset
  1485
claus
parents: 362
diff changeset
  1486
%{  /* NOCONTEXT */
claus
parents: 362
diff changeset
  1487
    extern OBJ __lifoRememberedSet();
claus
parents: 362
diff changeset
  1488
claus
parents: 362
diff changeset
  1489
    RETURN ( __lifoRememberedSet() );
claus
parents: 362
diff changeset
  1490
%}
claus
parents: 362
diff changeset
  1491
    "
claus
parents: 362
diff changeset
  1492
     ObjectMemory lifoRememberedSet
claus
parents: 362
diff changeset
  1493
    "
claus
parents: 362
diff changeset
  1494
!
claus
parents: 362
diff changeset
  1495
claus
parents: 362
diff changeset
  1496
numberOfWeakObjects
claus
parents: 362
diff changeset
  1497
    "return the number of weak objects in the system"
claus
parents: 362
diff changeset
  1498
claus
parents: 362
diff changeset
  1499
%{  /* NOCONTEXT */
claus
parents: 362
diff changeset
  1500
    extern int __weakListSize();
claus
parents: 362
diff changeset
  1501
claus
parents: 362
diff changeset
  1502
    RETURN ( __MKSMALLINT(__weakListSize()) );
claus
parents: 362
diff changeset
  1503
%}
claus
parents: 362
diff changeset
  1504
    "
claus
parents: 362
diff changeset
  1505
     ObjectMemory numberOfWeakObjects
claus
parents: 362
diff changeset
  1506
    "
claus
parents: 362
diff changeset
  1507
!
claus
parents: 362
diff changeset
  1508
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1509
numberOfObjects
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1510
    "return the number of objects in the system."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1511
326
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1512
    |tally "{ Class: SmallInteger }"|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1513
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1514
    tally := 0.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1515
    self allObjectsDo:[:obj | tally := tally + 1].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1516
    ^ tally
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1517
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1518
    "
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1519
     ObjectMemory numberOfObjects  
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1520
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1521
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1522
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1523
collectObjectsWhich:aBlock
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1524
    "helper for the whoReferences queries. Returns a collection
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1525
     of objects for which aBlock returns true."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1526
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1527
    |aCollection|
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1528
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1529
    aCollection := IdentitySet new.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1530
    self allObjectsDo:[:o |
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1531
	(aBlock value:o) ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1532
	    aCollection add:o
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1533
	]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1534
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1535
    (aCollection size == 0) ifTrue:[
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1536
	"actually this cannot happen - there is always one"
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1537
	^ nil
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1538
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1539
    ^ aCollection
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1540
!
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1541
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1542
whoReferences:anObject
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1543
    "return a collection of objects referencing the argument, anObject"
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1544
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1545
    ^ self collectObjectsWhich:[:o | o references:anObject]
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1546
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1547
    "
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1548
     (ObjectMemory whoReferences:Transcript) printNL
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1549
    "
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1550
!
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1551
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1552
whoReferencesInstancesOf:aClass
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1553
    "return a collection of objects refering to instances
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1554
     of the argument, aClass"
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1555
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1556
    ^ self collectObjectsWhich:[:o | o referencesInstanceOf:aClass]
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1557
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1558
    "
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1559
     (ObjectMemory whoReferencesInstancesOf:SystemBrowser) printNL
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1560
    "
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1561
!
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1562
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1563
whoReferencesDerivedInstancesOf:aClass
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1564
    "return a collection of objects refering to instances
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1565
     of the argument, aClass or a subclass of it."
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1566
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1567
    ^ self collectObjectsWhich:[:o | o referencesDerivedInstanceOf:aClass]
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1568
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1569
    "
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1570
     (ObjectMemory whoReferencesDerivedInstancesOf:View) printNL
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1571
    "
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1572
!
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1573
435
claus
parents: 426
diff changeset
  1574
maximumIdentityHashValue
claus
parents: 426
diff changeset
  1575
    "for ST-80 compatibility: return the maximum value
claus
parents: 426
diff changeset
  1576
     a hashKey as returned by identityHash can get.
claus
parents: 426
diff changeset
  1577
     Since ST/X uses direct pointers, a field in the objectHeader
claus
parents: 426
diff changeset
  1578
     is used, which is currently 11 bits in size."
claus
parents: 426
diff changeset
  1579
claus
parents: 426
diff changeset
  1580
%{  /* NOCONTEXT */
claus
parents: 426
diff changeset
  1581
    RETURN ( __MKSMALLINT( __MAX_HASH__ << __HASH_SHIFT__) );
claus
parents: 426
diff changeset
  1582
%}
claus
parents: 426
diff changeset
  1583
    "
claus
parents: 426
diff changeset
  1584
     ObjectMemory maximumIdentityHashValue
claus
parents: 426
diff changeset
  1585
    "
claus
parents: 426
diff changeset
  1586
! !
claus
parents: 426
diff changeset
  1587
claus
parents: 426
diff changeset
  1588
!ObjectMemory class methodsFor:'debug queries'!
claus
parents: 426
diff changeset
  1589
claus
parents: 426
diff changeset
  1590
printReferences:anObject
claus
parents: 426
diff changeset
  1591
    "for debugging: print referents to anObject.
claus
parents: 426
diff changeset
  1592
     WARNING: this method is for ST/X debugging only 
claus
parents: 426
diff changeset
  1593
	      it will be removed without notice
claus
parents: 426
diff changeset
  1594
	use ObjectMemory>>whoReferences: or anObject>>allOwners."
claus
parents: 426
diff changeset
  1595
claus
parents: 426
diff changeset
  1596
%{
claus
parents: 426
diff changeset
  1597
    __printRefChain(__context, anObject);
claus
parents: 426
diff changeset
  1598
%}
claus
parents: 426
diff changeset
  1599
!
claus
parents: 426
diff changeset
  1600
claus
parents: 426
diff changeset
  1601
dumpObject:someObject
claus
parents: 426
diff changeset
  1602
    "low level dump an object.
claus
parents: 426
diff changeset
  1603
     WARNING: this method is for ST/X debugging only 
claus
parents: 426
diff changeset
  1604
	      it will be removed without notice"
claus
parents: 426
diff changeset
  1605
claus
parents: 426
diff changeset
  1606
%{
claus
parents: 426
diff changeset
  1607
    dumpObject(someObject);
claus
parents: 426
diff changeset
  1608
%}
claus
parents: 426
diff changeset
  1609
    "
claus
parents: 426
diff changeset
  1610
     ObjectMemory dumpObject:true
claus
parents: 426
diff changeset
  1611
     ObjectMemory dumpObject:(Array new:10) 
claus
parents: 426
diff changeset
  1612
     ObjectMemory dumpObject:(10@20 corner:30@40) 
claus
parents: 426
diff changeset
  1613
    "
claus
parents: 426
diff changeset
  1614
!
claus
parents: 426
diff changeset
  1615
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1616
addressOf:anObject
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1617
    "return the core address of anObject as an integer
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1618
     - since objects may move around, the returned value is invalid after the
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1619
     next scavenge/collect.
435
claus
parents: 426
diff changeset
  1620
     WARNING: this method is for ST/X debugging only 
claus
parents: 426
diff changeset
  1621
	      it will be removed without notice"
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1622
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1623
%{  /* NOCONTEXT */
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1624
329
claus
parents: 326
diff changeset
  1625
    if (! __isNonNilObject(anObject)) {
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1626
	RETURN ( nil );
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1627
    }
326
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1628
    if (((int)anObject >= _MIN_INT) && ((int)anObject <= _MAX_INT)) {
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1629
	RETURN ( _MKSMALLINT((int)anObject) );
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1630
    }
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1631
    RETURN ( _MKLARGEINT((int)anObject) );
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1632
%}
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1633
    "
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1634
    |p|
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1635
    p := Point new.
370
claus
parents: 369
diff changeset
  1636
    ((ObjectMemory addressOf:p) printStringRadix:16) printNL.
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1637
    ObjectMemory scavenge.
370
claus
parents: 369
diff changeset
  1638
    ((ObjectMemory addressOf:p) printStringRadix:16) printNL.
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1639
    "
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1640
!
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1641
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1642
objectAt:anAddress
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1643
    "return whatever anAddress points to as object.
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1644
     BIG BIG DANGER ALERT: 
326
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1645
	this method is only to be used for debugging ST/X itself 
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1646
	- you can easily (and badly) crash the system.
435
claus
parents: 426
diff changeset
  1647
     WARNING: this method is for ST/X debugging only 
claus
parents: 426
diff changeset
  1648
	      it will be removed without notice"
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1649
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1650
    |low high|
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1651
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1652
    low := anAddress bitAnd:16rFFFF.
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1653
    high := (anAddress bitShift:16) bitAnd:16rFFFF.
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1654
%{
253
30daee717a53 *** empty log message ***
claus
parents: 229
diff changeset
  1655
    if (__bothSmallInteger(low, high)) {
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1656
	RETURN ((OBJ)((_intVal(high) << 16) | _intVal(low)));
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1657
    }
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1658
%}
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1659
!
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1660
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1661
sizeOf:anObject
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1662
    "return the size of anObject in bytes.
326
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1663
     (this is not the same as 'anObject size').
435
claus
parents: 426
diff changeset
  1664
     WARNING: this method is for ST/X debugging only 
claus
parents: 426
diff changeset
  1665
	      it will be removed without notice"
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1666
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1667
%{  /* NOCONTEXT */
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1668
329
claus
parents: 326
diff changeset
  1669
    RETURN ( __isNonNilObject(anObject) ? _MKSMALLINT(__qSize(anObject)) : _MKSMALLINT(0) )
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1670
%}
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1671
    "
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1672
     |hist big nw|
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1673
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1674
     hist := Array new:100 withAll:0.
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1675
     big := 0.
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1676
     ObjectMemory allObjectsDo:[:o |
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1677
	 nw := (ObjectMemory sizeOf:o) // 4 + 1.
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1678
	 nw > 100 ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1679
	    big := big + 1
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1680
	 ] ifFalse:[
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1681
	    hist at:nw put:(hist at:nw) + 1
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1682
	 ].
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1683
     ].
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1684
     hist printNL.
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1685
     big printNL
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1686
    "
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1687
!
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1688
435
claus
parents: 426
diff changeset
  1689
ageOf:anObject
claus
parents: 426
diff changeset
  1690
    "return the number of scavenges, an object has survived
claus
parents: 426
diff changeset
  1691
     in new space. 
claus
parents: 426
diff changeset
  1692
     For old objects and living contexts, the returned number is invalid.
claus
parents: 426
diff changeset
  1693
     WARNING: this method is for ST/X debugging only 
claus
parents: 426
diff changeset
  1694
	      it will be removed without notice"
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1695
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1696
%{  /* NOCONTEXT */
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1697
329
claus
parents: 326
diff changeset
  1698
    if (! __isNonNilObject(anObject)) {
435
claus
parents: 426
diff changeset
  1699
	RETURN ( 0 );
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1700
    }
435
claus
parents: 426
diff changeset
  1701
    RETURN ( _MKSMALLINT( _GET_AGE(anObject) ) );
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1702
%}
435
claus
parents: 426
diff changeset
  1703
    "
claus
parents: 426
diff changeset
  1704
    |p|
claus
parents: 426
diff changeset
  1705
    p := Point new.
claus
parents: 426
diff changeset
  1706
    (ObjectMemory ageOf:p) printNL.
claus
parents: 426
diff changeset
  1707
    ObjectMemory tenuringScavenge.
claus
parents: 426
diff changeset
  1708
    (ObjectMemory spaceOf:p) printNL.
claus
parents: 426
diff changeset
  1709
    ObjectMemory tenuringScavenge.
claus
parents: 426
diff changeset
  1710
    (ObjectMemory spaceOf:p) printNL.
claus
parents: 426
diff changeset
  1711
    ObjectMemory tenuringScavenge.
claus
parents: 426
diff changeset
  1712
    (ObjectMemory spaceOf:p) printNL.
claus
parents: 426
diff changeset
  1713
    ObjectMemory tenuringScavenge.
claus
parents: 426
diff changeset
  1714
    (ObjectMemory spaceOf:p) printNL.
claus
parents: 426
diff changeset
  1715
    "
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1716
!
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1717
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1718
flagsOf:anObject
435
claus
parents: 426
diff changeset
  1719
    "For debugging only.
claus
parents: 426
diff changeset
  1720
     WARNING: this method is for ST/X debugging only 
claus
parents: 426
diff changeset
  1721
	      it will be removed without notice"
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1722
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1723
%{  /* NOCONTEXT */
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1724
329
claus
parents: 326
diff changeset
  1725
    if (! __isNonNilObject(anObject)) {
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1726
	RETURN ( nil );
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1727
    }
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1728
    RETURN ( _MKSMALLINT( anObject->o_flags ) );
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1729
%}
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  1730
    "
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1731
F_ISREMEMBERED  1       /* a new-space thing being refd by some oldSpace thing */
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1732
F_ISFORWARDED   2       /* a forwarded object (you will never see this here) */
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1733
F_DEREFERENCED  4       /* a collection after grow (not currently used) */
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1734
F_ISONLIFOLIST  8       /* a non-lifo-context-referencing-obj already on list */
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1735
F_MARK          16      /* mark bit for background collector */
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1736
    "
326
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1737
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1738
    "
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1739
     |arr|
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1740
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1741
     arr := Array new.
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1742
     arr at:1 put:([thisContext] value).
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1743
     (ObjectMemory flagsOf:anObject) printNL
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1744
    "
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1745
!
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1746
435
claus
parents: 426
diff changeset
  1747
spaceOf:anObject
claus
parents: 426
diff changeset
  1748
    "return the memory space, in which anObject is.
claus
parents: 426
diff changeset
  1749
     - since objects may move between spaces, 
claus
parents: 426
diff changeset
  1750
       the returned value may be invalid after the next scavenge/collect.
claus
parents: 426
diff changeset
  1751
     WARNING: this method is for ST/X debugging only 
claus
parents: 426
diff changeset
  1752
	      it will be removed without notice"
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1753
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1754
%{  /* NOCONTEXT */
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1755
329
claus
parents: 326
diff changeset
  1756
    if (! __isNonNilObject(anObject)) {
435
claus
parents: 426
diff changeset
  1757
	RETURN ( nil );
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1758
    }
435
claus
parents: 426
diff changeset
  1759
    RETURN ( _MKSMALLINT( __qSpace(anObject) ) );
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1760
%}
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1761
! !
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1762
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1763
!ObjectMemory class methodsFor:'garbage collection'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1764
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1765
scavenge
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1766
    "collect young objects, without aging (i.e. no tenure).
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1767
     Can be used to quickly get rid of shortly before allocated
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1768
     stuff. This is relatively fast (compared to oldspace collect).
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1769
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1770
     An example where a non-tenuring scavenge makes sense is when
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1771
     allocating some OperatingSystem resource (a Color, File or View) 
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1772
     and the OS runs out of resources. In this case, the scavenge may
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1773
     free some ST-objects and therefore (by signalling the WeakArrays
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1774
     or Registries) free the OS resources too.
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1775
     Of course, only recently allocated resources will be freed this
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1776
     way. If none was freed, a full collect will be needed."
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1777
%{
326
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1778
    __nonTenuringScavenge(__context);
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1779
%}
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1780
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1781
    "
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1782
     ObjectMemory scavenge
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1783
    "
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1784
!
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1785
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1786
tenuringScavenge
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1787
    "collect newspace stuff, with aging (i.e. objects old enough
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1788
     will be moved into the oldSpace).
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1789
     Use this for debugging and testing only - the system performs
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1790
     this automatically when the newspace fills up.
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1791
     This is relatively fast (compared to oldspace collect)"
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1792
%{
326
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1793
    __scavenge(__context);
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1794
%}
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1795
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1796
    "
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1797
     ObjectMemory tenuringScavenge
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1798
    "
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1799
!
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1800
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1801
tenure
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1802
    "force all living new stuff into old-space - effectively making
312
d2e7297b7321 *** empty log message ***
claus
parents: 310
diff changeset
  1803
     all living young objects become old objects immediately.
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1804
     This is relatively fast (compared to oldspace collect).
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1805
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1806
     This method should only be used in very special situations:
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1807
     for example, when building up some long-living data structure
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1808
     in a time critical application.
194
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1809
     To do so, you have to do a scavenge followed by a tenure after the
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1810
     objects are created. Be careful, to not reference any other chunk-
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1811
     data when calling for a tenure (this will lead to lots of garbage in
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1812
     the oldspace).
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1813
     In normal situations, explicit tenures are not needed."
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1814
%{
326
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1815
    __tenure(__context);
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1816
%}
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1817
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1818
    "
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1819
     ObjectMemory tenure
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1820
    "
194
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1821
    "
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1822
     ... build up long living objects ...
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1823
     ObjectMemory scavenge.
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1824
     ObjectMemory tenure
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1825
     ... continue - objects created above are now in oldSpace ...
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1826
    "
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1827
!
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1828
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1829
garbageCollect
375
claus
parents: 370
diff changeset
  1830
    "search for and free garbage in the oldSpace.
claus
parents: 370
diff changeset
  1831
     This can take a long time - especially, if paging is involved."
claus
parents: 370
diff changeset
  1832
claus
parents: 370
diff changeset
  1833
    "/ used to be 
claus
parents: 370
diff changeset
  1834
    "/    self compressingGarbageCollect 
claus
parents: 370
diff changeset
  1835
    "/ here; changed to default to markAndSweep
claus
parents: 370
diff changeset
  1836
claus
parents: 370
diff changeset
  1837
    self markAndSweep
claus
parents: 370
diff changeset
  1838
claus
parents: 370
diff changeset
  1839
    "
claus
parents: 370
diff changeset
  1840
     ObjectMemory garbageCollect
claus
parents: 370
diff changeset
  1841
    "
claus
parents: 370
diff changeset
  1842
!
claus
parents: 370
diff changeset
  1843
claus
parents: 370
diff changeset
  1844
compressingGarbageCollect
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1845
    "search for and free garbage in the oldSpace (newSpace is cleaned automatically) 
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1846
     performing a COMPRESSING garbage collect.
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1847
     This can take a long time - especially, if paging is involved
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1848
     (when no paging is involved, its faster than I thought :-).
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1849
     If no memory is available for the compress, or the system has been started with
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  1850
     the -Msingle option, this does a non-COMPRESSING collect."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1851
%{
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1852
    if (! __garbageCollect(__context)) {
326
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1853
	__markAndSweep(__context);
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  1854
    }
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1855
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1856
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1857
    "
375
claus
parents: 370
diff changeset
  1858
     ObjectMemory compressingGarbageCollect
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1859
    "
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1860
!
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1861
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1862
markAndSweep
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1863
    "mark/sweep garbage collector.
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1864
     perform a full mark&sweep collect.
369
claus
parents: 362
diff changeset
  1865
     Warning: this may take some time and it is NOT interruptable.
claus
parents: 362
diff changeset
  1866
     If you want to do a collect from a background process, or have
claus
parents: 362
diff changeset
  1867
     other things to do, better use #incrementalGC which is interruptable."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1868
%{
326
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  1869
    __markAndSweep(__context);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1870
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1871
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  1872
    "
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1873
     ObjectMemory markAndSweep
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1874
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1875
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1876
375
claus
parents: 370
diff changeset
  1877
reclaimSymbols
claus
parents: 370
diff changeset
  1878
    "reclaim unused symbols;
claus
parents: 370
diff changeset
  1879
     Unused symbols are (currently) not reclaimed automatically,
claus
parents: 370
diff changeset
  1880
     but only upon request with this method. 
claus
parents: 370
diff changeset
  1881
     It takes some time to do this ... and it is NOT interruptable.
claus
parents: 370
diff changeset
  1882
     Future versions may do this automatically, while garbage collecting."
claus
parents: 370
diff changeset
  1883
%{
claus
parents: 370
diff changeset
  1884
    __reclaimSymbols(__context);
claus
parents: 370
diff changeset
  1885
%}
claus
parents: 370
diff changeset
  1886
    "
claus
parents: 370
diff changeset
  1887
     ObjectMemory reclaimSymbols
claus
parents: 370
diff changeset
  1888
    "
claus
parents: 370
diff changeset
  1889
!
claus
parents: 370
diff changeset
  1890
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1891
gcStep
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1892
    "one incremental garbage collect step.
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  1893
     Mark or sweep some small number of objects. This
85
claus
parents: 77
diff changeset
  1894
     method will return after a reasonable (short) time.
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1895
     This is used by the ProcessorScheduler at idle times.
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1896
     Returns true, if an incremental GC cycle has finished."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1897
%{
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1898
    extern int __incrGCstep();
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1899
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1900
    RETURN (__incrGCstep(__context) ? true : false);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1901
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1902
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  1903
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1904
incrementalGC
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1905
    "perform one round of incremental GC steps.
403
claus
parents: 384
diff changeset
  1906
     The overall effect of this method is (almost) the same as calling 
claus
parents: 384
diff changeset
  1907
     markAndSweep. However, #incrementalGC is interruptable while #markAndSweep
claus
parents: 384
diff changeset
  1908
     is atomic and blocks for a while. The code here performs incremental
claus
parents: 384
diff changeset
  1909
     GC steps, until one complete gc-cycle is completed. If running at a higher
claus
parents: 384
diff changeset
  1910
     than userBackground priority, it will give up the CPU after every such
claus
parents: 384
diff changeset
  1911
     step for a while.
claus
parents: 384
diff changeset
  1912
     Thus this method can be called either from a low prio (background) process 
claus
parents: 384
diff changeset
  1913
     or from a high prio process.
369
claus
parents: 362
diff changeset
  1914
     (however, if you have nothing else to do, its better to call for markAndSweep,
claus
parents: 362
diff changeset
  1915
      since it is faster)
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1916
     For example, someone allocating huge amounts of memory could
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1917
     ask for the possibility of a quick allocation using
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  1918
     #checkForFastNew: and try a #incrementalGC if not. In many
270
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1919
     cases, this can avoid a pause (in the higher prio processes) due to 
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1920
     a blocking GC."
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1921
403
claus
parents: 384
diff changeset
  1922
    |p delay|
claus
parents: 384
diff changeset
  1923
claus
parents: 384
diff changeset
  1924
    Processor activeProcess priority > Processor userBackgroundPriority ifTrue:[
claus
parents: 384
diff changeset
  1925
	delay := Delay forMilliseconds:1
claus
parents: 384
diff changeset
  1926
    ].
claus
parents: 384
diff changeset
  1927
claus
parents: 384
diff changeset
  1928
    [self gcStep] whileFalse:[
claus
parents: 384
diff changeset
  1929
	delay notNil ifTrue:[delay wait]
claus
parents: 384
diff changeset
  1930
    ].
369
claus
parents: 362
diff changeset
  1931
    self moreOldSpaceIfUseful
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1932
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1933
    "
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1934
     ObjectMemory incrementalGC
356
claus
parents: 345
diff changeset
  1935
     [ObjectMemory incrementalGC] forkAt:3
403
claus
parents: 384
diff changeset
  1936
     [ObjectMemory incrementalGC] forkAt:9 
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  1937
    "
194
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1938
!
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1939
270
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1940
gcStepIfUseful
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1941
    "If either the IncrementalGCLimit or the FreeSpaceGCLimits have been
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  1942
     reached, perform one incremental garbage collect step.
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  1943
     Return true, if more gcSteps are required to finish the cycle,
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  1944
     false if done with a gc round.
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  1945
     If no limit has been reached yet, do nothing and return false.
312
d2e7297b7321 *** empty log message ***
claus
parents: 310
diff changeset
  1946
     This is called by the ProcessorScheduler at idle times or by the 
d2e7297b7321 *** empty log message ***
claus
parents: 310
diff changeset
  1947
     backgroundCollector."
270
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1948
379
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  1949
    |done limit|
270
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1950
472
9c5121e7d3e8 catch abortSignal when performing IGC's.
Claus Gittinger <cg@exept.de>
parents: 465
diff changeset
  1951
    Object abortSignal handle:[:ex |
9c5121e7d3e8 catch abortSignal when performing IGC's.
Claus Gittinger <cg@exept.de>
parents: 465
diff changeset
  1952
	"/ in case of abort (from the debugger),
9c5121e7d3e8 catch abortSignal when performing IGC's.
Claus Gittinger <cg@exept.de>
parents: 465
diff changeset
  1953
	"/ disable gcSteps.
9c5121e7d3e8 catch abortSignal when performing IGC's.
Claus Gittinger <cg@exept.de>
parents: 465
diff changeset
  1954
	done := true.
9c5121e7d3e8 catch abortSignal when performing IGC's.
Claus Gittinger <cg@exept.de>
parents: 465
diff changeset
  1955
	IncrementalGCLimit := FreeSpaceGCLimit := nil.
9c5121e7d3e8 catch abortSignal when performing IGC's.
Claus Gittinger <cg@exept.de>
parents: 465
diff changeset
  1956
	'OBJMEM: IGC aborted; turning off incremental GC' errorPrintNL
9c5121e7d3e8 catch abortSignal when performing IGC's.
Claus Gittinger <cg@exept.de>
parents: 465
diff changeset
  1957
    ] do:[
493
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1958
	limit := IncrementalGCLimit.
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1959
	(limit notNil and:[self oldSpaceAllocatedSinceLastGC > limit]) ifTrue:[
472
9c5121e7d3e8 catch abortSignal when performing IGC's.
Claus Gittinger <cg@exept.de>
parents: 465
diff changeset
  1960
	    done := ObjectMemory gcStep
493
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1961
	] ifFalse:[
472
9c5121e7d3e8 catch abortSignal when performing IGC's.
Claus Gittinger <cg@exept.de>
parents: 465
diff changeset
  1962
	    limit := FreeSpaceGCLimit.
9c5121e7d3e8 catch abortSignal when performing IGC's.
Claus Gittinger <cg@exept.de>
parents: 465
diff changeset
  1963
	    (limit notNil and:[(self freeSpace + self freeListSpace) < limit]) ifTrue:[
493
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1964
		done := ObjectMemory gcStep.
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1965
		done ifTrue:[
472
9c5121e7d3e8 catch abortSignal when performing IGC's.
Claus Gittinger <cg@exept.de>
parents: 465
diff changeset
  1966
		    self moreOldSpaceIfUseful
493
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1967
		].
472
9c5121e7d3e8 catch abortSignal when performing IGC's.
Claus Gittinger <cg@exept.de>
parents: 465
diff changeset
  1968
	    ] ifFalse:[
493
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1969
		done := true
472
9c5121e7d3e8 catch abortSignal when performing IGC's.
Claus Gittinger <cg@exept.de>
parents: 465
diff changeset
  1970
	    ]
493
2a2b3d5c0dbc irq latency statistic hook added
Claus Gittinger <cg@exept.de>
parents: 472
diff changeset
  1971
	].
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  1972
    ].
369
claus
parents: 362
diff changeset
  1973
    ^ done not
270
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1974
!
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  1975
194
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1976
verboseGarbageCollect
375
claus
parents: 370
diff changeset
  1977
    "perform a compressing garbage collect and show some informational
194
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1978
     output on the Transcript"
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1979
370
claus
parents: 369
diff changeset
  1980
    |nBytesBefore nReclaimed value unit|
194
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1981
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1982
    nBytesBefore := self oldSpaceUsed.
375
claus
parents: 370
diff changeset
  1983
    self compressingGarbageCollect.
194
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1984
    nReclaimed := nBytesBefore - self oldSpaceUsed.
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1985
    nReclaimed > 0 ifTrue:[
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1986
	nReclaimed > 1024 ifTrue:[
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1987
	    nReclaimed > (1024 * 1024) ifTrue:[
370
claus
parents: 369
diff changeset
  1988
		value := nReclaimed // (1024 * 1024).
claus
parents: 369
diff changeset
  1989
		unit := ' Mb.'
194
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1990
	    ] ifFalse:[
370
claus
parents: 369
diff changeset
  1991
		value := nReclaimed // 1024.
claus
parents: 369
diff changeset
  1992
		unit := ' Kb.'
194
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1993
	    ]
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  1994
	] ifFalse:[
370
claus
parents: 369
diff changeset
  1995
	    value := nReclaimed.
claus
parents: 369
diff changeset
  1996
	    unit := ' bytes.'
claus
parents: 369
diff changeset
  1997
	].
claus
parents: 369
diff changeset
  1998
	Transcript show:'reclaimed '; show:value printString.
claus
parents: 369
diff changeset
  1999
	Transcript showCr:unit
194
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  2000
    ]
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  2001
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  2002
    "
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  2003
     ObjectMemory verboseGarbageCollect
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  2004
    "
207
claus
parents: 202
diff changeset
  2005
!
claus
parents: 202
diff changeset
  2006
claus
parents: 202
diff changeset
  2007
startBackgroundCollectorAt:aPriority
claus
parents: 202
diff changeset
  2008
    "start a process doing incremental GC in the background.
claus
parents: 202
diff changeset
  2009
     Use this, if you have suspendable background processes which
claus
parents: 202
diff changeset
  2010
     run all the time, and therefore would prevent the idle-collector
claus
parents: 202
diff changeset
  2011
     from running. See documentation in this class for more details."
claus
parents: 202
diff changeset
  2012
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2013
    |p|
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2014
270
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2015
    "/
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2016
    "/ its not useful, to run it more than once
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2017
    "/
207
claus
parents: 202
diff changeset
  2018
    BackgroundCollectProcess notNil ifTrue:[
claus
parents: 202
diff changeset
  2019
	BackgroundCollectProcess priority:aPriority.
claus
parents: 202
diff changeset
  2020
	^ self
claus
parents: 202
diff changeset
  2021
    ].
270
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2022
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2023
    p :=
207
claus
parents: 202
diff changeset
  2024
	[
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2025
	    [
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2026
		[true] whileTrue:[
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2027
		    self gcStepIfUseful ifTrue:[
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2028
			"
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2029
			 perform a full cycle
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2030
			"
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2031
			self incrementalGC
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2032
		    ].
270
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2033
		    "
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2034
		     wait a bit
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2035
		    "
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2036
		    (Delay forSeconds:5) wait
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2037
		]
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2038
	    ] valueOnUnwindDo:[
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2039
		BackgroundCollectProcess := nil
211
58bb873aa83c *** empty log message ***
claus
parents: 207
diff changeset
  2040
	    ]
207
claus
parents: 202
diff changeset
  2041
	] newProcess.
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2042
    p name:'background collector'.
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2043
    p priority:aPriority.
339
claus
parents: 335
diff changeset
  2044
    p restartable:true.
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2045
    p resume.
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2046
    BackgroundCollectProcess := p
211
58bb873aa83c *** empty log message ***
claus
parents: 207
diff changeset
  2047
58bb873aa83c *** empty log message ***
claus
parents: 207
diff changeset
  2048
    "
293
31df3850e98c *** empty log message ***
claus
parents: 291
diff changeset
  2049
     the following lets the backgroundCollector run at prio 5
31df3850e98c *** empty log message ***
claus
parents: 291
diff changeset
  2050
     whenever 100000 bytes have been allocated, OR freeSpace drops
31df3850e98c *** empty log message ***
claus
parents: 291
diff changeset
  2051
     below 1meg. Having the system keep 1meg as reserve for peak allocation.
31df3850e98c *** empty log message ***
claus
parents: 291
diff changeset
  2052
31df3850e98c *** empty log message ***
claus
parents: 291
diff changeset
  2053
     Doing this may reduce pauses due to inevitable collects when running
31df3850e98c *** empty log message ***
claus
parents: 291
diff changeset
  2054
     out of freeSpace, if the collector can keep up with allocation rate.
31df3850e98c *** empty log message ***
claus
parents: 291
diff changeset
  2055
    "
31df3850e98c *** empty log message ***
claus
parents: 291
diff changeset
  2056
31df3850e98c *** empty log message ***
claus
parents: 291
diff changeset
  2057
    "
31df3850e98c *** empty log message ***
claus
parents: 291
diff changeset
  2058
     ObjectMemory incrementalGCLimit:100000.
31df3850e98c *** empty log message ***
claus
parents: 291
diff changeset
  2059
     ObjectMemory freeSpaceGCLimit:1000000.
211
58bb873aa83c *** empty log message ***
claus
parents: 207
diff changeset
  2060
     ObjectMemory startBackgroundCollectorAt:5
58bb873aa83c *** empty log message ***
claus
parents: 207
diff changeset
  2061
    "
207
claus
parents: 202
diff changeset
  2062
!
claus
parents: 202
diff changeset
  2063
claus
parents: 202
diff changeset
  2064
stopBackgroundCollector
claus
parents: 202
diff changeset
  2065
    "stop the background collector"
claus
parents: 202
diff changeset
  2066
claus
parents: 202
diff changeset
  2067
    BackgroundCollectProcess notNil ifTrue:[
claus
parents: 202
diff changeset
  2068
	BackgroundCollectProcess terminate.
claus
parents: 202
diff changeset
  2069
	BackgroundCollectProcess := nil
claus
parents: 202
diff changeset
  2070
    ]
293
31df3850e98c *** empty log message ***
claus
parents: 291
diff changeset
  2071
211
58bb873aa83c *** empty log message ***
claus
parents: 207
diff changeset
  2072
    "
58bb873aa83c *** empty log message ***
claus
parents: 207
diff changeset
  2073
     ObjectMemory stopBackgroundCollector
58bb873aa83c *** empty log message ***
claus
parents: 207
diff changeset
  2074
    "
362
claus
parents: 360
diff changeset
  2075
!
claus
parents: 360
diff changeset
  2076
claus
parents: 360
diff changeset
  2077
backgroundCollectorRunning
claus
parents: 360
diff changeset
  2078
    "return true, if a backgroundCollector is running"
claus
parents: 360
diff changeset
  2079
claus
parents: 360
diff changeset
  2080
    ^ BackgroundCollectProcess notNil
claus
parents: 360
diff changeset
  2081
claus
parents: 360
diff changeset
  2082
    "
claus
parents: 360
diff changeset
  2083
     ObjectMemory backgroundCollectorRunning
claus
parents: 360
diff changeset
  2084
    "
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2085
! !
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2086
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2087
!ObjectMemory class methodsFor:'garbage collector control'!
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2088
270
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2089
freeSpaceGCLimit:aNumber
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2090
    "set the freeSpace limit for incremental GC activation.
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2091
     The system will start doing incremental background GC, once less than this number 
310
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2092
     of bytes are available for allocation.
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2093
     The default is nil; setting it to nil will turn this trigger off."
270
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2094
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2095
    FreeSpaceGCLimit := aNumber
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2096
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2097
    "
310
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2098
     the following will start the incrementalGC (in the background)
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2099
     whenever the freeSpace drops below 1meg of free space
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2100
    "
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2101
    "
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2102
     ObjectMemory freeSpaceGCLimit:1000000.  
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2103
    "
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2104
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2105
    "
293
31df3850e98c *** empty log message ***
claus
parents: 291
diff changeset
  2106
     turn it off (i.e. let the system hit the wall ...)
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2107
    "
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2108
    "
270
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2109
     ObjectMemory freeSpaceGCLimit:nil.     
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2110
    "
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2111
!
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2112
310
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2113
freeSpaceGCAmount:aNumber
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2114
    "set the amount to be allocated if, after an incrementalGC,
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2115
     not at least FreeSpaceGCLimit bytes are available for allocation.
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2116
     The amount should be greater than the limit, otherwise the incremental
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2117
     GC may try over and over to get the memory (actually waisting time)."
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2118
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2119
    FreeSpaceGCAmount := aNumber
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2120
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2121
    "
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2122
     the following will try to always keep at least 1meg of free space
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2123
     (in the background) and start to do so, whenever the freeSpace drops
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2124
     below 250k.
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2125
    "
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2126
    "
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2127
     ObjectMemory freeSpaceGCLimit:250000.  
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2128
     ObjectMemory freeSpaceGCAmount:1000000.  
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2129
    "
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2130
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2131
    "
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2132
     turn it off (i.e. let the system  compute an appropriate amount ...)
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2133
    "
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2134
    "
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2135
     ObjectMemory freeSpaceGCAmount:nil.     
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2136
    "
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2137
!
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2138
270
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2139
freeSpaceGCLimit
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2140
    "return the freeSpace limit for incremental GC activation.
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2141
     The system will start doing incremental background GC, once less than this number 
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2142
     of bytes are available in the compact free space.
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2143
     The default is 100000; setting it to nil will turn this trigger off."
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2144
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2145
    ^ FreeSpaceGCLimit
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2146
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2147
    "
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2148
     ObjectMemory freeSpaceGCLimit
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2149
    "
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2150
!
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2151
310
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2152
freeSpaceGCAmount
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2153
    "return the amount to be allocated if, after an incrementalGC,
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2154
     not at least FreeSpaceGCLimit bytes are available for allocation.
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2155
     The default is nil, which lets the system compute an abbpropriate value"
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2156
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2157
    ^ FreeSpaceGCAmount
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2158
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2159
    "
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2160
     ObjectMemory freeSpaceGCAmount
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2161
    "
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2162
!
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2163
2
claus
parents: 1
diff changeset
  2164
incrementalGCLimit:aNumber
270
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2165
    "set the allocatedSinceLastGC limit for incremental GC activation.
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2166
     The system will start doing incremental background GC, once more than this number 
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2167
     of bytes have been allocated since the last GC. 
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2168
     The default is 500000; setting it to nil will turn this trigger off."
2
claus
parents: 1
diff changeset
  2169
claus
parents: 1
diff changeset
  2170
    IncrementalGCLimit := aNumber
claus
parents: 1
diff changeset
  2171
85
claus
parents: 77
diff changeset
  2172
    "
213
3b56a17534fd *** empty log message ***
claus
parents: 211
diff changeset
  2173
     ObjectMemory incrementalGCLimit:500000.  'do incr. GC very seldom'
3b56a17534fd *** empty log message ***
claus
parents: 211
diff changeset
  2174
     ObjectMemory incrementalGCLimit:100000.  'medium'
3b56a17534fd *** empty log message ***
claus
parents: 211
diff changeset
  2175
     ObjectMemory incrementalGCLimit:10000.   'do incr. GC very often'
3b56a17534fd *** empty log message ***
claus
parents: 211
diff changeset
  2176
     ObjectMemory incrementalGCLimit:nil.     'never'
85
claus
parents: 77
diff changeset
  2177
    "
2
claus
parents: 1
diff changeset
  2178
!
claus
parents: 1
diff changeset
  2179
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2180
incrementalGCLimit
270
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2181
    "return the  allocatedSinceLastGC limit for incremental GC activation.
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2182
     The system will start doing incremental background GC, once more than this number 
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2183
     of bytes have been allocated since the last GC. 
f036aaa9a836 *** empty log message ***
claus
parents: 253
diff changeset
  2184
     The default is 500000; setting it to nil will turn this trigger off."
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2185
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2186
    ^ IncrementalGCLimit
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2187
85
claus
parents: 77
diff changeset
  2188
    "
claus
parents: 77
diff changeset
  2189
     ObjectMemory incrementalGCLimit
claus
parents: 77
diff changeset
  2190
    "
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2191
!
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2192
369
claus
parents: 362
diff changeset
  2193
moreOldSpaceIfUseful
claus
parents: 362
diff changeset
  2194
    "to be called after an incremental GC cycle;
claus
parents: 362
diff changeset
  2195
     if freeSpace is still below limit, allocate more oldSpace"
claus
parents: 362
diff changeset
  2196
claus
parents: 362
diff changeset
  2197
    |limit free amount|
claus
parents: 362
diff changeset
  2198
claus
parents: 362
diff changeset
  2199
    limit := FreeSpaceGCLimit.
claus
parents: 362
diff changeset
  2200
    limit notNil ifTrue:[
claus
parents: 362
diff changeset
  2201
	"/ if reclaimed space is below limit, we have to allocate more
claus
parents: 362
diff changeset
  2202
	"/ oldSpace, to avoid excessive gcSteps (due to freeSpaceLimit 
claus
parents: 362
diff changeset
  2203
	"/ still not reached)
claus
parents: 362
diff changeset
  2204
	"/
claus
parents: 362
diff changeset
  2205
	free := self freeSpace + self freeListSpace.
claus
parents: 362
diff changeset
  2206
	free < (limit * 3 // 2) ifTrue:[
claus
parents: 362
diff changeset
  2207
	    amount := FreeSpaceGCAmount.
claus
parents: 362
diff changeset
  2208
	    amount isNil ifTrue:[
claus
parents: 362
diff changeset
  2209
		amount := limit * 3 // 2.
claus
parents: 362
diff changeset
  2210
	    ].
claus
parents: 362
diff changeset
  2211
	    'OBJECTMEMORY: moreOldSpace to satisfy free-limit' infoPrintNL.
458
ef1a25054341 avoid looping in IGC if moreOldSpace fails
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  2212
	    (self moreOldSpace:(amount - free + (64*1024))) ifFalse:[
ef1a25054341 avoid looping in IGC if moreOldSpace fails
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  2213
		"/
ef1a25054341 avoid looping in IGC if moreOldSpace fails
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  2214
		"/ could not increase oldspace; reset FreeSpaceGCLimit to avoid
ef1a25054341 avoid looping in IGC if moreOldSpace fails
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  2215
		"/ useless retries
ef1a25054341 avoid looping in IGC if moreOldSpace fails
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  2216
		'OBJECTMEMORY: could not increase oldSpace - reset limit' errorPrintNL.
ef1a25054341 avoid looping in IGC if moreOldSpace fails
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  2217
		FreeSpaceGCLimit := nil
ef1a25054341 avoid looping in IGC if moreOldSpace fails
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  2218
	    ]
369
claus
parents: 362
diff changeset
  2219
	].
claus
parents: 362
diff changeset
  2220
    ].
claus
parents: 362
diff changeset
  2221
!
claus
parents: 362
diff changeset
  2222
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2223
moreOldSpace:howMuch
458
ef1a25054341 avoid looping in IGC if moreOldSpace fails
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  2224
    "allocate howMuch bytes more for old objects; return true if this worked,
ef1a25054341 avoid looping in IGC if moreOldSpace fails
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  2225
     false if that failed.
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2226
     This is done automatically, when running out of space, but makes
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2227
     sense, if its known in advance that a lot of memory is needed to
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2228
     avoid multiple reallocations and compresses.
310
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2229
     On systems which do not support the mmap (or equivalent) system call,
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2230
     this (currently) implies a compressing garbage collect - so its slow.
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2231
     Notice: this is a nonstandard interface - use only in special situations."
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2232
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2233
%{  
458
ef1a25054341 avoid looping in IGC if moreOldSpace fails
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  2234
    if (__isSmallInteger(howMuch)) {
ef1a25054341 avoid looping in IGC if moreOldSpace fails
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  2235
	RETURN( __moreOldSpace(__context, _intVal(howMuch)) ? true : false );
ef1a25054341 avoid looping in IGC if moreOldSpace fails
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  2236
    }
ef1a25054341 avoid looping in IGC if moreOldSpace fails
Claus Gittinger <cg@exept.de>
parents: 443
diff changeset
  2237
    RETURN (false);
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2238
%}
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2239
    "
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2240
     ObjectMemory moreOldSpace:1000000
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2241
    "
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2242
!
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2243
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2244
announceSpaceNeed:howMuch
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2245
    "announce to the memory system, that howMuch bytes of memory will be needed
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2246
     soon. The VM tries to prepare itself for this allocation to be performed
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2247
     with less overhead. For example, it could preallocate some memory in one
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2248
     big chunk (instead of doing many smaller reallocations later).
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2249
     Notice: this is a nonstandard interface - use only in special situations.
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2250
     Also, this does a background collect before the big chunk of memory is
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2251
     allocated, not locking other processes while doing so."
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2252
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2253
    (howMuch < (self newSpaceSize // 2)) ifTrue:[
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2254
	self scavenge.
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2255
    ].
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2256
    (self checkForFastNew:howMuch) ifFalse:[
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2257
	(howMuch > (self newSpaceSize // 2)) ifFalse:[
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2258
	    self scavenge.
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2259
	].
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2260
	self incrementalGC.
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2261
	(self checkForFastNew:howMuch) ifFalse:[
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2262
	    self moreOldSpace:howMuch
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2263
	]
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2264
    ]
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2265
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2266
    "
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2267
     ObjectMemory announceSpaceNeed:100000
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2268
    "
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2269
!
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2270
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2271
announceOldSpaceNeed:howMuch
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2272
    "announce to the memory system, that howMuch bytes of memory will be needed
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2273
     soon, which is going to live longer (whatever that means). 
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2274
     It first checks if the memory can be allocated without forcing a compressing
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2275
     GC. If not, the oldSpace is increased. This may also lead to a slow compressing
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2276
     collect. However, many smaller increases are avoided afterwards. Calling this
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2277
     method before allocating huge chunks of data may provide better overall performance.
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2278
     Notice: this is a nonstandard interface - use only in special situations."
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2279
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2280
    (self checkForFastNew:howMuch) ifFalse:[
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2281
	self incrementalGC.
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2282
	(self checkForFastNew:howMuch) ifFalse:[
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2283
	    self moreOldSpace:howMuch
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2284
	]
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2285
    ]
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2286
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2287
    "
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2288
     ObjectMemory announceOldSpaceNeed:1000000
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2289
    "
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2290
!
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2291
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2292
oldSpaceIncrement
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2293
    "return the oldSpaceIncrement value. Thats the amount by which
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2294
     more memory is allocated in case the oldSpace gets filled up.
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2295
     In normal situations, the default value used in the VM is fine
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2296
     and there is no need to change it."
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2297
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2298
%{  /* NOCONTEXT */
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2299
    extern unsigned __oldSpaceIncrement();
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2300
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2301
    RETURN (_MKSMALLINT( __oldSpaceIncrement(-1) )); 
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2302
%}
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2303
    "
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2304
     ObjectMemory oldSpaceIncrement
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2305
    "
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2306
!
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2307
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2308
oldSpaceIncrement:amount
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2309
    "set the oldSpaceIncrement value. Thats the amount by which
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2310
     more memory is allocated in case the oldSpace gets filled up.
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2311
     In normal situations, the default value used in the VM is fine
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2312
     and there is no need to change it. This method returns the 
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2313
     previous increment value."
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2314
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2315
%{  /* NOCONTEXT */
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2316
    extern unsigned __oldSpaceIncrement();
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2317
253
30daee717a53 *** empty log message ***
claus
parents: 229
diff changeset
  2318
    if (__isSmallInteger(amount)) {
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2319
	RETURN (_MKSMALLINT( __oldSpaceIncrement(_intVal(amount)) )); 
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2320
    }
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2321
%}
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2322
    "to change increment to 1Meg:"
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2323
    "
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2324
     ObjectMemory oldSpaceIncrement:1024*1024
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2325
    "
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2326
!
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2327
329
claus
parents: 326
diff changeset
  2328
oldSpaceCompressLimit:amount
claus
parents: 326
diff changeset
  2329
    "set the limit for oldSpace compression. If more memory than this
claus
parents: 326
diff changeset
  2330
     limit is in use, the system will not perform compresses on the oldspace,
claus
parents: 326
diff changeset
  2331
     but instead do a mark&sweep GC followed by an oldSpace increase if not enough
claus
parents: 326
diff changeset
  2332
     could be reclaimed. The default is currently some 8Mb, which is ok for workstations
claus
parents: 326
diff changeset
  2333
     with 16..32Mb of physical memory. If your system has much more physical RAM,
claus
parents: 326
diff changeset
  2334
     you may want to increase this limit.
claus
parents: 326
diff changeset
  2335
     This method returns the previous increment value."
claus
parents: 326
diff changeset
  2336
claus
parents: 326
diff changeset
  2337
%{  /* NOCONTEXT */
claus
parents: 326
diff changeset
  2338
    extern unsigned __compressingGCLimit();
claus
parents: 326
diff changeset
  2339
claus
parents: 326
diff changeset
  2340
    if (__isSmallInteger(amount)) {
claus
parents: 326
diff changeset
  2341
	RETURN (_MKSMALLINT( __compressingGCLimit(_intVal(amount)) ));
claus
parents: 326
diff changeset
  2342
    }
claus
parents: 326
diff changeset
  2343
%}
claus
parents: 326
diff changeset
  2344
    "to change the limit to 12Mb:"
claus
parents: 326
diff changeset
  2345
    "
claus
parents: 326
diff changeset
  2346
     ObjectMemory oldSpaceCompressLimit:12*1024*1024
claus
parents: 326
diff changeset
  2347
    "
claus
parents: 326
diff changeset
  2348
!
claus
parents: 326
diff changeset
  2349
 
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2350
fastMoreOldSpaceAllocation:aBoolean
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2351
    "this method turns on/off fastMoreOldSpace allocation.
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2352
     By default, this is turned off (false), which means that in case of
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2353
     a filled-up oldSpace, a GC is tried first before more oldSpace is allocated. 
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2354
     This strategy is ok for the normal operation of the system,
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2355
     but behaves badly, if the program allocates huge data structures (say a
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2356
     game tree of 30Mb in size) which survives and therefore will not be reclaimed
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2357
     by a GC.
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2358
     Of course while building this tree, and the memory becomes full, the system 
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2359
     would not know in advance, that the GC will not reclaim anything.
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2360
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2361
     Setting fastOldSpaceIncrement to true will avoid this, by forcing the
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2362
     memory system to allocate more memory right away, without doing a GC first.
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2363
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2364
     WARNING: make certain that this flag is turned off, after your huge data
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2365
     is allocated, since otherwise the system may continue to increase its
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2366
     virtual memory without ever checking for garbage.
310
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2367
     This method returns the previous value of the flag; typically this return
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2368
     value should be used to switch back."
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2369
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2370
%{   /* NOCONTEXT */
370
claus
parents: 369
diff changeset
  2371
     extern int __fastMoreOldSpaceAllocation();
claus
parents: 369
diff changeset
  2372
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2373
     RETURN (__fastMoreOldSpaceAllocation(aBoolean == true ? 1 : 0) ? true : false);
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2374
%}
310
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2375
    "
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2376
     |previousSetting|
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2377
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2378
     previousSetting := ObjectMemory fastMoreOldSpaceAllocation:true.
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2379
     [
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2380
	...
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2381
	allocate your huge data
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2382
	...
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2383
     ] valueNoOrOnUnwindDo:[
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2384
	ObjectMemory fastMoreOldSpaceAllocation:previousSetting
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2385
     ]
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2386
    "
370
claus
parents: 369
diff changeset
  2387
claus
parents: 369
diff changeset
  2388
    "
claus
parents: 369
diff changeset
  2389
     |prev this|
claus
parents: 369
diff changeset
  2390
claus
parents: 369
diff changeset
  2391
     prev := ObjectMemory fastMoreOldSpaceAllocation:true.
claus
parents: 369
diff changeset
  2392
     ObjectMemory fastMoreOldSpaceAllocation:prev.
claus
parents: 369
diff changeset
  2393
     ^ prev
claus
parents: 369
diff changeset
  2394
    "
claus
parents: 369
diff changeset
  2395
!
claus
parents: 369
diff changeset
  2396
claus
parents: 369
diff changeset
  2397
fastMoreOldSpaceLimit:aNumber
claus
parents: 369
diff changeset
  2398
    "this method sets and returns the fastMoreOldSpace limit.
claus
parents: 369
diff changeset
  2399
     If fastMoreOldSpaceAllocation is true, and the current oldSpace size is
claus
parents: 369
diff changeset
  2400
     below this limit, the memory manager will NOT do a GC when running out of
claus
parents: 369
diff changeset
  2401
     oldSpace, but instead quickly go ahead increasing the size of the oldSpace.
claus
parents: 369
diff changeset
  2402
     Setting the limit to 0 turns off any limit (i.e. it will continue to
claus
parents: 369
diff changeset
  2403
     increase the oldSpace forwever - actually, until the OS refuses to give us
claus
parents: 369
diff changeset
  2404
     more memory). The returned value is the previous setting of the limit."
claus
parents: 369
diff changeset
  2405
claus
parents: 369
diff changeset
  2406
%{   /* NOCONTEXT */
claus
parents: 369
diff changeset
  2407
     extern int __fastMoreOldSpaceLimit();
claus
parents: 369
diff changeset
  2408
claus
parents: 369
diff changeset
  2409
     if (__isSmallInteger(aNumber)) {
claus
parents: 369
diff changeset
  2410
	 RETURN ( __MKSMALLINT( __fastMoreOldSpaceLimit(__intVal(aNumber))));
claus
parents: 369
diff changeset
  2411
     }
claus
parents: 369
diff changeset
  2412
%}.
claus
parents: 369
diff changeset
  2413
     self primitiveFailed
claus
parents: 369
diff changeset
  2414
    
claus
parents: 369
diff changeset
  2415
    "
claus
parents: 369
diff changeset
  2416
     |prev this|
claus
parents: 369
diff changeset
  2417
claus
parents: 369
diff changeset
  2418
     prev := ObjectMemory fastMoreOldSpaceLimit:10*1024*1024.
claus
parents: 369
diff changeset
  2419
     ObjectMemory fastMoreOldSpaceLimit:prev.
claus
parents: 369
diff changeset
  2420
     ^ prev
claus
parents: 369
diff changeset
  2421
    "
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2422
!
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2423
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2424
checkForFastNew:amount
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2425
    "this method returns true, if amount bytes could be allocated
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2426
     quickly (i.e. without forcing a full GC or compress).
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2427
     This can be used for smart background processes, which want to
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2428
     allocate big chunks of data without disturbing foreground processes
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2429
     too much. Such a process would check for fast-allocation, and perform
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2430
     incremental GC-steps if required. Thus, avoiding the long blocking pause 
310
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2431
     due to a forced (non-incremental) GC. 
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2432
     Especially: doing so will not block higher priority foreground processes.
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2433
     See an example use in Behavior>>niceBasicNew:.
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2434
     This is experimental and not guaranteed to be in future versions."
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2435
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2436
%{  /* NOCONTEXT */
370
claus
parents: 369
diff changeset
  2437
    extern int __checkForFastNew();
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2438
253
30daee717a53 *** empty log message ***
claus
parents: 229
diff changeset
  2439
    if (__isSmallInteger(amount)) {
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2440
	if (! __checkForFastNew(_intVal(amount))) {
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2441
	    RETURN (false);
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2442
	}
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2443
    }
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2444
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2445
%}.
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2446
    ^ true
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2447
!
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2448
2
claus
parents: 1
diff changeset
  2449
turnGarbageCollectorOff
310
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2450
    "turn off the generational garbage collector by forcing new objects to be
fbfb977ae1bd *** empty log message ***
claus
parents: 308
diff changeset
  2451
     allocated directly in oldSpace (instead of newSpace)
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2452
     WARNING:
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2453
     This is somewhat dangerous: if collector is turned off,
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  2454
     and too many objects are created, the system may run into trouble
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  2455
     (i.e. oldSpace becomes full) and be forced to perform a full mark&sweep
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2456
     or even a compressing collect - making the overall realtime behavior worse.
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2457
     Use this only for special purposes or when realtime behavior
403
claus
parents: 384
diff changeset
  2458
     is required for a limited time period.
claus
parents: 384
diff changeset
  2459
claus
parents: 384
diff changeset
  2460
     OBSOLETE: this is no longer supported 
claus
parents: 384
diff changeset
  2461
	       - it may be a no-operation by the time you read this."
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2462
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2463
%{  /* NOCONTEXT */
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2464
    __allocForceSpace(OLDSPACE);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2465
%}
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2466
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2467
2
claus
parents: 1
diff changeset
  2468
turnGarbageCollectorOn
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2469
    "turn garbage collector on again (see ObjectMemory>>turnGarbageCollectorOff)"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2470
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2471
%{  /* NOCONTEXT */
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2472
    __allocForceSpace(9999);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2473
%}
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2474
!
85
claus
parents: 77
diff changeset
  2475
claus
parents: 77
diff changeset
  2476
makeOld:anObject
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2477
    "move anObject into oldSpace.
133
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2478
     This method is for internal & debugging purposes only -
433d44af1630 more GC control
claus
parents: 93
diff changeset
  2479
     it may vanish. Dont use it."
85
claus
parents: 77
diff changeset
  2480
%{
claus
parents: 77
diff changeset
  2481
    if (__moveToOldSpace(anObject, __context) < 0) {
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2482
	RETURN (false);
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2483
    }
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2484
%}.
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2485
    ^ true
194
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  2486
!
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  2487
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  2488
tenureParameters:magic
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  2489
    "this is pure magic and not for public eyes ...
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2490
     This method allows fine tuning the scavenger internals,
194
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  2491
     in cooperation to some statistic & test programs.
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2492
     It is undocumented, secret and may vanish. 
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2493
     If you play around here, the system may behave very strange."
194
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  2494
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  2495
%{  /* NOCONTEXT */
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  2496
    __tenureParams(magic);
197c209e61f4 fine tuning tenure
claus
parents: 178
diff changeset
  2497
%}.
370
claus
parents: 369
diff changeset
  2498
!
claus
parents: 369
diff changeset
  2499
379
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2500
lockTenure:flag
370
claus
parents: 369
diff changeset
  2501
    "set/clear the tenureLock. If the lock is set, the system
claus
parents: 369
diff changeset
  2502
     completely turns off tenuring, and objects remain in newSpace (forever).
379
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2503
     Once this lock is set, the system operates only in the newSpace and no memory 
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2504
     allocations from oldSpace are allowed (except for explicit tenure calls). 
370
claus
parents: 369
diff changeset
  2505
     If any allocation request cannot be resoved, the VM raises a memory interrupt,
379
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2506
     clears the lockTenure-flag and returns nil. Thus, it automatically falls back into
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2507
     the normal mode of operation, to avoid big trouble 
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2508
     (fail to allocate memory when handling the exception).
370
claus
parents: 369
diff changeset
  2509
claus
parents: 369
diff changeset
  2510
     This interface can be used in applications, which are guaranteed to have their
claus
parents: 369
diff changeset
  2511
     working set completely in the newSpace AND want to limit the worst case
379
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2512
     pause times to the worst case scavenge time 
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2513
     (which itself is limitd by the size of the newSpace). 
370
claus
parents: 369
diff changeset
  2514
     I.e. systems which go into some event loop after initial startup,
claus
parents: 369
diff changeset
  2515
     may turn on the tenureLock to make certain that no oldSpace memory is 
379
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2516
     allocated in the future; thereby limiting any GC activity to newSpace scavenges only.
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2517
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2518
     This is an EXPERIMENTAL interface.
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2519
    "
370
claus
parents: 369
diff changeset
  2520
claus
parents: 369
diff changeset
  2521
%{
379
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2522
    if (flag == true) {
370
claus
parents: 369
diff changeset
  2523
	__tenure(__context);
claus
parents: 369
diff changeset
  2524
    }
379
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2525
    __lockTenure(flag == true ? 1 : 0);
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2526
%}
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2527
!
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2528
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2529
avoidTenure:flag
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2530
    "set/clear the avoidTenure flag. If set, aging of newSpace is turned off
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2531
     as long as the newSpace fill-grade stays below some magic high-water mark.
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2532
     If off (the default), aging is done as usual.
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2533
     If the flag is turned on, scavenge may be a bit slower, due to more
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2534
     objects being copied around. However, chances are high that in an idle
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2535
     or (almost idle) system, less objects are moved into oldSpace.
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2536
     Therefore, this helps to avoid oldSpace colelcts, in systems which go into
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2537
     some standby mode and are reactivated by some external event.
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2538
     (the avoid-flag should be turned off there, and set again once the idle loop
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2539
     is reentered).
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2540
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2541
    This is an EXPERIMENTAL interface."
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2542
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2543
%{  /* NOCONTEXT */
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2544
    __avoidTenure(flag == true ? 1 : 0);
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2545
%}
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2546
!
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2547
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2548
watchTenure:flag
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2549
    "set/clear the tenureWatch. If set, an internalError exception will be raised,
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2550
     whenever objects are tenured from newSpace into oldSpace
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2551
     (except for an explicit tenure request). 
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2552
     This can be used to validate that no oldSpace objects are created
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2553
     (i.e. the system operates fully in newSpace). 
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2554
     Be careful, if the avoidTenure flag is not set, 
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2555
     there will almost always be a tenure sooner or later.
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2556
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2557
    EXPERIMENTAL - no warranty"
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2558
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2559
%{  /* NOCONTEXT */
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2560
    __watchTenure(flag == true ? 1 : 0);
370
claus
parents: 369
diff changeset
  2561
%}
claus
parents: 369
diff changeset
  2562
!
claus
parents: 369
diff changeset
  2563
claus
parents: 369
diff changeset
  2564
newSpaceSize:newSize
claus
parents: 369
diff changeset
  2565
    "change the size of the newSpace. To do this, the current contents
claus
parents: 369
diff changeset
  2566
     of the newSpace may have to be tenured (if size is smaller).
claus
parents: 369
diff changeset
  2567
     Returns false, if it failed for any reason.
claus
parents: 369
diff changeset
  2568
     Experimental: this interface may valish without notice.
claus
parents: 369
diff changeset
  2569
claus
parents: 369
diff changeset
  2570
     DANGER ALERT:
claus
parents: 369
diff changeset
  2571
	be careful too big of a size may lead to longer scavenge pauses.
claus
parents: 369
diff changeset
  2572
	Too small of a newSpace may lead to more CPU overhead, due to
claus
parents: 369
diff changeset
  2573
	excessive scavenges. You have been warned."
claus
parents: 369
diff changeset
  2574
claus
parents: 369
diff changeset
  2575
%{  
claus
parents: 369
diff changeset
  2576
    extern int __setNewSpaceSize();
claus
parents: 369
diff changeset
  2577
claus
parents: 369
diff changeset
  2578
    if (__isSmallInteger(newSize)) {
claus
parents: 369
diff changeset
  2579
	RETURN (__setNewSpaceSize(__intVal(newSize)) ? true : false);
claus
parents: 369
diff changeset
  2580
    }
claus
parents: 369
diff changeset
  2581
%}.
claus
parents: 369
diff changeset
  2582
    self primitiveFailed
claus
parents: 369
diff changeset
  2583
claus
parents: 369
diff changeset
  2584
    " less absolute CPU overhead (but longer pauses):
claus
parents: 369
diff changeset
  2585
claus
parents: 369
diff changeset
  2586
     ObjectMemory newSpaceSize:800*1024
claus
parents: 369
diff changeset
  2587
    "
claus
parents: 369
diff changeset
  2588
claus
parents: 369
diff changeset
  2589
    " smaller pauses, but more overall CPU overhead:
claus
parents: 369
diff changeset
  2590
claus
parents: 369
diff changeset
  2591
     ObjectMemory newSpaceSize:200*1024
claus
parents: 369
diff changeset
  2592
    "
claus
parents: 369
diff changeset
  2593
claus
parents: 369
diff changeset
  2594
    " the default:
claus
parents: 369
diff changeset
  2595
claus
parents: 369
diff changeset
  2596
     ObjectMemory newSpaceSize:400*1024
claus
parents: 369
diff changeset
  2597
    "
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2598
! !
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2599
362
claus
parents: 360
diff changeset
  2600
!ObjectMemory class ignoredMethodsFor:'object finalization'!
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2601
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2602
allShadowObjectsDo:aBlock
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2603
    "evaluate the argument, aBlock for all known shadow objects"
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2604
%{
326
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  2605
    __allShadowObjectsDo(&aBlock COMMA_CON);
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2606
%}
362
claus
parents: 360
diff changeset
  2607
! !
claus
parents: 360
diff changeset
  2608
claus
parents: 360
diff changeset
  2609
!ObjectMemory class methodsFor:'object finalization'!
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2610
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2611
allChangedShadowObjectsDo:aBlock
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2612
    "evaluate the argument, aBlock for all known shadow objects which have
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2613
     lost a pointer recently."
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2614
%{
326
d2902942491d *** empty log message ***
claus
parents: 325
diff changeset
  2615
    __allChangedShadowObjectsDo(&aBlock COMMA_CON);
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2616
%}
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2617
!
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2618
291
5e036c656524 *** empty log message ***
claus
parents: 290
diff changeset
  2619
finalize
5e036c656524 *** empty log message ***
claus
parents: 290
diff changeset
  2620
    "tell all weak objects that something happened."
5e036c656524 *** empty log message ***
claus
parents: 290
diff changeset
  2621
5e036c656524 *** empty log message ***
claus
parents: 290
diff changeset
  2622
    self allChangedShadowObjectsDo:[:aShadowArray | 
5e036c656524 *** empty log message ***
claus
parents: 290
diff changeset
  2623
	aShadowArray lostPointer.
5e036c656524 *** empty log message ***
claus
parents: 290
diff changeset
  2624
    ]
5e036c656524 *** empty log message ***
claus
parents: 290
diff changeset
  2625
!
5e036c656524 *** empty log message ***
claus
parents: 290
diff changeset
  2626
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2627
disposeInterrupt
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2628
    "this is triggered by the garbage collector,
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2629
     whenever any shadowArray looses a pointer."
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2630
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2631
    FinalizationSemaphore notNil ifTrue:[
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2632
	"/
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2633
	"/ background finalizer is waiting ...
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2634
	"/
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2635
	FinalizationSemaphore signal
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2636
    ] ifFalse:[
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2637
	"/
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2638
	"/ do it right here
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2639
	"/
291
5e036c656524 *** empty log message ***
claus
parents: 290
diff changeset
  2640
	self finalize
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2641
    ]
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2642
!
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2643
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2644
startBackgroundFinalizationAt:aPriority
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2645
    "start a process doing finalization work in the background.
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2646
     Can be used to reduce the pauses created by finalization.
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2647
     Normally, these pauses are not noticed; however if you have (say)
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2648
     ten thousands of weak objects, these could become long enough to
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2649
     make background finalization usefull.
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2650
     WARNING: background finalization may lead to much delayed freeing of
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2651
     system resources. Especially, you may temporarily run out of free
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2652
     color table entries or fileDescriptors etc. Use at your own risk (if at all)"
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2653
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2654
    |p|
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2655
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2656
    "/
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2657
    "/ its not useful, to run it more than once
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2658
    "/
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2659
    BackgroundFinalizationProcess notNil ifTrue:[
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2660
	BackgroundFinalizationProcess priority:aPriority.
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2661
	^ self
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2662
    ].
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2663
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2664
    FinalizationSemaphore := Semaphore new.
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2665
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2666
    p :=
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2667
	[
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2668
	    [
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2669
		[true] whileTrue:[
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2670
		    "
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2671
		     wait till something to do ...
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2672
		    "
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2673
		    FinalizationSemaphore wait.
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2674
		    "
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2675
		     ... and do it
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2676
		    "
291
5e036c656524 *** empty log message ***
claus
parents: 290
diff changeset
  2677
		    self finalize
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2678
		]
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2679
	    ] valueOnUnwindDo:[
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2680
		BackgroundFinalizationProcess := nil.
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2681
		FinalizationSemaphore := nil
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2682
	    ]
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2683
	] newProcess.
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2684
    p name:'background finalizer'.
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2685
    p priority:aPriority.
339
claus
parents: 335
diff changeset
  2686
    p restartable:true.
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2687
    p resume.
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2688
    BackgroundFinalizationProcess := p
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2689
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2690
    "
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2691
     ObjectMemory startBackgroundFinalizationAt:5
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2692
    "
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2693
!
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2694
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2695
stopBackgroundFinalization
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2696
    "stop the background finalizer"
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2697
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2698
    BackgroundFinalizationProcess notNil ifTrue:[
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2699
	BackgroundFinalizationProcess terminate.
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2700
	BackgroundFinalizationProcess := nil
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2701
    ].
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2702
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2703
    "
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2704
     ObjectMemory stopBackgroundFinalization
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2705
    "
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2706
! !
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2707
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2708
!ObjectMemory class methodsFor:'physical memory access'!
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2709
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2710
newSpacePagesDo:aBlock
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2711
    "evaluates aBlock for all pages in the newSpace, passing
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2712
     the pages address as argument.
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2713
     For internal & debugging use only."
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2714
%{
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2715
    if (__newSpacePagesDo(&aBlock COMMA_CON) < 0) {
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2716
	RETURN (false);
85
claus
parents: 77
diff changeset
  2717
    }
claus
parents: 77
diff changeset
  2718
%}.
claus
parents: 77
diff changeset
  2719
    ^ true
claus
parents: 77
diff changeset
  2720
!
claus
parents: 77
diff changeset
  2721
claus
parents: 77
diff changeset
  2722
oldSpacePagesDo:aBlock
claus
parents: 77
diff changeset
  2723
    "evaluates aBlock for all pages in the oldSpace, passing
claus
parents: 77
diff changeset
  2724
     the pages address as argument. 
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2725
     For internal & debugging use only."
85
claus
parents: 77
diff changeset
  2726
%{
claus
parents: 77
diff changeset
  2727
    if (__oldSpacePagesDo(&aBlock COMMA_CON) < 0) {
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2728
	RETURN (false);
85
claus
parents: 77
diff changeset
  2729
    }
claus
parents: 77
diff changeset
  2730
%}.
claus
parents: 77
diff changeset
  2731
    ^ true
claus
parents: 77
diff changeset
  2732
!
claus
parents: 77
diff changeset
  2733
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2734
collectedOldSpacePagesDo:aBlock
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2735
    "evaluates aBlock for all pages in the prev. oldSpace, passing
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2736
     the pages address as argument. 
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2737
     For internal & debugging use only."
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2738
%{
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2739
    if (__collectedOldSpacePagesDo(&aBlock COMMA_CON) < 0) {
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2740
	RETURN (false);
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2741
    }
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2742
%}.
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2743
    ^ true
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2744
!
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2745
85
claus
parents: 77
diff changeset
  2746
pageIsInCore:aPageNumber
claus
parents: 77
diff changeset
  2747
    "return true, if the page (as enumerated via oldSpacePagesDo:)
claus
parents: 77
diff changeset
  2748
     is in memory; false, if currently paged out. For internal
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2749
     use / monitors only; may vanish.
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2750
     NOTICE: not all systems provide this information; on those that
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2751
     do not, true is returned for all pages."
85
claus
parents: 77
diff changeset
  2752
%{
claus
parents: 77
diff changeset
  2753
#ifdef HAS_MINCORE
claus
parents: 77
diff changeset
  2754
    int pageSize = getpagesize();
claus
parents: 77
diff changeset
  2755
    char result[10];
claus
parents: 77
diff changeset
  2756
    INT addr;
claus
parents: 77
diff changeset
  2757
253
30daee717a53 *** empty log message ***
claus
parents: 229
diff changeset
  2758
    if (__isSmallInteger(aPageNumber)) {
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2759
	addr = _intVal(aPageNumber) & ~(pageSize - 1);
85
claus
parents: 77
diff changeset
  2760
    } else {
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2761
	addr = ((INT)aPageNumber) & ~(pageSize - 1);
85
claus
parents: 77
diff changeset
  2762
    }
claus
parents: 77
diff changeset
  2763
    if (mincore(addr, pageSize-1, result) < 0) {
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2764
	RETURN (true);
85
claus
parents: 77
diff changeset
  2765
    }
claus
parents: 77
diff changeset
  2766
    RETURN ((result[0] & 1) ? true : false);
claus
parents: 77
diff changeset
  2767
#endif
claus
parents: 77
diff changeset
  2768
%}.
claus
parents: 77
diff changeset
  2769
    "OS does not supply this info - assume yes"
claus
parents: 77
diff changeset
  2770
    ^ true
claus
parents: 77
diff changeset
  2771
! !
claus
parents: 77
diff changeset
  2772
379
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2773
!ObjectMemory class methodsFor:'statistics'!
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2774
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2775
ageStatistic
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2776
%{   /* NOCONTEXT */
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2777
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2778
    __ageStatistics();
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2779
%}
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2780
! !
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  2781
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2782
!ObjectMemory class methodsFor:'low memory handling'!
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2783
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2784
memoryInterrupt
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2785
    "when a low-memory condition arises, ask all classes to
290
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2786
     remove possibly cached data. You may help the system a bit,
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2787
     in providing a lowSpaceCleanup method in your classes which have
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2788
     lots of data kept somewhere (usually, cached data).
23994c0a7f7b *** empty log message ***
claus
parents: 282
diff changeset
  2789
     - this may or may not help."
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2790
308
f04744ef7b5d *** empty log message ***
claus
parents: 302
diff changeset
  2791
    Smalltalk allBehaviorsDo:[:aClass |
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2792
	aClass lowSpaceCleanup
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2793
    ].
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2794
178
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2795
"/    self error:'almost out of memory'
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2796
    'almost out of memory' errorPrintNL.
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2797
4da1b10bf42c more GC control
claus
parents: 159
diff changeset
  2798
    LowSpaceSemaphore signalIf.
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2799
! !
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2800
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2801
!ObjectMemory class methodsFor:'system management'!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2802
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2803
loadClassBinary:aClassName
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2804
    "find the object file for aClassName and -if found - load it;
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2805
     this one loads precompiled object files"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2806
357
claus
parents: 356
diff changeset
  2807
    |fName newClass|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2808
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2809
    fName := self fileNameForClass:aClassName.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2810
    fName notNil ifTrue:[
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2811
	Class withoutUpdatingChangesDo:
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2812
	[
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2813
	    self loadBinary:(fName , '.o')
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2814
	].
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2815
	newClass := self at:(aClassName asSymbol).
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2816
	(newClass notNil and:[newClass implements:#initialize]) ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2817
	    newClass initialize
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2818
	]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2819
    ]
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2820
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2821
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  2822
imageName
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  2823
    "return the filename of the current image, or nil
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  2824
     if not running from an image."
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  2825
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  2826
    ^ ImageName
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2827
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2828
    "
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2829
     ObjectMemory imageName 
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2830
    "
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2831
!
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2832
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2833
imageBaseName
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2834
    "return a reasonable filename to use as baseName (i.e. without extension).
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2835
     This is the filename of the current image (without '.img') or,
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2836
     if not running from an image, the default name 'st'"
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2837
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2838
    |nm|
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2839
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2840
    nm := ImageName.
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2841
    (nm isNil or:[nm isBlank]) ifTrue:[
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2842
	^ 'st'
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2843
    ].
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2844
    (nm endsWith:'.sav') ifTrue:[
359
claus
parents: 357
diff changeset
  2845
	nm := nm copyWithoutLast:4
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2846
    ].
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2847
    (nm endsWith:'.img') ifTrue:[
359
claus
parents: 357
diff changeset
  2848
	^ nm copyWithoutLast:4
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2849
    ].
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2850
    ^ nm
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2851
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2852
    "
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2853
     ObjectMemory imageBaseName    
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2854
    "
77
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  2855
!
6c38ca59927f *** empty log message ***
claus
parents: 68
diff changeset
  2856
22
847106305963 *** empty log message ***
claus
parents: 13
diff changeset
  2857
nameForSnapshot
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2858
    "return a reasonable filename to store the snapshot image into.
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2859
     This is the filename of the current image or,
22
847106305963 *** empty log message ***
claus
parents: 13
diff changeset
  2860
     if not running from an image, the default name 'st.img'"
847106305963 *** empty log message ***
claus
parents: 13
diff changeset
  2861
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2862
    ^ self imageBaseName , '.img'
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2863
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2864
    "
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2865
     ObjectMemory nameForSnapshot    
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2866
    "
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2867
!
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2868
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2869
nameForSources
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2870
    "return a reasonable filename to store the sources into.
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2871
     This is the basename of the current image with '.img' replaced
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2872
     by '.src', or, if not running from an image, the default name 'st.src'"
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2873
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2874
    ^ self imageBaseName , '.src'
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2875
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2876
    "
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2877
     ObjectMemory nameForSources    
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2878
    "
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2879
!
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2880
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2881
nameForChanges
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2882
    "return a reasonable filename to store the changes into.
525
5d725316fd4a allow setting the change-file-name
Claus Gittinger <cg@exept.de>
parents: 510
diff changeset
  2883
     Currently, this is defined in a classVariable and defaults to 'changes'.
5d725316fd4a allow setting the change-file-name
Claus Gittinger <cg@exept.de>
parents: 510
diff changeset
  2884
     In future versions, this will be the basename of the current image with '.img' replaced
5d725316fd4a allow setting the change-file-name
Claus Gittinger <cg@exept.de>
parents: 510
diff changeset
  2885
     by '.chg', or, if not running from an image, the default name 'st.chg'."
5d725316fd4a allow setting the change-file-name
Claus Gittinger <cg@exept.de>
parents: 510
diff changeset
  2886
5d725316fd4a allow setting the change-file-name
Claus Gittinger <cg@exept.de>
parents: 510
diff changeset
  2887
    ChangeFileName notNil ifTrue:[^ ChangeFileName].
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2888
    ^ 'changes'.
360
claus
parents: 359
diff changeset
  2889
claus
parents: 359
diff changeset
  2890
"/ future versions will have:
claus
parents: 359
diff changeset
  2891
"/ (requires some additionas at other places)
claus
parents: 359
diff changeset
  2892
"/
claus
parents: 359
diff changeset
  2893
"/    ^ self imageBaseName , '.chg'
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2894
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2895
    "
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2896
     ObjectMemory nameForChanges    
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2897
    "
22
847106305963 *** empty log message ***
claus
parents: 13
diff changeset
  2898
!
847106305963 *** empty log message ***
claus
parents: 13
diff changeset
  2899
525
5d725316fd4a allow setting the change-file-name
Claus Gittinger <cg@exept.de>
parents: 510
diff changeset
  2900
nameForChanges:aFilename
5d725316fd4a allow setting the change-file-name
Claus Gittinger <cg@exept.de>
parents: 510
diff changeset
  2901
    "set the name of the file where changes are stored into."
5d725316fd4a allow setting the change-file-name
Claus Gittinger <cg@exept.de>
parents: 510
diff changeset
  2902
5d725316fd4a allow setting the change-file-name
Claus Gittinger <cg@exept.de>
parents: 510
diff changeset
  2903
    ChangeFileName := aFilename
5d725316fd4a allow setting the change-file-name
Claus Gittinger <cg@exept.de>
parents: 510
diff changeset
  2904
5d725316fd4a allow setting the change-file-name
Claus Gittinger <cg@exept.de>
parents: 510
diff changeset
  2905
    "
5d725316fd4a allow setting the change-file-name
Claus Gittinger <cg@exept.de>
parents: 510
diff changeset
  2906
     ObjectMemory nameForChanges:'myChanges'    
5d725316fd4a allow setting the change-file-name
Claus Gittinger <cg@exept.de>
parents: 510
diff changeset
  2907
    "
5d725316fd4a allow setting the change-file-name
Claus Gittinger <cg@exept.de>
parents: 510
diff changeset
  2908
!
5d725316fd4a allow setting the change-file-name
Claus Gittinger <cg@exept.de>
parents: 510
diff changeset
  2909
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2910
snapShot
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2911
    "create a snapshot file containing all of the current state."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2912
22
847106305963 *** empty log message ***
claus
parents: 13
diff changeset
  2913
    self snapShotOn:(self nameForSnapshot)
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2914
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2915
    "
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2916
     ObjectMemory snapShot
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2917
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2918
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2919
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2920
snapShotOn:aFileName
329
claus
parents: 326
diff changeset
  2921
    "create a snapshot in the given file. 
claus
parents: 326
diff changeset
  2922
     If the file exists, save it for backup.
claus
parents: 326
diff changeset
  2923
     Return true if the snapshot worked, false if it failed for some reason.
claus
parents: 326
diff changeset
  2924
     Notify dependents before and after the snapshot operation."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2925
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2926
    |ok oldImageName|
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2927
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2928
    "
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2929
     keep a save version - just in case something
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2930
     bad happens while writing the image.
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2931
     (could be st/x internal error or file-system errors etc)
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2932
    "
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2933
    (OperatingSystem isValidPath:aFileName) ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2934
	OperatingSystem renameFile:aFileName to:(aFileName , '.sav').
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2935
    ].
22
847106305963 *** empty log message ***
claus
parents: 13
diff changeset
  2936
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2937
    "
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2938
     give others a chance to fix things
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2939
    "
329
claus
parents: 326
diff changeset
  2940
    self changed:#save.             "/ will vanish ...
claus
parents: 326
diff changeset
  2941
    self changed:#aboutToSnapshot.  "/ ... for ST-80 compatibility
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2942
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2943
    "
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2944
     ST-80 compatibility; send #preSnapshot to all classes
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2945
    "
202
40ca7cc6fb9c *** empty log message ***
claus
parents: 194
diff changeset
  2946
    Smalltalk allBehaviorsDo:[:aClass |
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2947
	aClass preSnapshot
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2948
    ].
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  2949
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2950
    "
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2951
     save the name with it ...
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2952
    "
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2953
    oldImageName := ImageName.
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2954
    ImageName := aFileName.
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2955
    ok := self primSnapShotOn:aFileName.
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2956
    ImageName := oldImageName.
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2957
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2958
    ok ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2959
	Class addChangeRecordForSnapshot:aFileName.
329
claus
parents: 326
diff changeset
  2960
    ].
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2961
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2962
329
claus
parents: 326
diff changeset
  2963
    "
claus
parents: 326
diff changeset
  2964
     ST-80 compatibility; send #postSnapshot to all classes
claus
parents: 326
diff changeset
  2965
    "
claus
parents: 326
diff changeset
  2966
    Smalltalk allBehaviorsDo:[:aClass |
claus
parents: 326
diff changeset
  2967
	aClass postSnapshot
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2968
    ].
329
claus
parents: 326
diff changeset
  2969
    self changed:#finishedSnapshot.  "/ ST-80 compatibility
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2970
    ^ ok
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2971
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2972
    "
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2973
     ObjectMemory snapShotOn:'myimage.img'
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2974
    "
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2975
!
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2976
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2977
primSnapShotOn:aFileName
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2978
    "create a snapshot in the given file.
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2979
     Low level entry. Does not notify classes or write an entry to
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2980
     the changes file. Also, no image backup is created. Returns true if
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2981
     the snapshot worked, false if it failed for some reason.
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2982
     This method should not be used in normal cases."
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2983
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2984
    |ok|
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2985
13
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2986
%{  /* STACK:32000 */
62303f84ff5f *** empty log message ***
claus
parents: 10
diff changeset
  2987
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2988
    OBJ __snapShotOn();
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2989
    OBJ funny = @symbol(funnySnapshotSymbol);
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2990
56
be0ed17e6f85 *** empty log message ***
claus
parents: 22
diff changeset
  2991
    if (__isString(aFileName)) {
356
claus
parents: 345
diff changeset
  2992
	__BLOCKINTERRUPTS();
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2993
	ok = __snapShotOn(__context, _stringVal(aFileName), funny);
356
claus
parents: 345
diff changeset
  2994
	__UNBLOCKINTERRUPTS();
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  2995
    }
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  2996
%}.
22
847106305963 *** empty log message ***
claus
parents: 13
diff changeset
  2997
    ^ ok
418
claus
parents: 403
diff changeset
  2998
!
claus
parents: 403
diff changeset
  2999
claus
parents: 403
diff changeset
  3000
allBinaryModulesDo:aBlock
claus
parents: 403
diff changeset
  3001
    "internal private method - walk over all known binary
claus
parents: 403
diff changeset
  3002
     modules and evaluate aBlock for each entry.
claus
parents: 403
diff changeset
  3003
     Do not depend on the information returned for each - this may
claus
parents: 403
diff changeset
  3004
     change without notice."
claus
parents: 403
diff changeset
  3005
claus
parents: 403
diff changeset
  3006
%{
claus
parents: 403
diff changeset
  3007
    __REGISTRATION_DO_BLOCK(&aBlock COMMA_SND);
claus
parents: 403
diff changeset
  3008
%}
claus
parents: 403
diff changeset
  3009
!
claus
parents: 403
diff changeset
  3010
claus
parents: 403
diff changeset
  3011
binaryModuleInfo
claus
parents: 403
diff changeset
  3012
    "return a collection of moduleInfo entries.
claus
parents: 403
diff changeset
  3013
     This returns a dictionary (keys are internal moduleIDs)
claus
parents: 403
diff changeset
  3014
     with one entry for each binary package."
claus
parents: 403
diff changeset
  3015
claus
parents: 403
diff changeset
  3016
    |modules|
claus
parents: 403
diff changeset
  3017
claus
parents: 403
diff changeset
  3018
    modules := IdentityDictionary new.
claus
parents: 403
diff changeset
  3019
    self allBinaryModulesDo:[:entry | 
438
claus
parents: 435
diff changeset
  3020
	|id name type libName subModuleName module dynamic infoRec pathName
claus
parents: 435
diff changeset
  3021
	 typeName nameString|
418
claus
parents: 403
diff changeset
  3022
claus
parents: 403
diff changeset
  3023
	id := entry at:1.
claus
parents: 403
diff changeset
  3024
	subModuleName := (entry at:2) asSymbol.
claus
parents: 403
diff changeset
  3025
	libName := (entry at:4).
claus
parents: 403
diff changeset
  3026
claus
parents: 403
diff changeset
  3027
	id > 0 ifTrue:[
claus
parents: 403
diff changeset
  3028
	    pathName := ObjectFileLoader pathNameFromID:id.
claus
parents: 403
diff changeset
  3029
	    dynamic := true.
438
claus
parents: 435
diff changeset
  3030
	    typeName := 'dynamic '.
claus
parents: 435
diff changeset
  3031
	    name := pathName asFilename baseName
418
claus
parents: 403
diff changeset
  3032
	] ifFalse:[
claus
parents: 403
diff changeset
  3033
	    dynamic := false.
443
Claus Gittinger <cg@exept.de>
parents: 440
diff changeset
  3034
	    typeName := 'builtIn '.
418
claus
parents: 403
diff changeset
  3035
	    pathName := nil.
claus
parents: 403
diff changeset
  3036
	    libName isNil ifTrue:[
438
claus
parents: 435
diff changeset
  3037
		name := subModuleName
418
claus
parents: 403
diff changeset
  3038
	    ] ifFalse:[
438
claus
parents: 435
diff changeset
  3039
		name := libName
418
claus
parents: 403
diff changeset
  3040
	    ].
claus
parents: 403
diff changeset
  3041
	].
438
claus
parents: 435
diff changeset
  3042
	nameString := typeName.
claus
parents: 435
diff changeset
  3043
	libName isNil ifTrue:[
claus
parents: 435
diff changeset
  3044
	    nameString := nameString, 'module '
claus
parents: 435
diff changeset
  3045
	] ifFalse:[
claus
parents: 435
diff changeset
  3046
	    nameString := nameString, 'classLib '
claus
parents: 435
diff changeset
  3047
	].
claus
parents: 435
diff changeset
  3048
	nameString := nameString , name.
claus
parents: 435
diff changeset
  3049
418
claus
parents: 403
diff changeset
  3050
	libName isNil ifTrue:[
claus
parents: 403
diff changeset
  3051
	    type := #classObject
claus
parents: 403
diff changeset
  3052
	] ifFalse:[
claus
parents: 403
diff changeset
  3053
	    type := #classLibrary
claus
parents: 403
diff changeset
  3054
	].
claus
parents: 403
diff changeset
  3055
	infoRec := modules at:id ifAbsent:nil.
claus
parents: 403
diff changeset
  3056
	infoRec notNil ifTrue:[
claus
parents: 403
diff changeset
  3057
	    (infoRec at:#classNames) add:subModuleName
claus
parents: 403
diff changeset
  3058
	] ifFalse:[
claus
parents: 403
diff changeset
  3059
	    infoRec := IdentityDictionary new.
claus
parents: 403
diff changeset
  3060
	    infoRec at:#id put:id.
claus
parents: 403
diff changeset
  3061
	    infoRec at:#classNames put:(Set with:subModuleName).
claus
parents: 403
diff changeset
  3062
	    infoRec at:#pathName put:pathName.
438
claus
parents: 435
diff changeset
  3063
	    infoRec at:#name put:nameString.
418
claus
parents: 403
diff changeset
  3064
	    infoRec at:#libraryName put:libName.
claus
parents: 403
diff changeset
  3065
	    infoRec at:#dynamic put:dynamic.
claus
parents: 403
diff changeset
  3066
	    infoRec at:#type put:type.
claus
parents: 403
diff changeset
  3067
	    modules at:id put:infoRec.
claus
parents: 403
diff changeset
  3068
	].
claus
parents: 403
diff changeset
  3069
    ].
claus
parents: 403
diff changeset
  3070
    ^ modules
claus
parents: 403
diff changeset
  3071
claus
parents: 403
diff changeset
  3072
    "
claus
parents: 403
diff changeset
  3073
     ObjectMemory binaryModuleInfo
claus
parents: 403
diff changeset
  3074
    "
claus
parents: 403
diff changeset
  3075
438
claus
parents: 435
diff changeset
  3076
    "Modified: 17.9.1995 / 16:33:02 / claus"
418
claus
parents: 403
diff changeset
  3077
!
claus
parents: 403
diff changeset
  3078
claus
parents: 403
diff changeset
  3079
fullBinaryModuleInfo
claus
parents: 403
diff changeset
  3080
    "return a full collection of moduleInfo entries.
claus
parents: 403
diff changeset
  3081
     This returns a dictionary (keys are component names)
claus
parents: 403
diff changeset
  3082
     with one entry for each component in all binary packages."
claus
parents: 403
diff changeset
  3083
claus
parents: 403
diff changeset
  3084
    |modules|
claus
parents: 403
diff changeset
  3085
claus
parents: 403
diff changeset
  3086
    modules := IdentityDictionary new.
claus
parents: 403
diff changeset
  3087
    self allBinaryModulesDo:[:entry | 
claus
parents: 403
diff changeset
  3088
	|id name type libName subModuleName module dynamic infoRec pathName
claus
parents: 403
diff changeset
  3089
	 t|
claus
parents: 403
diff changeset
  3090
claus
parents: 403
diff changeset
  3091
	id := entry at:1.
claus
parents: 403
diff changeset
  3092
	subModuleName := (entry at:2) asSymbol.
claus
parents: 403
diff changeset
  3093
	libName := (entry at:4).
claus
parents: 403
diff changeset
  3094
	t := AbsoluteTime fromOSTime:(entry at:5).
claus
parents: 403
diff changeset
  3095
claus
parents: 403
diff changeset
  3096
	id > 0 ifTrue:[
claus
parents: 403
diff changeset
  3097
	    dynamic := true.
claus
parents: 403
diff changeset
  3098
	] ifFalse:[
claus
parents: 403
diff changeset
  3099
	    dynamic := false.
claus
parents: 403
diff changeset
  3100
	].
claus
parents: 403
diff changeset
  3101
	libName isNil ifTrue:[
claus
parents: 403
diff changeset
  3102
	    type := #classObject
claus
parents: 403
diff changeset
  3103
	] ifFalse:[
claus
parents: 403
diff changeset
  3104
	    type := #classLibrary
claus
parents: 403
diff changeset
  3105
	].
claus
parents: 403
diff changeset
  3106
	infoRec := IdentityDictionary new.
claus
parents: 403
diff changeset
  3107
	infoRec at:#id put:id.
claus
parents: 403
diff changeset
  3108
	infoRec at:#className put:subModuleName.
claus
parents: 403
diff changeset
  3109
	infoRec at:#libraryName put:libName.
claus
parents: 403
diff changeset
  3110
	infoRec at:#dynamic put:dynamic.
claus
parents: 403
diff changeset
  3111
	infoRec at:#type put:type.
claus
parents: 403
diff changeset
  3112
	infoRec at:#timeStamp put:t.
claus
parents: 403
diff changeset
  3113
	modules at:subModuleName put:infoRec.
claus
parents: 403
diff changeset
  3114
    ].
claus
parents: 403
diff changeset
  3115
    ^ modules
claus
parents: 403
diff changeset
  3116
claus
parents: 403
diff changeset
  3117
    "
claus
parents: 403
diff changeset
  3118
     ObjectMemory fullBinaryModuleInfo
claus
parents: 403
diff changeset
  3119
    "
claus
parents: 403
diff changeset
  3120
claus
parents: 403
diff changeset
  3121
    "Modified: 30.8.1995 / 17:29:30 / claus"
379
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  3122
! !
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  3123
5b5a130ccd09 revision added
claus
parents: 375
diff changeset
  3124
!ObjectMemory class ignoredMethodsFor:'system management'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3125
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3126
applicationImageOn:aFileName for:startupClass selector:startupSelector
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3127
    "create a snapshot which will come up without any views 
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  3128
     but starts up an application by sending startupClass the startupSelector.
312
d2e7297b7321 *** empty log message ***
claus
parents: 310
diff changeset
  3129
     This exists to nail down an idea I tried once.
d2e7297b7321 *** empty log message ***
claus
parents: 310
diff changeset
  3130
     It is absolutely EXPERIMENTAL and unfinished. Dont use this method."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3131
2
claus
parents: 1
diff changeset
  3132
    |viewsKnown savedIdleBlocks savedTimeoutBlocks savedTranscript
claus
parents: 1
diff changeset
  3133
     savedRoot|
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3134
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3135
    viewsKnown := Display knownViews.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3136
    savedTranscript := Transcript.
2
claus
parents: 1
diff changeset
  3137
    savedRoot := RootView.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3138
335
claus
parents: 332
diff changeset
  3139
    "a kludge: save image with modified knownViews, 
10
claus
parents: 5
diff changeset
  3140
     and also Transcript set to StdErr ..."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3141
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3142
    Display knownViews:nil.
2
claus
parents: 1
diff changeset
  3143
    RootView := nil.
claus
parents: 1
diff changeset
  3144
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3145
    Transcript := Stderr.
10
claus
parents: 5
diff changeset
  3146
    Smalltalk startupClass:startupClass selector:startupSelector arguments:nil.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3147
    self snapShotOn:aFileName.
10
claus
parents: 5
diff changeset
  3148
    Smalltalk startupClass:nil selector:nil arguments:nil.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3149
2
claus
parents: 1
diff changeset
  3150
    RootView := savedRoot.
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3151
    Transcript := savedTranscript.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3152
    Display knownViews:viewsKnown.
335
claus
parents: 332
diff changeset
  3153
claus
parents: 332
diff changeset
  3154
    "
claus
parents: 332
diff changeset
  3155
     ObjectMemory applicationImageOn:'draw.img' for:DrawTool selector:#start
claus
parents: 332
diff changeset
  3156
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3157
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3158
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3159
minimumApplicationImageOn:aFileName for:startupClass selector:startupSelector
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3160
    "create a snapshot which will come up without any views 
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3161
     but starts up an application by sending startupClass the startupSelector.
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  3162
     All unneeded info is stripped from the saved image.
312
d2e7297b7321 *** empty log message ***
claus
parents: 310
diff changeset
  3163
     This exists to nail down an idea I tried once.
d2e7297b7321 *** empty log message ***
claus
parents: 310
diff changeset
  3164
     It is absolutely EXPERIMENTAL and unfinished. Dont use this method."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3165
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3166
    "create a temporary image, for continuation"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3167
    self snapShotOn:'temp.img'.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3168
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3169
    Display knownViews do:[:aView |
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  3170
	aView notNil ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  3171
	    aView superView isNil ifTrue:[
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  3172
		aView destroy
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  3173
	    ]
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  3174
	]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3175
    ].
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3176
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3177
    self stripImage.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3178
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3179
    self applicationImageOn:aFileName for:startupClass selector:startupSelector.
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3180
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3181
    "continue in old image"
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3182
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3183
    OperatingSystem exec:(Arguments at:1)
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  3184
	   withArguments:#('smalltalk' '-i' 'temp.img') , (Arguments copyFrom:2)
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3185
335
claus
parents: 332
diff changeset
  3186
    "
claus
parents: 332
diff changeset
  3187
     ObjectMemory minimumApplicationImageOn:'draw1.img' for:DrawTool selector:#start
claus
parents: 332
diff changeset
  3188
     ObjectMemory applicationImageOn:'draw2.img' for:DrawTool selector:#start
claus
parents: 332
diff changeset
  3189
    "
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3190
!
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3191
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3192
stripImage
93
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  3193
    "remove all unneeded stuff from the image - much more is possible here.
e31220cb391f *** empty log message ***
claus
parents: 88
diff changeset
  3194
     EXPERIMENTAL and unfinished. Dont use this method."
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3195
2
claus
parents: 1
diff changeset
  3196
    "remove all class comments & source"
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3197
2
claus
parents: 1
diff changeset
  3198
    Smalltalk allBehaviorsDo:[:aClass |
159
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  3199
	aClass setComment:nil.
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  3200
	aClass methodArray do:[:aMethod |
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  3201
	    aMethod source:''.
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  3202
	    aMethod category:#none 
514c749165c3 *** empty log message ***
claus
parents: 133
diff changeset
  3203
	]
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3204
    ].
335
claus
parents: 332
diff changeset
  3205
claus
parents: 332
diff changeset
  3206
    "remove some developpers classes"
claus
parents: 332
diff changeset
  3207
claus
parents: 332
diff changeset
  3208
    Smalltalk at:#Compiler put:Parser.
claus
parents: 332
diff changeset
  3209
    Smalltalk at:#Debugger put:MiniDebugger.
claus
parents: 332
diff changeset
  3210
    Smalltalk at:#Inspector put:MiniInspector.
claus
parents: 332
diff changeset
  3211
    Smalltalk at:#FileBrowser put:nil.
claus
parents: 332
diff changeset
  3212
    Smalltalk at:#SystemBrowser put:nil.
claus
parents: 332
diff changeset
  3213
    Debugger newDebugger.
claus
parents: 332
diff changeset
  3214
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3215
    self garbageCollect
a27a279701f8 Initial revision
claus
parents:
diff changeset
  3216
! !
362
claus
parents: 360
diff changeset
  3217
claus
parents: 360
diff changeset
  3218
!ObjectMemory class methodsFor:'ST-80 compatibility'!
claus
parents: 360
diff changeset
  3219
claus
parents: 360
diff changeset
  3220
availableFreeBytes
claus
parents: 360
diff changeset
  3221
    ^ self freeSpace + self freeListSpace
claus
parents: 360
diff changeset
  3222
claus
parents: 360
diff changeset
  3223
    "
claus
parents: 360
diff changeset
  3224
     ObjectMemory availableFreeBytes 
claus
parents: 360
diff changeset
  3225
    "
claus
parents: 360
diff changeset
  3226
!
claus
parents: 360
diff changeset
  3227
claus
parents: 360
diff changeset
  3228
current
claus
parents: 360
diff changeset
  3229
    ^ self
claus
parents: 360
diff changeset
  3230
!
claus
parents: 360
diff changeset
  3231
claus
parents: 360
diff changeset
  3232
growMemoryBy:numberOfBytes
claus
parents: 360
diff changeset
  3233
    ^ self moreOldSpace:numberOfBytes
claus
parents: 360
diff changeset
  3234
!
claus
parents: 360
diff changeset
  3235
claus
parents: 360
diff changeset
  3236
numOopsNumBytes
claus
parents: 360
diff changeset
  3237
    ^ Array with:(self numberOfObjects)
claus
parents: 360
diff changeset
  3238
	    with:(self bytesUsed)
claus
parents: 360
diff changeset
  3239
claus
parents: 360
diff changeset
  3240
    "
claus
parents: 360
diff changeset
  3241
     ObjectMemory numOopsNumBytes 
claus
parents: 360
diff changeset
  3242
    "
claus
parents: 360
diff changeset
  3243
!
claus
parents: 360
diff changeset
  3244
426
claus
parents: 418
diff changeset
  3245
bytesPerOOP
claus
parents: 418
diff changeset
  3246
    "return the number of bytes an object reference (for example: an instvar)
claus
parents: 418
diff changeset
  3247
     takes"
claus
parents: 418
diff changeset
  3248
claus
parents: 418
diff changeset
  3249
%{  /* NOCONTEXT */
claus
parents: 418
diff changeset
  3250
    RETURN(__MKSMALLINT(sizeof(OBJ)));
claus
parents: 418
diff changeset
  3251
%}
claus
parents: 418
diff changeset
  3252
claus
parents: 418
diff changeset
  3253
    "
claus
parents: 418
diff changeset
  3254
     ObjectMemory bytesPerOOP 
claus
parents: 418
diff changeset
  3255
    "
claus
parents: 418
diff changeset
  3256
!
claus
parents: 418
diff changeset
  3257
claus
parents: 418
diff changeset
  3258
bytesPerOTE
claus
parents: 418
diff changeset
  3259
    "return the number of overhead bytes of an object.
claus
parents: 418
diff changeset
  3260
     i.e. the number of bytes in every objects header."
claus
parents: 418
diff changeset
  3261
claus
parents: 418
diff changeset
  3262
%{  /* NOCONTEXT */
claus
parents: 418
diff changeset
  3263
    RETURN(__MKSMALLINT(OHDR_SIZE));
claus
parents: 418
diff changeset
  3264
%}
claus
parents: 418
diff changeset
  3265
claus
parents: 418
diff changeset
  3266
    "
claus
parents: 418
diff changeset
  3267
     ObjectMemory bytesPerOTE 
claus
parents: 418
diff changeset
  3268
    "
claus
parents: 418
diff changeset
  3269
!
claus
parents: 418
diff changeset
  3270
362
claus
parents: 360
diff changeset
  3271
globalCompactingGC
claus
parents: 360
diff changeset
  3272
    self garbageCollect
claus
parents: 360
diff changeset
  3273
!
claus
parents: 360
diff changeset
  3274
claus
parents: 360
diff changeset
  3275
compactingGC
claus
parents: 360
diff changeset
  3276
    self garbageCollect
claus
parents: 360
diff changeset
  3277
! !