1
|
1 |
"
|
5
|
2 |
COPYRIGHT (c) 1992 by Claus Gittinger
|
159
|
3 |
All Rights Reserved
|
1
|
4 |
|
|
5 |
This software is furnished under a license and may be used
|
|
6 |
only in accordance with the terms of that license and with the
|
|
7 |
inclusion of the above copyright notice. This software may not
|
|
8 |
be provided or otherwise made available to, or used by, any
|
|
9 |
other person. No title to or ownership of the software is
|
|
10 |
hereby transferred.
|
|
11 |
"
|
|
12 |
|
|
13 |
Object subclass:#ObjectMemory
|
|
14 |
instanceVariableNames:''
|
2
|
15 |
classVariableNames:'InternalErrorHandler UserInterruptHandler TimerInterruptHandler
|
159
|
16 |
SpyInterruptHandler StepInterruptHandler ExceptionInterruptHandler
|
|
17 |
ErrorInterruptHandler MemoryInterruptHandler SignalInterruptHandler
|
|
18 |
ChildSignalInterruptHandler DisposeInterruptHandler
|
|
19 |
RecursionInterruptHandler IOInterruptHandler
|
|
20 |
CustomInterruptHandler
|
2
|
21 |
|
178
|
22 |
AllocationFailureSignal LowSpaceSemaphore
|
310
|
23 |
IncrementalGCLimit FreeSpaceGCLimit FreeSpaceGCAmount
|
290
|
24 |
BackgroundCollectProcess BackgroundFinalizationProcess
|
|
25 |
FinalizationSemaphore
|
159
|
26 |
Dependents
|
|
27 |
ImageName'
|
1
|
28 |
poolDictionaries:''
|
|
29 |
category:'System-Support'
|
|
30 |
!
|
|
31 |
|
|
32 |
ObjectMemory comment:'
|
5
|
33 |
COPYRIGHT (c) 1992 by Claus Gittinger
|
159
|
34 |
All Rights Reserved
|
93
|
35 |
|
310
|
36 |
$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.32 1995-03-18 15:07:44 claus Exp $
|
2
|
37 |
'!
|
|
38 |
|
|
39 |
!ObjectMemory class methodsFor:'documentation'!
|
|
40 |
|
88
|
41 |
copyright
|
|
42 |
"
|
|
43 |
COPYRIGHT (c) 1992 by Claus Gittinger
|
159
|
44 |
All Rights Reserved
|
88
|
45 |
|
|
46 |
This software is furnished under a license and may be used
|
|
47 |
only in accordance with the terms of that license and with the
|
|
48 |
inclusion of the above copyright notice. This software may not
|
|
49 |
be provided or otherwise made available to, or used by, any
|
|
50 |
other person. No title to or ownership of the software is
|
|
51 |
hereby transferred.
|
|
52 |
"
|
|
53 |
!
|
|
54 |
|
|
55 |
version
|
|
56 |
"
|
310
|
57 |
$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.32 1995-03-18 15:07:44 claus Exp $
|
88
|
58 |
"
|
|
59 |
!
|
|
60 |
|
2
|
61 |
documentation
|
|
62 |
"
|
68
|
63 |
This class contains access methods to the system memory -
|
|
64 |
in previous versions this stuff used to be in the Smalltalk class.
|
|
65 |
It has been separated for better overall structure.
|
229
|
66 |
There are no instances of ObjectMemory - all is done in class methods.
|
1
|
67 |
|
68
|
68 |
Many methods here are for debuging purposes only, and not standard.
|
|
69 |
Do not depend on them being there - some may vanish ...
|
|
70 |
(especially those, that depend on a specific GC implementation)
|
13
|
71 |
|
229
|
72 |
Warning:
|
|
73 |
The InterruptHandler variables are known by the runtime system -
|
|
74 |
they are the objects that get an interrupt message when the event
|
|
75 |
occurs. You may not remove them.
|
2
|
76 |
|
229
|
77 |
Class variables:
|
2
|
78 |
|
159
|
79 |
InternalErrorHandler gets informed (by VM), when some runtime
|
|
80 |
error occurs (usually fatal)
|
2
|
81 |
|
159
|
82 |
UserInterruptHandler gets informed (by VM) when CNTL-C is pressed
|
|
83 |
TimerInterruptHandler gets alarm timer interrupts (from VM)
|
|
84 |
SpyInterruptHandler another alarm timer (from VM)
|
|
85 |
StepInterruptHandler gets single step interrupts (from VM)
|
|
86 |
ExceptionInterruptHandler gets floating point exceptions (from VM)
|
|
87 |
ErrorInterruptHandler gets graphic device errors (from VM)
|
|
88 |
MemoryInterruptHandler gets soon-out-of-memory conditions (from VM)
|
|
89 |
SignalInterruptHandler gets unix signals (from VM)
|
|
90 |
ChildSignalInterruptHandler gets child death signals (from VM)
|
|
91 |
DisposeInterruptHandler gets informed, when an object is disposed from
|
|
92 |
a shadowArray (from VM)
|
|
93 |
RecursionInterruptHandler gets recursion limit violations (from VM)
|
|
94 |
IOInterruptHandler gets SIGIO unix signals (from VM)
|
|
95 |
CustomInterruptHandler gets custom interrupts (from VM)
|
2
|
96 |
|
270
|
97 |
IncrementalGCLimit number of bytes, that must be allocated since
|
290
|
98 |
last full garbage collect to turn the incremental
|
|
99 |
collector on (at idle time).
|
|
100 |
|
|
101 |
FreeSpaceGCLimit low limit on freeSpace at which incremental
|
|
102 |
gc starts to run at idle time.
|
270
|
103 |
|
310
|
104 |
FreeSpaceGCAmount amount to allocate once freeSpace drops
|
|
105 |
below FreeSpaceGCLimit
|
|
106 |
|
159
|
107 |
Dependents keep my dependents locally (its faster) for
|
|
108 |
all those registries
|
270
|
109 |
|
213
|
110 |
LowSpaceSemaphore a semaphore signalled whenever the system is
|
|
111 |
running in low memory (i.e. the memory manager
|
|
112 |
ran into memory shortage and feels that it
|
|
113 |
may soon be no longer grant allocation requests).
|
|
114 |
You can have a process waiting on this semaphore
|
|
115 |
which starts to remove (i.e. nil-out) objects
|
|
116 |
or preform other cleanup actions.
|
|
117 |
|
|
118 |
AllocationFailureSignal signal raised when a new fails (see Behavior)
|
|
119 |
When this signal is raised, the meomory manager
|
|
120 |
is really in trouble (i.e. above feelings where
|
|
121 |
correct)
|
290
|
122 |
|
|
123 |
BackgroundCollectProcess created by startBackgroundCollectorAt:
|
|
124 |
|
|
125 |
BackgroundFinalizationProcess created by startBackgroundFinalizationAt:
|
2
|
126 |
"
|
93
|
127 |
!
|
|
128 |
|
|
129 |
caching
|
|
130 |
"
|
|
131 |
The system uses various caches to speed up method-lookup.
|
|
132 |
Currently, there is a three-level cache hierarchy:
|
|
133 |
|
159
|
134 |
inline-cache keeps the target of the last send at the caller-
|
|
135 |
side (i.e. every send goes through its private
|
|
136 |
1-slot inline-cache, where the address of the last
|
|
137 |
called function at this call location is kept.)
|
93
|
138 |
|
229
|
139 |
polymorph-inline-cache keeps a limited list of all targets ever reached
|
|
140 |
at this call location. The list is automatically
|
|
141 |
flushed if it grows too large, or the overall number
|
|
142 |
of poly-chache entries exceeds a limit.
|
93
|
143 |
|
159
|
144 |
method-lookup-cache a global cache. Hashes on class-selector pairs,
|
|
145 |
returning the target method.
|
93
|
146 |
|
|
147 |
Whenever methods are added or removed from the system, or the inheritance
|
|
148 |
hierarchy changes, some or all caches have to be flushed.
|
202
|
149 |
The flushXXX methods perform the task of flushing various caches.
|
207
|
150 |
All standard methods in Behavior call for cache flushing, when things change;
|
229
|
151 |
however, if you use the low level access methods in Behavior
|
|
152 |
(for example: #setSuperclass:) special care has to be taken.
|
|
153 |
|
|
154 |
In some situations, not all caches need flushing, for example a change
|
|
155 |
in an interpreted method (currently) needs no flushing of the inline caches.
|
|
156 |
Also, flushing can be limited to entries for a specific class for most changes.
|
|
157 |
|
202
|
158 |
To be 'on the brigth side of live', use ObjectMemory>>flushCaches (which
|
|
159 |
flushes all of them), when in doubt of which caches should be flushed.
|
|
160 |
It is better flush too much - otherwise you may end up in a wrong method after
|
|
161 |
a send.
|
93
|
162 |
"
|
|
163 |
!
|
|
164 |
|
|
165 |
interrupts
|
|
166 |
"
|
|
167 |
Handling of interrupts (i.e. unix-signals) is done via handler objects, which
|
|
168 |
get a #XXXInterrupt-message sent. This is more flexible than (say) signalling
|
|
169 |
a semaphore, since the handler-object may do anything to react on the signal
|
|
170 |
(of course, it can also signal a semaphore to emulate the above behavior).
|
|
171 |
|
229
|
172 |
Another reason for having handler objects is that they allow interrupt handling
|
207
|
173 |
without any context switch, for high speed interrupt response.
|
|
174 |
However, special care is needed, since it is not defined, which process gets
|
|
175 |
the interrupt and will do the processing.
|
93
|
176 |
Typically, the handlers are set during early initialization of the system
|
202
|
177 |
by sending 'ObjectMemory XXXInterruptHandler:aHandler' and not changed later.
|
|
178 |
(see Smalltalk>>initialize or ProcessorScheduler>>initialize).
|
207
|
179 |
To setup your own handler, create some object which responds to #xxxInterrupt,
|
|
180 |
and make it the handler using the above method.
|
|
181 |
|
|
182 |
Interrupt messages sent to handlers are:
|
|
183 |
internalError:<someString> - internal interpreter/GC errors
|
|
184 |
userInterrupt - ^C interrupt
|
|
185 |
customInterrupt - custom interrupt
|
|
186 |
ioInterrupt - SIGIO interrupt
|
229
|
187 |
timerInterrupt - alarm timer (SIGALRM)
|
207
|
188 |
errorInterrupt - display error
|
229
|
189 |
spyInterrupt - spy timer interrupt (SIGVTALARM)
|
207
|
190 |
stepInterrupt - single step interrupt
|
|
191 |
disposeInterrupt - finalization required
|
|
192 |
recursionInterrupt - recursion (stack) overflow
|
|
193 |
memoryInterrupt - soon running out of memory
|
229
|
194 |
fpExceptionInterrupt - floating point exception (SIGFPE)
|
207
|
195 |
childSignalInterrupt - death of a child process (SIGCHILD)
|
|
196 |
signalInterrupt:<number> - unix signal (if other than above signals)
|
93
|
197 |
"
|
|
198 |
!
|
|
199 |
|
|
200 |
garbageCollection
|
|
201 |
"
|
|
202 |
Currently, Smalltalk/X uses a two-level memory hierachy.
|
|
203 |
Objects are created in a so-called newSpace, which is relatively small.
|
202
|
204 |
This newSpace is cleaned by a scavenge-operation, whenever becoming
|
133
|
205 |
full. Scavenging means, that all still-live objects (i.e. referenced by some
|
|
206 |
other) are copied over to another memory area, leaving all unreferenced
|
207
|
207 |
objects as garbage behind. After this copying, these two semispaces exchange their
|
202
|
208 |
roles - i.e. objects are copied ping-pong like between these semispaces.
|
|
209 |
Once an object survives enough of these copying operations, the next scavenge
|
216
|
210 |
will move it into the so called oldSpace, which is much larger, and not
|
202
|
211 |
processed by the scavenger.
|
|
212 |
This movement of an object from newSpace to oldSpace is called 'tenure'.
|
133
|
213 |
|
93
|
214 |
Scavenging occurs automatically, and is usually done fast enough to go
|
|
215 |
unnoticed (typically, it takes some 5 to 50ms to perform a scavenge,
|
|
216 |
depending on how many live objects are in the newspace).
|
|
217 |
Interrestingly, the scavenger performs better, if many garbage objects
|
|
218 |
are to be reclaimed, since less object-copying has to be done. Therefore,
|
216
|
219 |
the best-case scavenge time is almost zero, if there is only garbage in
|
|
220 |
the newSpace. In contrast, the worst-case is when all newSpace objects are still
|
207
|
221 |
living. To honor this situation, the system uses an adaptive tenure-count,
|
|
222 |
which adjusts the number of scavenges required for tenure (the so called
|
|
223 |
'tenureAge') according to the fill-grade of the newSpace.
|
93
|
224 |
|
|
225 |
To reclaim oldspace, the system uses three algorithms: mark&sweep, a copying
|
|
226 |
(and compressing) baker-type collector and an incremental mark&sweep.
|
|
227 |
|
|
228 |
The mark&sweep runs whenever the oldspace becomes full, putting dead objects
|
|
229 |
onto a free list. If a memory request cannot be served from this freelist,
|
|
230 |
and the total size of objects on the freelist exceeds a threshold, the system
|
|
231 |
will compress the oldspace to make the free-space into one big area.
|
207
|
232 |
This compress is done by copying all live objects into a newly allocated
|
|
233 |
area, and freeing the previous memory afterwards (baker collector).
|
93
|
234 |
Since a compressing oldspace collect leads to a noticable pause of the system,
|
|
235 |
the memory manager tries hard to avoid oldspace compression.
|
207
|
236 |
(actually, if enough real memory is available to hold both spaces in physical
|
|
237 |
memory, the compress is pretty fast).
|
202
|
238 |
|
93
|
239 |
The incremental mark&sweep runs in the background, whenever the system is idle
|
|
240 |
(see ProcessorSceduler>>waitForEventOrTimeout). Like the normal mark&sweep,
|
|
241 |
this incremental collector follows object references and marks reachable objects
|
|
242 |
on its way. This is done 'a few objects-at-a-time', to not disrupt the system
|
270
|
243 |
noticable.
|
310
|
244 |
Incremental collection is controlled by the variables
|
|
245 |
'IncrementalGCLimit' and 'FreeSpaceGCLimit'/'FreeSpaceGCAmount':
|
|
246 |
|
290
|
247 |
the ProcessorScheduler will perform incremental GC steps at idle time,
|
|
248 |
if the total space allocated since the last full collect exceeds
|
|
249 |
IncrementalGCLimit,
|
|
250 |
or if there are less than 'FreeSpaceGCLimit' bytes available in free store.
|
310
|
251 |
If after the incrementalGC, less than FreeSpaceGCLimit bytes are available,
|
|
252 |
'FreeSpaceGCAmount' more bytes are requested from the memory manager.
|
290
|
253 |
|
|
254 |
The defaults are set in ObjectMemory>>initialize and can be changed in your
|
|
255 |
startup 'smalltalk.rc'-file. Setting them to nil will turn incremental GC off.
|
270
|
256 |
|
|
257 |
For example, setting IncrementalGCLimit to 500000 will start the background collector
|
207
|
258 |
whenever 500k bytes have been allocated - usually very seldom. Setting it to some
|
|
259 |
small number (say 10000) will have it run very often.
|
290
|
260 |
|
310
|
261 |
Setting FreeSpaceGCAmount to (say) 1mio lets the system try to always keep
|
290
|
262 |
1meg of freeSpace. If less memory is available, more oldSPace will be allocated
|
|
263 |
for. This may prevent the system from running into a GC pause when memory is
|
|
264 |
allocated in peaks (but only, if the incremental GC can keep up with allocation
|
310
|
265 |
rate). The trigger level FreeSpaceGCLimit should be below the amount;
|
|
266 |
to avoid excessive incremental GC activity (say 1/4 if the amount).
|
290
|
267 |
|
|
268 |
Having the background GC running often should not hurt the performance of your
|
|
269 |
smalltalk processes, since the IGC only runs at idle times.
|
|
270 |
(there are some short delays in event processing, since the IGC's steps may take
|
|
271 |
some XX ms.)
|
270
|
272 |
However, if you are not alone on your machine (i.e. a timesharing system) or
|
|
273 |
you have other Unix processes to run, you should not run the IGC too often,
|
290
|
274 |
since it may hurt other users/unix processes.
|
93
|
275 |
|
216
|
276 |
Since this collector only runs at idle times, even a low priority background
|
|
277 |
process will prevent it from doing its work. You may want to start a somewhat
|
207
|
278 |
higher priority background collect (say at prio 4), which also preempts these
|
|
279 |
background processes. (see ObjectMemory>>startBackgroundCollectorAt:).
|
202
|
280 |
|
216
|
281 |
Beginning with 2.10.4, a third space, called fixSpace has been added.
|
|
282 |
Objects in this space are never moved or garbage collected.
|
|
283 |
This space is currently used for (some) symbols only, but additional constant
|
229
|
284 |
objects may be put into it in the future (true, false, some basic classes etc.).
|
|
285 |
|
|
286 |
A plan for 2.11 is to offer an arbitrary number of spaces, which can be
|
|
287 |
attached and detached at runtime. This will allow easy share of object
|
|
288 |
with remote systems and separating objects into a per application/package
|
|
289 |
space. (be prepared for changes in the future and make your application
|
|
290 |
independ of the VM internals)
|
216
|
291 |
|
202
|
292 |
hints & tricks:
|
|
293 |
|
213
|
294 |
normally, there is no need to call for an explicit garbage collection, or
|
216
|
295 |
modify the default parameters.
|
213
|
296 |
The memory system should adapt reasonable and provide good performance
|
202
|
297 |
for a wide range of allocation patterns (see Example3 below for an exception).
|
|
298 |
|
207
|
299 |
However, there may be situations, in which hints and/or explicit
|
202
|
300 |
control over allocation can speedup your programs; but please:
|
93
|
301 |
|
207
|
302 |
- if you think you have to play around with the memory policies,
|
202
|
303 |
first check your program - you may find useless allocations
|
|
304 |
or bad uses of collections. A typical error that is made is to
|
|
305 |
create large collections using the #, (comma) concatenation method,
|
|
306 |
which shows square behavior, since it allocates many, many temporary
|
213
|
307 |
collections. Also, watch out for #copyWith:, #add: etc.
|
202
|
308 |
All of these create a new collection. Remember, that most collections
|
|
309 |
offer methods to preallocate some space; for example, 'Set new:' creates
|
229
|
310 |
an empty set, but preallocates space to avoid resizing over and over.
|
|
311 |
|
216
|
312 |
An especially bad performace dog is to use #add: on fix-size collection
|
|
313 |
objects (such as Strings or Arrays), since in addition to allocating
|
229
|
314 |
lots of garbage, a #become: operation is required for EACH element
|
216
|
315 |
added. NEVER use Arrays for growing/shrinking data - use OrderedCollection
|
229
|
316 |
instead. (if you really need an array, use asArray afterwards)
|
202
|
317 |
|
207
|
318 |
- if you are going to allocate huge data structures, think about
|
|
319 |
optimizing space. For example, if you allocate a million instances of
|
213
|
320 |
some object, each added instance variable makes up 4Mb of additional
|
|
321 |
memory need.
|
207
|
322 |
Also, for Byte-valued, Integer-valued and Float like objects, special
|
|
323 |
collections are provided, which store their values directly inside (instead
|
|
324 |
of a reference to the object). A FloatArray consisting of 1 million floats
|
213
|
325 |
requires about 4mb of memory, while an Array of Floats requires 4mb for the
|
|
326 |
references to the floats, PLUS 20Mb for the floats themself.
|
93
|
327 |
|
207
|
328 |
- check if you really need fast access to all of these objects; you may
|
|
329 |
try to only keep some subset in memory, and use binary storage or
|
|
330 |
(if this is too slow) optimized store/retrieve methods and keep the bigger
|
229
|
331 |
part in a file.
|
|
332 |
(How about a DiskArray class, which does this transparent ?
|
|
333 |
See the FileText class for some ideas and something to start with ...)
|
207
|
334 |
|
|
335 |
|
|
336 |
Hint / Example 1:
|
93
|
337 |
you are about to allocate a huge data structure, which is known to
|
|
338 |
survive long. In this case, it is better to have these objects move into the
|
|
339 |
oldspace sooner, to avoid the copying overhead during scavenges.
|
|
340 |
|
|
341 |
To do this, you can call ObjectMemory>>tenure after allocation, which
|
|
342 |
forces all new-objects immediately into the oldspace.
|
|
343 |
Make certain, that not to many (ideally no) short-living objects are in the
|
|
344 |
newspace when doing this.
|
|
345 |
|
|
346 |
Another alternative is to tell the system that all allocation should be
|
|
347 |
done directly in the oldspace. This completely avoids the scavenging overhead
|
|
348 |
for these objects. To do so, use ObjectMemory>>turnGarbageCollectorOff
|
|
349 |
before the allocation, and ObjectMemory>>turnGarbageCollectorOn afterwards.
|
202
|
350 |
Keep in mind, that do-loops may allocate block-objects and other temporaries,
|
178
|
351 |
so there is a danger of making things worse due to having all those temporaries
|
93
|
352 |
in the oldspace afterwards. (which is not a fatal situation, but will
|
178
|
353 |
force the system to do an oldspace collect earlier, which may not be your
|
|
354 |
intention).
|
93
|
355 |
|
202
|
356 |
|
207
|
357 |
Hint / Example 2:
|
93
|
358 |
you know in advance, that a certain (big) amount of memory will be needed.
|
|
359 |
For example, the fileBrowser wants to show a huge file in its text-view.
|
133
|
360 |
In this case, it is better to tell the memory system in advance, how much
|
93
|
361 |
memory will be needed, since otherwise many compresses and reallocations will
|
133
|
362 |
occur (the memory system will allocate additional memory in chunks of smaller
|
|
363 |
256k pieces, if a compress failes. Thus, if you are going to allocate (say) 1Mb of
|
|
364 |
strings, it will perform 5 compressing GC's).
|
|
365 |
|
202
|
366 |
This is done using ObjectMemory>>moreOldSpace: or ObjectMemory announceSpaceNeed:.
|
|
367 |
In the above example, you would do 'ObjectMemory announceSpaceNeed:500000', which
|
133
|
368 |
avoids those annoying 5 compressing GC's.
|
207
|
369 |
BTW: if you have other smalltalk processes (threads) running which should not be
|
|
370 |
paused if possible, it is better to use #announceSpaceNeed. This tries to avoid
|
|
371 |
pausing in other processes and sometimes succeeds, while moreOldSpace will always
|
|
372 |
block the whole system for a while. However, there is no 'no-pause' guarantee.
|
133
|
373 |
|
|
374 |
The amount of automatic increase (in case the oldSpace becomes full) is 256k by
|
|
375 |
default. This number can be changed with ObjectMemory>>oldSpaceIncrement:.
|
|
376 |
|
207
|
377 |
|
|
378 |
Hint / Example3:
|
178
|
379 |
There are rare cases, when an explicit GC makes a difference: since
|
|
380 |
object finalization is done at GC time, objects which keep operatingSystem
|
|
381 |
resources may be finalized late. This is normally no problem, except if
|
|
382 |
the system is running out of resources. For example, allocating new colors
|
|
383 |
may fail if many colors have already been allocated in the past - even
|
|
384 |
though these colors are actually free. The Depth8Image calls for an
|
|
385 |
explicit GC, whenever it fails to allocate a color for a bitmap, to force
|
|
386 |
finalization of free, but not yet finalized colors.
|
|
387 |
|
207
|
388 |
|
|
389 |
Hint 4:
|
|
390 |
If you run in too small of physical memory, the incremental GC may have a
|
|
391 |
bad effect on your working set: since it touches pages (which may otherwise
|
|
392 |
not be needed at the moment, the operating system is forced to steal other
|
|
393 |
(possibly more useful) pages from your set of incore pages.
|
|
394 |
You may get better performance, if you turn off the incremental GC while
|
|
395 |
processing a big data structure.
|
|
396 |
|
|
397 |
|
229
|
398 |
Warning: many of the methods found here are not standard and may not even be available in
|
133
|
399 |
future versions of ST/X. Use them only in very special situations or experiments.
|
229
|
400 |
|
207
|
401 |
Let me know about additional special features you think are useful, and about
|
|
402 |
special features you are using - this provides the feedback required to decide
|
|
403 |
which methods are to be removed or kept or enhanced in future versions.
|
93
|
404 |
"
|
2
|
405 |
! !
|
|
406 |
|
|
407 |
!ObjectMemory class methodsFor:'initialization'!
|
|
408 |
|
|
409 |
initialize
|
178
|
410 |
"initialize the class"
|
|
411 |
|
2
|
412 |
AllocationFailureSignal isNil ifTrue:[
|
302
|
413 |
ErrorSignal isNil ifTrue:[super initialize].
|
159
|
414 |
|
302
|
415 |
AllocationFailureSignal := ErrorSignal newSignalMayProceed:true.
|
159
|
416 |
AllocationFailureSignal nameClass:self message:#allocationFailureSignal.
|
|
417 |
AllocationFailureSignal notifierString:'allocation failure'.
|
178
|
418 |
|
|
419 |
LowSpaceSemaphore := Semaphore new.
|
2
|
420 |
].
|
290
|
421 |
DisposeInterruptHandler := self.
|
2
|
422 |
IncrementalGCLimit := 500000.
|
310
|
423 |
FreeSpaceGCLimit := FreeSpaceGCAmount := nil.
|
13
|
424 |
MemoryInterruptHandler := self
|
2
|
425 |
! !
|
|
426 |
|
|
427 |
!ObjectMemory class methodsFor:'signal access'!
|
|
428 |
|
|
429 |
allocationFailureSignal
|
13
|
430 |
"return the signal raised when an object allocation failed"
|
|
431 |
|
2
|
432 |
^ AllocationFailureSignal
|
|
433 |
! !
|
1
|
434 |
|
178
|
435 |
!ObjectMemory class methodsFor:'semaphore access'!
|
|
436 |
|
|
437 |
lowSpaceSemaphore
|
|
438 |
"return the semaphore that is signalled when the system detects a
|
|
439 |
low space condition. Usually, some time after this, an allocationFailure
|
|
440 |
will happen. You can have a cleanup process sitting in that semaphore and
|
|
441 |
start to release object."
|
|
442 |
|
|
443 |
^ LowSpaceSemaphore
|
|
444 |
! !
|
|
445 |
|
10
|
446 |
!ObjectMemory class methodsFor:'dependents access'!
|
|
447 |
|
|
448 |
dependents
|
|
449 |
"return the colleciton of my dependents"
|
|
450 |
|
|
451 |
^ Dependents
|
|
452 |
!
|
|
453 |
|
|
454 |
dependents:aCollection
|
|
455 |
"set the dependents collection"
|
|
456 |
|
|
457 |
Dependents := aCollection
|
282
|
458 |
!
|
|
459 |
|
|
460 |
dependentsDo:aBlock
|
|
461 |
"evaluate aBlock for all of my dependents.
|
|
462 |
Since this is performed at startup time (under the scheduler),
|
|
463 |
this is redefined here to catch abort signals.
|
|
464 |
Thus, if any error occurs in a #returnFromSnapshot,
|
|
465 |
the user can press abort to continue."
|
|
466 |
|
|
467 |
|deps|
|
|
468 |
|
|
469 |
deps := Dependents.
|
|
470 |
deps notNil ifTrue:[
|
|
471 |
deps do:[:each |
|
|
472 |
AbortSignal handle:[:ex |
|
|
473 |
ex return
|
|
474 |
] do:[
|
|
475 |
aBlock value:each
|
|
476 |
]
|
|
477 |
]
|
|
478 |
]
|
10
|
479 |
! !
|
|
480 |
|
1
|
481 |
!ObjectMemory class methodsFor:'cache management'!
|
|
482 |
|
|
483 |
flushInlineCachesForClass:aClass
|
93
|
484 |
"flush inlinecaches for calls to aClass."
|
1
|
485 |
|
|
486 |
%{ /* NOCONTEXT */
|
|
487 |
__flushInlineCachesFor(aClass);
|
|
488 |
%}
|
|
489 |
!
|
|
490 |
|
|
491 |
flushInlineCachesWithArgs:nargs
|
|
492 |
"flush inlinecaches for calls with nargs arguments"
|
|
493 |
|
|
494 |
%{ /* NOCONTEXT */
|
|
495 |
__flushInlineCaches(_intVal(nargs));
|
|
496 |
%}
|
|
497 |
!
|
|
498 |
|
|
499 |
flushInlineCachesFor:aClass withArgs:nargs
|
|
500 |
"flush inlinecaches for calls to aClass with nargs arguments"
|
|
501 |
|
|
502 |
%{ /* NOCONTEXT */
|
|
503 |
__flushInlineCachesForAndNargs(aClass, _intVal(nargs));
|
|
504 |
%}
|
|
505 |
!
|
|
506 |
|
|
507 |
flushInlineCaches
|
|
508 |
"flush all inlinecaches"
|
|
509 |
|
|
510 |
%{ /* NOCONTEXT */
|
|
511 |
__flushAllInlineCaches();
|
|
512 |
%}
|
|
513 |
!
|
|
514 |
|
|
515 |
flushMethodCacheFor:aClass
|
|
516 |
"flush the method cache for sends to aClass"
|
|
517 |
|
|
518 |
%{ /* NOCONTEXT */
|
|
519 |
__flushMethodCacheFor(aClass);
|
|
520 |
%}
|
|
521 |
!
|
|
522 |
|
|
523 |
flushMethodCache
|
|
524 |
"flush the method cache"
|
|
525 |
|
|
526 |
%{ /* NOCONTEXT */
|
|
527 |
__flushMethodCache();
|
|
528 |
%}
|
|
529 |
!
|
|
530 |
|
2
|
531 |
flushCachesFor:aClass
|
|
532 |
"flush method and inline caches for aClass"
|
|
533 |
|
|
534 |
%{ /* NOCONTEXT */
|
|
535 |
__flushMethodCacheFor(aClass);
|
|
536 |
__flushInlineCachesFor(aClass);
|
|
537 |
%}
|
|
538 |
!
|
|
539 |
|
1
|
540 |
flushCaches
|
2
|
541 |
"flush method and inline caches for all classes"
|
1
|
542 |
|
|
543 |
%{ /* NOCONTEXT */
|
|
544 |
__flushMethodCache();
|
|
545 |
__flushAllInlineCaches();
|
|
546 |
%}
|
|
547 |
! !
|
|
548 |
|
216
|
549 |
!ObjectMemory class methodsFor:'enumerating'!
|
1
|
550 |
|
|
551 |
allObjectsDo:aBlock
|
85
|
552 |
"evaluate the argument, aBlock for all objects in the system.
|
|
553 |
There is one caveat: if a compressing oldSpace collect
|
|
554 |
occurs while looping over the objects, the loop cannot be
|
|
555 |
continued (for some internal reasons). In this case, false
|
|
556 |
is returned."
|
2
|
557 |
|
|
558 |
|work|
|
22
|
559 |
|
|
560 |
%{ /* NOREGISTER - work may not be placed into a register here */
|
2
|
561 |
nonTenuringScavenge(__context);
|
|
562 |
/*
|
|
563 |
* allObjectsDo needs a temporary to hold newSpace objects
|
|
564 |
*/
|
85
|
565 |
if (__allObjectsDo(&aBlock, &work COMMA_CON) < 0) {
|
159
|
566 |
RETURN (false);
|
85
|
567 |
}
|
|
568 |
%}.
|
|
569 |
^ true
|
2
|
570 |
!
|
|
571 |
|
|
572 |
allOldObjectsDo:aBlock
|
|
573 |
"evaluate the argument, aBlock for all old objects in the system.
|
|
574 |
For debugging and tests only - do not use"
|
|
575 |
%{
|
85
|
576 |
if (__allObjectsDo(&aBlock, (OBJ *)0 COMMA_CON) < 0) {
|
159
|
577 |
RETURN (false);
|
85
|
578 |
}
|
|
579 |
%}.
|
|
580 |
^ true
|
1
|
581 |
! !
|
|
582 |
|
229
|
583 |
!ObjectMemory class methodsFor:'interrupt handler access'!
|
2
|
584 |
|
|
585 |
internalErrorHandler
|
13
|
586 |
"return the handler for ST/X internal errors.
|
|
587 |
An internal error is reported for example when a methods
|
|
588 |
bytecode is not a ByteArray, the selector table is not an Array
|
93
|
589 |
etc.
|
|
590 |
Those should not occur in normal circumstances."
|
13
|
591 |
|
2
|
592 |
^ InternalErrorHandler
|
|
593 |
!
|
|
594 |
|
|
595 |
userInterruptHandler
|
13
|
596 |
"return the handler for CNTL-C interrupt handling"
|
|
597 |
|
2
|
598 |
^ UserInterruptHandler
|
|
599 |
!
|
|
600 |
|
|
601 |
userInterruptHandler:aHandler
|
13
|
602 |
"set the handler for CNTL-C interrupt handling"
|
|
603 |
|
2
|
604 |
UserInterruptHandler := aHandler
|
|
605 |
!
|
|
606 |
|
|
607 |
timerInterruptHandler
|
13
|
608 |
"return the handler for timer interrupts"
|
|
609 |
|
2
|
610 |
^ TimerInterruptHandler
|
|
611 |
!
|
|
612 |
|
10
|
613 |
timerInterruptHandler:aHandler
|
13
|
614 |
"set the handler for timer interrupts"
|
|
615 |
|
10
|
616 |
TimerInterruptHandler := aHandler
|
|
617 |
!
|
|
618 |
|
2
|
619 |
spyInterruptHandler
|
13
|
620 |
"return the handler for spy-timer interrupts"
|
|
621 |
|
2
|
622 |
^ SpyInterruptHandler
|
|
623 |
!
|
|
624 |
|
|
625 |
spyInterruptHandler:aHandler
|
13
|
626 |
"set the handler for spy-timer interrupts"
|
|
627 |
|
2
|
628 |
SpyInterruptHandler := aHandler
|
|
629 |
!
|
|
630 |
|
|
631 |
stepInterruptHandler
|
13
|
632 |
"return the handler for single step interrupts"
|
|
633 |
|
2
|
634 |
^ StepInterruptHandler
|
|
635 |
!
|
|
636 |
|
|
637 |
stepInterruptHandler:aHandler
|
13
|
638 |
"set the handler for single step interrupts"
|
|
639 |
|
2
|
640 |
StepInterruptHandler := aHandler
|
|
641 |
!
|
|
642 |
|
|
643 |
exceptionInterruptHandler
|
13
|
644 |
"return the handler for floating point exception interrupts"
|
|
645 |
|
2
|
646 |
^ ExceptionInterruptHandler
|
|
647 |
!
|
|
648 |
|
|
649 |
errorInterruptHandler
|
13
|
650 |
"return the handler for display error interrupts"
|
|
651 |
|
2
|
652 |
^ ErrorInterruptHandler
|
|
653 |
!
|
|
654 |
|
|
655 |
errorInterruptHandler:aHandler
|
13
|
656 |
"set the handler for display error interrupts"
|
|
657 |
|
2
|
658 |
ErrorInterruptHandler := aHandler
|
|
659 |
!
|
|
660 |
|
13
|
661 |
signalInterruptHandler
|
|
662 |
"return the handler for UNIX-signal interrupts"
|
2
|
663 |
|
|
664 |
^ SignalInterruptHandler
|
|
665 |
!
|
|
666 |
|
13
|
667 |
signalInterruptHandler:aHandler
|
|
668 |
"set the handler for UNIX-signal interrupts"
|
|
669 |
|
|
670 |
SignalInterruptHandler := aHandler
|
|
671 |
!
|
|
672 |
|
2
|
673 |
childSignalInterruptHandler
|
13
|
674 |
"return the handler for UNIX-death-of-a-childprocess-signal interrupts"
|
|
675 |
|
2
|
676 |
^ ChildSignalInterruptHandler
|
|
677 |
!
|
|
678 |
|
|
679 |
disposeInterruptHandler
|
13
|
680 |
"return the handler for object disposal interrupts"
|
|
681 |
|
2
|
682 |
^ DisposeInterruptHandler
|
|
683 |
!
|
|
684 |
|
|
685 |
disposeInterruptHandler:aHandler
|
13
|
686 |
"set the handler for object disposal interrupts"
|
|
687 |
|
2
|
688 |
DisposeInterruptHandler := aHandler
|
|
689 |
!
|
|
690 |
|
|
691 |
recursionInterruptHandler
|
13
|
692 |
"return the handler for recursion/stack overflow interrupts"
|
|
693 |
|
2
|
694 |
^ RecursionInterruptHandler
|
|
695 |
!
|
|
696 |
|
13
|
697 |
recursionInterruptHandler:aHandler
|
|
698 |
"set the handler for recursion/stack overflow interrupts"
|
|
699 |
|
|
700 |
RecursionInterruptHandler := aHandler
|
|
701 |
!
|
|
702 |
|
2
|
703 |
ioInterruptHandler
|
13
|
704 |
"return the handler for I/O available signal interrupts (SIGIO/SIGPOLL)"
|
|
705 |
|
2
|
706 |
^ IOInterruptHandler
|
|
707 |
!
|
|
708 |
|
|
709 |
ioInterruptHandler:aHandler
|
13
|
710 |
"set the handler for I/O available signal interrupts (SIGIO/SIGPOLL)"
|
|
711 |
|
2
|
712 |
IOInterruptHandler := aHandler
|
85
|
713 |
!
|
|
714 |
|
|
715 |
customInterruptHandler
|
|
716 |
"return the handler for custom interrupts"
|
|
717 |
|
|
718 |
^ CustomInterruptHandler
|
|
719 |
!
|
|
720 |
|
|
721 |
customInterruptHandler:aHandler
|
|
722 |
"set the handler for custom interrupts"
|
|
723 |
|
|
724 |
CustomInterruptHandler := aHandler
|
2
|
725 |
! !
|
|
726 |
|
1
|
727 |
!ObjectMemory class methodsFor:'queries'!
|
|
728 |
|
13
|
729 |
newSpaceSize
|
|
730 |
"return the total size of the new space - this is usually fix"
|
|
731 |
|
|
732 |
%{ /* NOCONTEXT */
|
133
|
733 |
extern unsigned __newSpaceSize();
|
|
734 |
|
13
|
735 |
RETURN ( _MKSMALLINT(__newSpaceSize()) );
|
|
736 |
%}
|
93
|
737 |
"
|
|
738 |
ObjectMemory newSpaceSize
|
|
739 |
"
|
13
|
740 |
!
|
|
741 |
|
|
742 |
oldSpaceSize
|
|
743 |
"return the total size of the old space. - may grow slowly"
|
|
744 |
|
|
745 |
%{ /* NOCONTEXT */
|
133
|
746 |
extern unsigned __oldSpaceSize();
|
|
747 |
|
13
|
748 |
RETURN ( _MKSMALLINT(__oldSpaceSize()) );
|
|
749 |
%}
|
93
|
750 |
"
|
|
751 |
ObjectMemory oldSpaceSize
|
|
752 |
"
|
13
|
753 |
!
|
|
754 |
|
216
|
755 |
fixSpaceSize
|
|
756 |
"return the total size of the fix space."
|
|
757 |
|
|
758 |
%{ /* NOCONTEXT */
|
|
759 |
extern unsigned __fixSpaceSize();
|
|
760 |
|
|
761 |
RETURN ( _MKSMALLINT(__fixSpaceSize()) );
|
|
762 |
%}
|
|
763 |
"
|
|
764 |
ObjectMemory fixSpaceSize
|
|
765 |
"
|
|
766 |
!
|
|
767 |
|
1
|
768 |
newSpaceUsed
|
10
|
769 |
"return the number of bytes allocated for new objects.
|
|
770 |
The returned value is usually obsolete as soon as you do
|
13
|
771 |
something with it ..."
|
1
|
772 |
|
|
773 |
%{ /* NOCONTEXT */
|
133
|
774 |
extern unsigned __newSpaceUsed();
|
|
775 |
|
1
|
776 |
RETURN ( _MKSMALLINT(__newSpaceUsed()) );
|
|
777 |
%}
|
93
|
778 |
"
|
202
|
779 |
ObjectMemory newSpaceUsed
|
93
|
780 |
"
|
1
|
781 |
!
|
|
782 |
|
|
783 |
oldSpaceUsed
|
10
|
784 |
"return the number of bytes allocated for old objects.
|
|
785 |
(This includes the free lists)"
|
1
|
786 |
|
|
787 |
%{ /* NOCONTEXT */
|
133
|
788 |
extern unsigned __oldSpaceUsed();
|
|
789 |
|
1
|
790 |
RETURN ( _MKSMALLINT(__oldSpaceUsed()) );
|
|
791 |
%}
|
93
|
792 |
"
|
202
|
793 |
ObjectMemory oldSpaceUsed
|
93
|
794 |
"
|
1
|
795 |
!
|
|
796 |
|
216
|
797 |
fixSpaceUsed
|
|
798 |
"return the number of bytes allocated for old objects in fix space."
|
|
799 |
|
|
800 |
%{ /* NOCONTEXT */
|
|
801 |
extern unsigned __fixSpaceUsed();
|
|
802 |
|
|
803 |
RETURN ( _MKSMALLINT(__fixSpaceUsed()) );
|
|
804 |
%}
|
|
805 |
"
|
|
806 |
ObjectMemory fixSpaceUsed
|
|
807 |
"
|
|
808 |
!
|
|
809 |
|
270
|
810 |
freeSpace
|
|
811 |
"return the number of bytes in the compact free area.
|
|
812 |
(oldSpaceUsed + freeSpaceSize = oldSpaceSize)"
|
|
813 |
|
|
814 |
%{ /* NOCONTEXT */
|
|
815 |
extern unsigned __oldSpaceSize(), __oldSpaceUsed();
|
|
816 |
|
|
817 |
RETURN ( _MKSMALLINT(__oldSpaceSize() - __oldSpaceUsed()) );
|
|
818 |
%}
|
|
819 |
"
|
|
820 |
ObjectMemory freeSpace
|
|
821 |
"
|
|
822 |
!
|
|
823 |
|
133
|
824 |
freeListSpace
|
10
|
825 |
"return the number of bytes in the free lists.
|
|
826 |
(which is included in oldSpaceUsed)"
|
|
827 |
|
|
828 |
%{ /* NOCONTEXT */
|
133
|
829 |
extern unsigned __freeListSpace();
|
|
830 |
|
|
831 |
RETURN ( _MKSMALLINT(__freeListSpace()) );
|
10
|
832 |
%}
|
93
|
833 |
"
|
133
|
834 |
ObjectMemory freeListSpace
|
93
|
835 |
"
|
10
|
836 |
!
|
|
837 |
|
1
|
838 |
bytesUsed
|
|
839 |
"return the number of bytes allocated for objects -
|
178
|
840 |
this number is not exact, since some objects may already be dead
|
|
841 |
(i.e. not yet reclaimed by the garbage collector).
|
|
842 |
If you need the exact number, you have to loop over all
|
|
843 |
objects and ask for the bytesize using ObjectMemory>>sizeOf:."
|
1
|
844 |
|
|
845 |
%{ /* NOCONTEXT */
|
133
|
846 |
extern unsigned __oldSpaceUsed(), __newSpaceUsed(), __freeListSpace();
|
|
847 |
|
|
848 |
RETURN ( _MKSMALLINT(__oldSpaceUsed() + __newSpaceUsed() - __freeListSpace()) );
|
1
|
849 |
%}
|
93
|
850 |
"
|
202
|
851 |
ObjectMemory bytesUsed
|
93
|
852 |
"
|
1
|
853 |
!
|
|
854 |
|
2
|
855 |
oldSpaceAllocatedSinceLastGC
|
|
856 |
"return the number of bytes allocated for old objects since the
|
178
|
857 |
last oldspace garbage collect occured. This information is used
|
|
858 |
by ProcessorScheduler to decide when to start the incremental
|
|
859 |
background GC."
|
2
|
860 |
|
|
861 |
%{ /* NOCONTEXT */
|
133
|
862 |
extern unsigned __oldSpaceAllocatedSinceLastGC();
|
|
863 |
|
2
|
864 |
RETURN ( _MKSMALLINT(__oldSpaceAllocatedSinceLastGC()) );
|
|
865 |
%}
|
93
|
866 |
"
|
202
|
867 |
ObjectMemory oldSpaceAllocatedSinceLastGC
|
93
|
868 |
"
|
2
|
869 |
!
|
|
870 |
|
178
|
871 |
tenureAge
|
|
872 |
"return the current tenure age - thats the number of times
|
|
873 |
an object has to survive scavenges to be moved into oldSpace.
|
202
|
874 |
For statistic/debugging only - this method may vanish"
|
178
|
875 |
|
|
876 |
%{ /* NOCONTEXT */
|
|
877 |
extern unsigned __tenureAge();
|
|
878 |
|
|
879 |
RETURN ( _MKSMALLINT(__tenureAge()) );
|
|
880 |
%}
|
|
881 |
!
|
|
882 |
|
194
|
883 |
lastScavangeReclamation
|
|
884 |
"returns the number of bytes replacimed by the last scavenge.
|
|
885 |
For statistic only - this may vanish."
|
|
886 |
|
|
887 |
%{ /* NOCONTEXT */
|
|
888 |
extern int __newSpaceReclaimed();
|
|
889 |
|
|
890 |
RETURN ( _MKSMALLINT(__newSpaceReclaimed()) );
|
|
891 |
%}
|
202
|
892 |
"percentage of reclaimed objects is returned by:
|
|
893 |
|
194
|
894 |
((ObjectMemory lastScavangeReclamation)
|
202
|
895 |
/ (ObjectMemory newSpaceSize)) * 100.0
|
194
|
896 |
"
|
|
897 |
!
|
|
898 |
|
178
|
899 |
runsSingleOldSpace
|
|
900 |
"return true, if the system runs in a single oldSpace or
|
|
901 |
false, if it has given up baker-collection. The memory
|
|
902 |
system will always drop the second semispace when running out of
|
|
903 |
virtual memory, or the baker-limit is reached.
|
202
|
904 |
OBSOLETE:
|
|
905 |
the system may now decide at any time to switch between
|
|
906 |
single and double-space algorithms, depending on the overall memory
|
|
907 |
size. You will now almost always get false as result, since the
|
|
908 |
second semispaces are only allocated when needed, and released
|
|
909 |
afterwards.
|
|
910 |
"
|
178
|
911 |
|
|
912 |
%{ /* NOCONTEXT */
|
|
913 |
extern char *collectedOldStartPtr;
|
|
914 |
|
|
915 |
RETURN ( ((collectedOldStartPtr == (char *)0) ? true : false) );
|
|
916 |
%}
|
202
|
917 |
"
|
|
918 |
ObjectMemory runsSingleOldSpace
|
|
919 |
"
|
178
|
920 |
!
|
|
921 |
|
|
922 |
incrementalGCPhase
|
|
923 |
"returns the internal state of the incremental GC.
|
|
924 |
The meaning of those numbers is a secret :-).
|
|
925 |
This is for debugging and monitoring only - and may vanish"
|
|
926 |
|
|
927 |
%{ /* NOCONTEXT */
|
|
928 |
extern int __incrGCphase();
|
|
929 |
|
|
930 |
RETURN (_MKSMALLINT(__incrGCphase()));
|
|
931 |
%}
|
|
932 |
!
|
|
933 |
|
270
|
934 |
scavengeCount
|
|
935 |
"return the number of scavenges that occurred since startup"
|
|
936 |
|
|
937 |
%{ /* NOCONTEXT */
|
|
938 |
extern int __scavengeCount();
|
|
939 |
|
|
940 |
RETURN (_MKSMALLINT(__scavengeCount()));
|
|
941 |
%}
|
|
942 |
"
|
|
943 |
ObjectMemory scavengeCount
|
|
944 |
"
|
|
945 |
!
|
|
946 |
|
|
947 |
markAndSweepCount
|
|
948 |
"return the number of mark&sweep collects that occurred since startup"
|
|
949 |
|
|
950 |
%{ /* NOCONTEXT */
|
|
951 |
extern int __markAndSweepCount();
|
|
952 |
|
|
953 |
RETURN (_MKSMALLINT(__markAndSweepCount()));
|
|
954 |
%}
|
|
955 |
"
|
|
956 |
ObjectMemory markAndSweepCount
|
|
957 |
"
|
|
958 |
!
|
|
959 |
|
|
960 |
garbageCollectCount
|
|
961 |
"return the number of compressing collects that occurred since startup"
|
|
962 |
|
|
963 |
%{ /* NOCONTEXT */
|
|
964 |
extern int __garbageCollectCount();
|
|
965 |
|
|
966 |
RETURN (_MKSMALLINT(__garbageCollectCount()));
|
|
967 |
%}
|
|
968 |
"
|
|
969 |
ObjectMemory garbageCollectCount
|
|
970 |
"
|
|
971 |
!
|
|
972 |
|
1
|
973 |
numberOfObjects
|
13
|
974 |
"return the number of objects in the system."
|
1
|
975 |
|
|
976 |
|tally|
|
|
977 |
|
|
978 |
tally := 0.
|
|
979 |
self allObjectsDo:[:obj | tally := tally + 1].
|
|
980 |
^ tally
|
|
981 |
|
93
|
982 |
"
|
202
|
983 |
ObjectMemory numberOfObjects
|
93
|
984 |
"
|
1
|
985 |
!
|
|
986 |
|
|
987 |
printReferences:anObject
|
178
|
988 |
"for debugging: print referents to anObject.
|
202
|
989 |
WARNING:
|
|
990 |
this method will vanish;
|
|
991 |
use ObjectMemory>>whoReferences: or anObject>>allOwners."
|
1
|
992 |
|
|
993 |
%{
|
|
994 |
_printRefChain(__context, anObject);
|
|
995 |
%}
|
|
996 |
!
|
|
997 |
|
202
|
998 |
collectObjectsWhich:aBlock
|
|
999 |
"helper for the whoReferences queries. Returns a collection
|
|
1000 |
of objects for which aBlock returns true."
|
1
|
1001 |
|
|
1002 |
|aCollection|
|
|
1003 |
|
|
1004 |
aCollection := IdentitySet new.
|
|
1005 |
self allObjectsDo:[:o |
|
202
|
1006 |
(aBlock value:o) ifTrue:[
|
159
|
1007 |
aCollection add:o
|
|
1008 |
]
|
1
|
1009 |
].
|
|
1010 |
(aCollection size == 0) ifTrue:[
|
159
|
1011 |
"actually this cannot happen - there is always one"
|
|
1012 |
^ nil
|
1
|
1013 |
].
|
|
1014 |
^ aCollection
|
13
|
1015 |
!
|
|
1016 |
|
202
|
1017 |
whoReferences:anObject
|
|
1018 |
"return a collection of objects referencing the argument, anObject"
|
|
1019 |
|
|
1020 |
^ self collectObjectsWhich:[:o | o references:anObject]
|
|
1021 |
|
|
1022 |
"
|
|
1023 |
(ObjectMemory whoReferences:Transcript) printNL
|
|
1024 |
"
|
|
1025 |
!
|
|
1026 |
|
|
1027 |
whoReferencesInstancesOf:aClass
|
|
1028 |
"return a collection of objects refering to instances
|
|
1029 |
of the argument, aClass"
|
|
1030 |
|
|
1031 |
^ self collectObjectsWhich:[:o | o referencesInstanceOf:aClass]
|
|
1032 |
|
|
1033 |
"
|
|
1034 |
(ObjectMemory whoReferencesInstancesOf:SystemBrowser) printNL
|
|
1035 |
"
|
|
1036 |
!
|
|
1037 |
|
|
1038 |
whoReferencesDerivedInstancesOf:aClass
|
|
1039 |
"return a collection of objects refering to instances
|
|
1040 |
of the argument, aClass or a subclass of it."
|
|
1041 |
|
|
1042 |
^ self collectObjectsWhich:[:o | o referencesDerivedInstanceOf:aClass]
|
|
1043 |
|
|
1044 |
"
|
|
1045 |
(ObjectMemory whoReferencesDerivedInstancesOf:View) printNL
|
|
1046 |
"
|
|
1047 |
!
|
|
1048 |
|
13
|
1049 |
addressOf:anObject
|
|
1050 |
"return the core address of anObject as an integer
|
|
1051 |
- since objects may move around, the returned value is invalid after the
|
|
1052 |
next scavenge/collect.
|
|
1053 |
Use only for debugging."
|
|
1054 |
|
|
1055 |
%{ /* NOCONTEXT */
|
|
1056 |
|
|
1057 |
if (! _isNonNilObject(anObject)) {
|
159
|
1058 |
RETURN ( nil );
|
13
|
1059 |
}
|
|
1060 |
RETURN ( _MKSMALLINT( (int)anObject ) );
|
|
1061 |
%}
|
|
1062 |
"
|
|
1063 |
|p|
|
|
1064 |
p := Point new.
|
77
|
1065 |
(ObjectMemory addressOf:p) printNL.
|
13
|
1066 |
ObjectMemory scavenge.
|
77
|
1067 |
(ObjectMemory addressOf:p) printNL.
|
13
|
1068 |
"
|
|
1069 |
!
|
|
1070 |
|
159
|
1071 |
objectAt:anAddress
|
|
1072 |
"return whatever anAddress points to as object.
|
202
|
1073 |
BIG BIG DANGER ALERT:
|
|
1074 |
this method is only to be used for debugging
|
|
1075 |
ST/X itself - you can easily (and badly) crash the system.
|
159
|
1076 |
This method will be removed from the final shipping version"
|
|
1077 |
|
|
1078 |
|low high|
|
|
1079 |
|
|
1080 |
low := anAddress bitAnd:16rFFFF.
|
|
1081 |
high := (anAddress bitShift:16) bitAnd:16rFFFF.
|
|
1082 |
%{
|
253
|
1083 |
if (__bothSmallInteger(low, high)) {
|
159
|
1084 |
RETURN ((OBJ)((_intVal(high) << 16) | _intVal(low)));
|
|
1085 |
}
|
|
1086 |
%}
|
|
1087 |
!
|
|
1088 |
|
13
|
1089 |
sizeOf:anObject
|
|
1090 |
"return the size of anObject in bytes.
|
|
1091 |
Use only for debugging/memory monitoring."
|
|
1092 |
|
|
1093 |
%{ /* NOCONTEXT */
|
|
1094 |
|
|
1095 |
RETURN ( _isNonNilObject(anObject) ? _MKSMALLINT(_qSize(anObject)) : _MKSMALLINT(0) )
|
|
1096 |
%}
|
|
1097 |
"
|
|
1098 |
|hist big nw|
|
|
1099 |
|
|
1100 |
hist := Array new:100 withAll:0.
|
|
1101 |
big := 0.
|
|
1102 |
ObjectMemory allObjectsDo:[:o |
|
159
|
1103 |
nw := (ObjectMemory sizeOf:o) // 4 + 1.
|
|
1104 |
nw > 100 ifTrue:[
|
|
1105 |
big := big + 1
|
|
1106 |
] ifFalse:[
|
|
1107 |
hist at:nw put:(hist at:nw) + 1
|
|
1108 |
].
|
13
|
1109 |
].
|
77
|
1110 |
hist printNL.
|
|
1111 |
big printNL
|
13
|
1112 |
"
|
|
1113 |
!
|
|
1114 |
|
|
1115 |
spaceOf:anObject
|
|
1116 |
"return the memory space, in which anObject is.
|
|
1117 |
- since objects may move between spaces, returned value is invalid after the
|
|
1118 |
next scavenge/collect.
|
202
|
1119 |
For debugging only; Dont use this method; it may vanish."
|
13
|
1120 |
|
|
1121 |
%{ /* NOCONTEXT */
|
|
1122 |
|
|
1123 |
if (! _isNonNilObject(anObject)) {
|
159
|
1124 |
RETURN ( nil );
|
13
|
1125 |
}
|
|
1126 |
RETURN ( _MKSMALLINT( _qSpace(anObject) ) );
|
|
1127 |
%}
|
159
|
1128 |
!
|
|
1129 |
|
|
1130 |
flagsOf:anObject
|
202
|
1131 |
"For debugging only; Dont use this method; it may vanish."
|
|
1132 |
|
159
|
1133 |
%{ /* NOCONTEXT */
|
|
1134 |
|
|
1135 |
if (! _isNonNilObject(anObject)) {
|
|
1136 |
RETURN ( nil );
|
|
1137 |
}
|
|
1138 |
RETURN ( _MKSMALLINT( anObject->o_flags ) );
|
|
1139 |
%}
|
13
|
1140 |
"
|
202
|
1141 |
F_ISREMEMBERED 1 /* a new-space thing being refd by some oldSpace thing */
|
|
1142 |
F_ISFORWARDED 2 /* a forwarded object (you will never see this here) */
|
159
|
1143 |
F_DEREFERENCED 4 /* a collection after grow (not currently used) */
|
|
1144 |
F_ISONLIFOLIST 8 /* a non-lifo-context-referencing-obj already on list */
|
|
1145 |
F_MARK 16 /* mark bit for background collector */
|
77
|
1146 |
"
|
|
1147 |
!
|
|
1148 |
|
|
1149 |
ageOf:anObject
|
|
1150 |
"return the number of scavenges, an object has survived
|
202
|
1151 |
in new space. For old objects and living contexts, the returned number
|
|
1152 |
is invalid.
|
|
1153 |
For debugging only; Dont use this method; it may vanish."
|
77
|
1154 |
|
|
1155 |
%{ /* NOCONTEXT */
|
|
1156 |
|
|
1157 |
if (! _isNonNilObject(anObject)) {
|
159
|
1158 |
RETURN ( 0 );
|
77
|
1159 |
}
|
|
1160 |
RETURN ( _MKSMALLINT( _GET_AGE(anObject) ) );
|
|
1161 |
%}
|
|
1162 |
"
|
|
1163 |
|p|
|
|
1164 |
p := Point new.
|
|
1165 |
(ObjectMemory ageOf:p) printNL.
|
|
1166 |
ObjectMemory tenuringScavenge.
|
|
1167 |
(ObjectMemory spaceOf:p) printNL.
|
|
1168 |
ObjectMemory tenuringScavenge.
|
|
1169 |
(ObjectMemory spaceOf:p) printNL.
|
|
1170 |
ObjectMemory tenuringScavenge.
|
|
1171 |
(ObjectMemory spaceOf:p) printNL.
|
|
1172 |
ObjectMemory tenuringScavenge.
|
|
1173 |
(ObjectMemory spaceOf:p) printNL.
|
13
|
1174 |
"
|
1
|
1175 |
! !
|
|
1176 |
|
178
|
1177 |
!ObjectMemory class methodsFor:'garbage collection'!
|
1
|
1178 |
|
133
|
1179 |
scavenge
|
|
1180 |
"collect young objects, without aging (i.e. no tenure).
|
|
1181 |
Can be used to quickly get rid of shortly before allocated
|
|
1182 |
stuff. This is relatively fast (compared to oldspace collect).
|
|
1183 |
|
|
1184 |
An example where a non-tenuring scavenge makes sense is when
|
|
1185 |
allocating some OperatingSystem resource (a Color, File or View)
|
|
1186 |
and the OS runs out of resources. In this case, the scavenge may
|
|
1187 |
free some ST-objects and therefore (by signalling the WeakArrays
|
|
1188 |
or Registries) free the OS resources too.
|
|
1189 |
Of course, only recently allocated resources will be freed this
|
|
1190 |
way. If none was freed, a full collect will be needed."
|
|
1191 |
%{
|
|
1192 |
nonTenuringScavenge(__context);
|
|
1193 |
%}
|
|
1194 |
|
|
1195 |
"
|
|
1196 |
ObjectMemory scavenge
|
|
1197 |
"
|
|
1198 |
!
|
|
1199 |
|
|
1200 |
tenuringScavenge
|
|
1201 |
"collect newspace stuff, with aging (i.e. objects old enough
|
|
1202 |
will be moved into the oldSpace).
|
|
1203 |
Use this for debugging and testing only - the system performs
|
|
1204 |
this automatically when the newspace fills up.
|
|
1205 |
This is relatively fast (compared to oldspace collect)"
|
|
1206 |
%{
|
|
1207 |
scavenge(__context);
|
|
1208 |
%}
|
|
1209 |
|
|
1210 |
"
|
|
1211 |
ObjectMemory tenuringScavenge
|
|
1212 |
"
|
|
1213 |
!
|
|
1214 |
|
|
1215 |
tenure
|
|
1216 |
"force all living new stuff into old-space - effectively making
|
|
1217 |
all living young objects become old objects.
|
|
1218 |
This is relatively fast (compared to oldspace collect).
|
|
1219 |
|
|
1220 |
This method should only be used in very special situations:
|
|
1221 |
for example, when building up some long-living data structure
|
|
1222 |
in a time critical application.
|
194
|
1223 |
To do so, you have to do a scavenge followed by a tenure after the
|
133
|
1224 |
objects are created. Be careful, to not reference any other chunk-
|
|
1225 |
data when calling for a tenure (this will lead to lots of garbage in
|
|
1226 |
the oldspace).
|
|
1227 |
In normal situations, explicit tenures are not needed."
|
|
1228 |
%{
|
|
1229 |
tenure(__context);
|
|
1230 |
%}
|
|
1231 |
|
|
1232 |
"
|
|
1233 |
ObjectMemory tenure
|
|
1234 |
"
|
194
|
1235 |
"
|
|
1236 |
... build up long living objects ...
|
|
1237 |
ObjectMemory scavenge.
|
|
1238 |
ObjectMemory tenure
|
|
1239 |
... continue - objects created above are now in oldSpace ...
|
|
1240 |
"
|
133
|
1241 |
!
|
|
1242 |
|
1
|
1243 |
garbageCollect
|
178
|
1244 |
"search for and free garbage in the oldSpace (newSpace is cleaned automatically)
|
|
1245 |
performing a COMPRESSING garbage collect.
|
133
|
1246 |
This can take a long time - especially, if paging is involved
|
178
|
1247 |
(when no paging is involved, its faster than I thought :-).
|
202
|
1248 |
If no memory is available for the compress, or the system has been started with
|
|
1249 |
the -Msingle option, this does a non-COMPRESSING collect."
|
1
|
1250 |
%{
|
178
|
1251 |
if (! __garbageCollect(__context)) {
|
|
1252 |
markAndSweep(__context);
|
|
1253 |
}
|
1
|
1254 |
%}
|
|
1255 |
|
93
|
1256 |
"
|
|
1257 |
ObjectMemory garbageCollect
|
|
1258 |
"
|
1
|
1259 |
!
|
|
1260 |
|
93
|
1261 |
reclaimSymbols
|
|
1262 |
"reclaim unused symbols;
|
159
|
1263 |
Unused symbols are (currently) not reclaimed automatically,
|
93
|
1264 |
but only upon request with this method. It takes some time
|
|
1265 |
to do this ...
|
202
|
1266 |
Future versions may do this automatically, while garbage collecting."
|
93
|
1267 |
%{
|
|
1268 |
__reclaimSymbols(__context);
|
|
1269 |
%}
|
|
1270 |
"
|
|
1271 |
ObjectMemory reclaimSymbols
|
|
1272 |
"
|
|
1273 |
!
|
|
1274 |
|
1
|
1275 |
markAndSweep
|
133
|
1276 |
"mark/sweep garbage collector.
|
|
1277 |
perform a full mark&sweep collect.
|
77
|
1278 |
Warning: this may take some time."
|
1
|
1279 |
%{
|
|
1280 |
markAndSweep(__context);
|
|
1281 |
%}
|
|
1282 |
|
93
|
1283 |
"
|
133
|
1284 |
ObjectMemory markAndSweep
|
|
1285 |
"
|
1
|
1286 |
!
|
|
1287 |
|
|
1288 |
gcStep
|
77
|
1289 |
"one incremental garbage collect step.
|
|
1290 |
Mark or sweep some small number of objects. This
|
85
|
1291 |
method will return after a reasonable (short) time.
|
133
|
1292 |
This is used by the ProcessorScheduler at idle times.
|
|
1293 |
Returns true, if an incremental GC cycle has finished."
|
1
|
1294 |
%{
|
133
|
1295 |
extern int __incrGCstep();
|
|
1296 |
|
|
1297 |
RETURN (__incrGCstep(__context) ? true : false);
|
1
|
1298 |
%}
|
|
1299 |
!
|
|
1300 |
|
133
|
1301 |
incrementalGC
|
|
1302 |
"perform one round of incremental GC steps.
|
202
|
1303 |
The overall effect of this method is the same as calling markAndSweep.
|
133
|
1304 |
However, #incrementalGC is interruptable while #markAndSweep
|
|
1305 |
blocks for a while. Thus this method can be called from a low
|
|
1306 |
prio (background) process to collect without disturbing
|
159
|
1307 |
foreground processes too much.
|
|
1308 |
For example, someone allocating huge amounts of memory could
|
|
1309 |
ask for the possibility of a quick allocation using
|
|
1310 |
#checkForFastNew: and try a #incrementalGC if not. In many
|
270
|
1311 |
cases, this can avoid a pause (in the higher prio processes) due to
|
|
1312 |
a blocking GC."
|
133
|
1313 |
|
|
1314 |
[self gcStep] whileFalse:[]
|
|
1315 |
|
|
1316 |
"
|
|
1317 |
ObjectMemory incrementalGC
|
|
1318 |
"
|
194
|
1319 |
!
|
|
1320 |
|
270
|
1321 |
gcStepIfUseful
|
|
1322 |
"If either the IncrementalGCLimit or the FreeSpaceGCLimits have been
|
290
|
1323 |
reached, perform one incremental garbage collect step.
|
|
1324 |
Return true, if more gcSteps are required to finish the cycle,
|
|
1325 |
false if done with a gc round.
|
|
1326 |
If no limit has been reached yet, do nothing and return false.
|
270
|
1327 |
This is called by the ProcessorScheduler at idle times."
|
|
1328 |
|
310
|
1329 |
|done limit free amount|
|
270
|
1330 |
|
290
|
1331 |
limit := IncrementalGCLimit.
|
|
1332 |
(limit notNil and:[self oldSpaceAllocatedSinceLastGC > limit]) ifTrue:[
|
|
1333 |
^ ObjectMemory gcStep not
|
|
1334 |
].
|
|
1335 |
limit := FreeSpaceGCLimit.
|
|
1336 |
(limit notNil and:[(self freeSpace + self freeListSpace) < limit]) ifTrue:[
|
|
1337 |
done := ObjectMemory gcStep.
|
|
1338 |
done ifTrue:[
|
|
1339 |
"/
|
|
1340 |
"/ finished with this cycle;
|
|
1341 |
"/ if reclaimed space is below limit, we have to allocate more
|
|
1342 |
"/ oldSpace, to avoid excessive gcSteps (due to freeSpaceLimit
|
|
1343 |
"/ still not reached)
|
|
1344 |
"/
|
|
1345 |
free := self freeSpace + self freeListSpace.
|
|
1346 |
free < limit ifTrue:[
|
310
|
1347 |
amount := FreeSpaceGCAmount.
|
|
1348 |
amount isNil ifTrue:[
|
|
1349 |
amount := limit * 3 // 2.
|
|
1350 |
].
|
|
1351 |
self moreOldSpace:(amount - free + (64*1024))
|
290
|
1352 |
].
|
|
1353 |
^ false
|
|
1354 |
].
|
|
1355 |
^ true
|
|
1356 |
].
|
|
1357 |
^ false
|
270
|
1358 |
!
|
|
1359 |
|
194
|
1360 |
verboseGarbageCollect
|
|
1361 |
"perform a compessing garbage collect and show some informational
|
|
1362 |
output on the Transcript"
|
|
1363 |
|
|
1364 |
|nBytesBefore nReclaimed|
|
|
1365 |
|
|
1366 |
nBytesBefore := self oldSpaceUsed.
|
|
1367 |
self garbageCollect.
|
|
1368 |
nReclaimed := nBytesBefore - self oldSpaceUsed.
|
|
1369 |
nReclaimed > 0 ifTrue:[
|
|
1370 |
Transcript show:'reclaimed '.
|
|
1371 |
nReclaimed > 1024 ifTrue:[
|
|
1372 |
nReclaimed > (1024 * 1024) ifTrue:[
|
|
1373 |
Transcript show:(nReclaimed // (1024 * 1024)) printString.
|
|
1374 |
Transcript showCr:' Mb.'
|
|
1375 |
] ifFalse:[
|
|
1376 |
Transcript show:(nReclaimed // 1024) printString.
|
|
1377 |
Transcript showCr:' Kb.'
|
|
1378 |
]
|
|
1379 |
] ifFalse:[
|
|
1380 |
Transcript show:nReclaimed printString.
|
|
1381 |
Transcript showCr:' bytes.'
|
|
1382 |
]
|
|
1383 |
]
|
|
1384 |
|
|
1385 |
"
|
|
1386 |
ObjectMemory verboseGarbageCollect
|
|
1387 |
"
|
207
|
1388 |
!
|
|
1389 |
|
|
1390 |
startBackgroundCollectorAt:aPriority
|
|
1391 |
"start a process doing incremental GC in the background.
|
|
1392 |
Use this, if you have suspendable background processes which
|
|
1393 |
run all the time, and therefore would prevent the idle-collector
|
|
1394 |
from running. See documentation in this class for more details."
|
|
1395 |
|
290
|
1396 |
|p|
|
|
1397 |
|
270
|
1398 |
"/
|
|
1399 |
"/ its not useful, to run it more than once
|
|
1400 |
"/
|
207
|
1401 |
BackgroundCollectProcess notNil ifTrue:[
|
|
1402 |
BackgroundCollectProcess priority:aPriority.
|
|
1403 |
^ self
|
|
1404 |
].
|
270
|
1405 |
|
290
|
1406 |
p :=
|
207
|
1407 |
[
|
290
|
1408 |
[
|
|
1409 |
[true] whileTrue:[
|
|
1410 |
self gcStepIfUseful ifTrue:[
|
|
1411 |
"
|
|
1412 |
perform a full cycle
|
|
1413 |
"
|
|
1414 |
self incrementalGC
|
|
1415 |
].
|
270
|
1416 |
"
|
290
|
1417 |
wait a bit
|
|
1418 |
"
|
|
1419 |
(Delay forSeconds:5) wait
|
|
1420 |
]
|
|
1421 |
] valueOnUnwindDo:[
|
|
1422 |
BackgroundCollectProcess := nil
|
211
|
1423 |
]
|
207
|
1424 |
] newProcess.
|
290
|
1425 |
p name:'background collector'.
|
|
1426 |
p priority:aPriority.
|
|
1427 |
p resume.
|
|
1428 |
BackgroundCollectProcess := p
|
211
|
1429 |
|
|
1430 |
"
|
293
|
1431 |
the following lets the backgroundCollector run at prio 5
|
|
1432 |
whenever 100000 bytes have been allocated, OR freeSpace drops
|
|
1433 |
below 1meg. Having the system keep 1meg as reserve for peak allocation.
|
|
1434 |
|
|
1435 |
Doing this may reduce pauses due to inevitable collects when running
|
|
1436 |
out of freeSpace, if the collector can keep up with allocation rate.
|
|
1437 |
"
|
|
1438 |
|
|
1439 |
"
|
|
1440 |
ObjectMemory incrementalGCLimit:100000.
|
|
1441 |
ObjectMemory freeSpaceGCLimit:1000000.
|
211
|
1442 |
ObjectMemory startBackgroundCollectorAt:5
|
|
1443 |
"
|
207
|
1444 |
!
|
|
1445 |
|
|
1446 |
stopBackgroundCollector
|
|
1447 |
"stop the background collector"
|
|
1448 |
|
|
1449 |
BackgroundCollectProcess notNil ifTrue:[
|
|
1450 |
BackgroundCollectProcess terminate.
|
|
1451 |
BackgroundCollectProcess := nil
|
|
1452 |
]
|
293
|
1453 |
|
211
|
1454 |
"
|
|
1455 |
ObjectMemory stopBackgroundCollector
|
|
1456 |
"
|
178
|
1457 |
! !
|
|
1458 |
|
|
1459 |
!ObjectMemory class methodsFor:'garbage collector control'!
|
133
|
1460 |
|
270
|
1461 |
freeSpaceGCLimit:aNumber
|
|
1462 |
"set the freeSpace limit for incremental GC activation.
|
|
1463 |
The system will start doing incremental background GC, once less than this number
|
310
|
1464 |
of bytes are available for allocation.
|
|
1465 |
The default is nil; setting it to nil will turn this trigger off."
|
270
|
1466 |
|
|
1467 |
FreeSpaceGCLimit := aNumber
|
|
1468 |
|
|
1469 |
"
|
310
|
1470 |
the following will start the incrementalGC (in the background)
|
|
1471 |
whenever the freeSpace drops below 1meg of free space
|
290
|
1472 |
"
|
|
1473 |
"
|
|
1474 |
ObjectMemory freeSpaceGCLimit:1000000.
|
|
1475 |
"
|
|
1476 |
|
|
1477 |
"
|
293
|
1478 |
turn it off (i.e. let the system hit the wall ...)
|
290
|
1479 |
"
|
|
1480 |
"
|
270
|
1481 |
ObjectMemory freeSpaceGCLimit:nil.
|
|
1482 |
"
|
|
1483 |
!
|
|
1484 |
|
310
|
1485 |
freeSpaceGCAmount:aNumber
|
|
1486 |
"set the amount to be allocated if, after an incrementalGC,
|
|
1487 |
not at least FreeSpaceGCLimit bytes are available for allocation.
|
|
1488 |
The amount should be greater than the limit, otherwise the incremental
|
|
1489 |
GC may try over and over to get the memory (actually waisting time)."
|
|
1490 |
|
|
1491 |
FreeSpaceGCAmount := aNumber
|
|
1492 |
|
|
1493 |
"
|
|
1494 |
the following will try to always keep at least 1meg of free space
|
|
1495 |
(in the background) and start to do so, whenever the freeSpace drops
|
|
1496 |
below 250k.
|
|
1497 |
"
|
|
1498 |
"
|
|
1499 |
ObjectMemory freeSpaceGCLimit:250000.
|
|
1500 |
ObjectMemory freeSpaceGCAmount:1000000.
|
|
1501 |
"
|
|
1502 |
|
|
1503 |
"
|
|
1504 |
turn it off (i.e. let the system compute an appropriate amount ...)
|
|
1505 |
"
|
|
1506 |
"
|
|
1507 |
ObjectMemory freeSpaceGCAmount:nil.
|
|
1508 |
"
|
|
1509 |
!
|
|
1510 |
|
270
|
1511 |
freeSpaceGCLimit
|
|
1512 |
"return the freeSpace limit for incremental GC activation.
|
|
1513 |
The system will start doing incremental background GC, once less than this number
|
|
1514 |
of bytes are available in the compact free space.
|
|
1515 |
The default is 100000; setting it to nil will turn this trigger off."
|
|
1516 |
|
|
1517 |
^ FreeSpaceGCLimit
|
|
1518 |
|
|
1519 |
"
|
|
1520 |
ObjectMemory freeSpaceGCLimit
|
|
1521 |
"
|
|
1522 |
!
|
|
1523 |
|
310
|
1524 |
freeSpaceGCAmount
|
|
1525 |
"return the amount to be allocated if, after an incrementalGC,
|
|
1526 |
not at least FreeSpaceGCLimit bytes are available for allocation.
|
|
1527 |
The default is nil, which lets the system compute an abbpropriate value"
|
|
1528 |
|
|
1529 |
^ FreeSpaceGCAmount
|
|
1530 |
|
|
1531 |
"
|
|
1532 |
ObjectMemory freeSpaceGCAmount
|
|
1533 |
"
|
|
1534 |
!
|
|
1535 |
|
2
|
1536 |
incrementalGCLimit:aNumber
|
270
|
1537 |
"set the allocatedSinceLastGC limit for incremental GC activation.
|
|
1538 |
The system will start doing incremental background GC, once more than this number
|
|
1539 |
of bytes have been allocated since the last GC.
|
|
1540 |
The default is 500000; setting it to nil will turn this trigger off."
|
2
|
1541 |
|
|
1542 |
IncrementalGCLimit := aNumber
|
|
1543 |
|
85
|
1544 |
"
|
213
|
1545 |
ObjectMemory incrementalGCLimit:500000. 'do incr. GC very seldom'
|
|
1546 |
ObjectMemory incrementalGCLimit:100000. 'medium'
|
|
1547 |
ObjectMemory incrementalGCLimit:10000. 'do incr. GC very often'
|
|
1548 |
ObjectMemory incrementalGCLimit:nil. 'never'
|
85
|
1549 |
"
|
2
|
1550 |
!
|
|
1551 |
|
13
|
1552 |
incrementalGCLimit
|
270
|
1553 |
"return the allocatedSinceLastGC limit for incremental GC activation.
|
|
1554 |
The system will start doing incremental background GC, once more than this number
|
|
1555 |
of bytes have been allocated since the last GC.
|
|
1556 |
The default is 500000; setting it to nil will turn this trigger off."
|
13
|
1557 |
|
|
1558 |
^ IncrementalGCLimit
|
|
1559 |
|
85
|
1560 |
"
|
|
1561 |
ObjectMemory incrementalGCLimit
|
|
1562 |
"
|
13
|
1563 |
!
|
|
1564 |
|
133
|
1565 |
moreOldSpace:howMuch
|
|
1566 |
"allocate howMuch bytes more for old objects.
|
|
1567 |
This is done automatically, when running out of space, but makes
|
|
1568 |
sense, if its known in advance that a lot of memory is needed to
|
|
1569 |
avoid multiple reallocations and compresses.
|
310
|
1570 |
On systems which do not support the mmap (or equivalent) system call,
|
|
1571 |
this (currently) implies a compressing garbage collect - so its slow.
|
133
|
1572 |
Notice: this is a nonstandard interface - use only in special situations."
|
|
1573 |
|
|
1574 |
%{
|
253
|
1575 |
if (__isSmallInteger(howMuch))
|
159
|
1576 |
__moreOldSpace(__context, _intVal(howMuch));
|
133
|
1577 |
%}
|
|
1578 |
"
|
|
1579 |
ObjectMemory moreOldSpace:1000000
|
|
1580 |
"
|
|
1581 |
!
|
|
1582 |
|
202
|
1583 |
announceSpaceNeed:howMuch
|
|
1584 |
"announce to the memory system, that howMuch bytes of memory will be needed
|
|
1585 |
soon. The VM tries to prepare itself for this allocation to be performed
|
|
1586 |
with less overhead. For example, it could preallocate some memory in one
|
|
1587 |
big chunk (instead of doing many smaller reallocations later).
|
|
1588 |
Notice: this is a nonstandard interface - use only in special situations.
|
|
1589 |
Also, this does a background collect before the big chunk of memory is
|
|
1590 |
allocated, not locking other processes while doing so."
|
|
1591 |
|
|
1592 |
(howMuch < (self newSpaceSize // 2)) ifTrue:[
|
|
1593 |
self scavenge.
|
|
1594 |
].
|
|
1595 |
(self checkForFastNew:howMuch) ifFalse:[
|
|
1596 |
(howMuch > (self newSpaceSize // 2)) ifFalse:[
|
|
1597 |
self scavenge.
|
|
1598 |
].
|
|
1599 |
self incrementalGC.
|
|
1600 |
(self checkForFastNew:howMuch) ifFalse:[
|
|
1601 |
self moreOldSpace:howMuch
|
|
1602 |
]
|
|
1603 |
]
|
|
1604 |
|
|
1605 |
"
|
|
1606 |
ObjectMemory announceSpaceNeed:100000
|
|
1607 |
"
|
|
1608 |
!
|
|
1609 |
|
133
|
1610 |
announceOldSpaceNeed:howMuch
|
202
|
1611 |
"announce to the memory system, that howMuch bytes of memory will be needed
|
|
1612 |
soon, which is going to live longer (whatever that means).
|
|
1613 |
It first checks if the memory can be allocated without forcing a compressing
|
|
1614 |
GC. If not, the oldSpace is increased. This may also lead to a slow compressing
|
133
|
1615 |
collect. However, many smaller increases are avoided afterwards. Calling this
|
|
1616 |
method before allocating huge chunks of data may provide better overall performance.
|
|
1617 |
Notice: this is a nonstandard interface - use only in special situations."
|
|
1618 |
|
|
1619 |
(self checkForFastNew:howMuch) ifFalse:[
|
159
|
1620 |
self incrementalGC.
|
|
1621 |
(self checkForFastNew:howMuch) ifFalse:[
|
|
1622 |
self moreOldSpace:howMuch
|
|
1623 |
]
|
133
|
1624 |
]
|
|
1625 |
|
|
1626 |
"
|
|
1627 |
ObjectMemory announceOldSpaceNeed:1000000
|
|
1628 |
"
|
|
1629 |
!
|
|
1630 |
|
|
1631 |
oldSpaceIncrement
|
|
1632 |
"return the oldSpaceIncrement value. Thats the amount by which
|
|
1633 |
more memory is allocated in case the oldSpace gets filled up.
|
|
1634 |
In normal situations, the default value used in the VM is fine
|
|
1635 |
and there is no need to change it."
|
178
|
1636 |
|
|
1637 |
%{ /* NOCONTEXT */
|
133
|
1638 |
extern unsigned __oldSpaceIncrement();
|
|
1639 |
|
|
1640 |
RETURN (_MKSMALLINT( __oldSpaceIncrement(-1) ));
|
|
1641 |
%}
|
178
|
1642 |
"
|
|
1643 |
ObjectMemory oldSpaceIncrement
|
|
1644 |
"
|
133
|
1645 |
!
|
|
1646 |
|
|
1647 |
oldSpaceIncrement:amount
|
|
1648 |
"set the oldSpaceIncrement value. Thats the amount by which
|
|
1649 |
more memory is allocated in case the oldSpace gets filled up.
|
|
1650 |
In normal situations, the default value used in the VM is fine
|
|
1651 |
and there is no need to change it. This method returns the
|
|
1652 |
previous increment value."
|
178
|
1653 |
|
|
1654 |
%{ /* NOCONTEXT */
|
133
|
1655 |
extern unsigned __oldSpaceIncrement();
|
|
1656 |
|
253
|
1657 |
if (__isSmallInteger(amount)) {
|
159
|
1658 |
RETURN (_MKSMALLINT( __oldSpaceIncrement(_intVal(amount)) ));
|
133
|
1659 |
}
|
|
1660 |
%}
|
178
|
1661 |
"to change increment to 1Meg:"
|
|
1662 |
"
|
|
1663 |
ObjectMemory oldSpaceIncrement:1024*1024
|
|
1664 |
"
|
|
1665 |
!
|
|
1666 |
|
|
1667 |
fastMoreOldSpaceAllocation:aBoolean
|
|
1668 |
"this method turns on/off fastMoreOldSpace allocation.
|
|
1669 |
By default, this is turned off (false), which means that in case of
|
202
|
1670 |
a filled-up oldSpace, a GC is tried first before more oldSpace is allocated.
|
178
|
1671 |
This strategy is ok for the normal operation of the system,
|
|
1672 |
but behaves badly, if the program allocates huge data structures (say a
|
202
|
1673 |
game tree of 30Mb in size) which survives and therefore will not be reclaimed
|
178
|
1674 |
by a GC.
|
202
|
1675 |
Of course while building this tree, and the memory becomes full, the system
|
|
1676 |
would not know in advance, that the GC will not reclaim anything.
|
|
1677 |
|
178
|
1678 |
Setting fastOldSpaceIncrement to true will avoid this, by forcing the
|
|
1679 |
memory system to allocate more memory right away, without doing a GC first.
|
|
1680 |
|
|
1681 |
WARNING: make certain that this flag is turned off, after your huge data
|
|
1682 |
is allocated, since otherwise the system may continue to increase its
|
202
|
1683 |
virtual memory without ever checking for garbage.
|
310
|
1684 |
This method returns the previous value of the flag; typically this return
|
|
1685 |
value should be used to switch back."
|
178
|
1686 |
|
|
1687 |
%{ /* NOCONTEXT */
|
|
1688 |
RETURN (__fastMoreOldSpaceAllocation(aBoolean == true ? 1 : 0) ? true : false);
|
|
1689 |
%}
|
310
|
1690 |
"
|
|
1691 |
|previousSetting|
|
|
1692 |
|
|
1693 |
previousSetting := ObjectMemory fastMoreOldSpaceAllocation:true.
|
|
1694 |
[
|
|
1695 |
...
|
|
1696 |
allocate your huge data
|
|
1697 |
...
|
|
1698 |
] valueNoOrOnUnwindDo:[
|
|
1699 |
ObjectMemory fastMoreOldSpaceAllocation:previousSetting
|
|
1700 |
]
|
|
1701 |
"
|
133
|
1702 |
!
|
|
1703 |
|
|
1704 |
checkForFastNew:amount
|
|
1705 |
"this method returns true, if amount bytes could be allocated
|
|
1706 |
quickly (i.e. without forcing a full GC or compress).
|
|
1707 |
This can be used for smart background processes, which want to
|
|
1708 |
allocate big chunks of data without disturbing foreground processes
|
|
1709 |
too much. Such a process would check for fast-allocation, and perform
|
202
|
1710 |
incremental GC-steps if required. Thus, avoiding the long blocking pause
|
310
|
1711 |
due to a forced (non-incremental) GC.
|
|
1712 |
Especially: doing so will not block higher priority foreground processes.
|
|
1713 |
See an example use in Behavior>>niceBasicNew:.
|
133
|
1714 |
This is experimental and not guaranteed to be in future versions."
|
|
1715 |
|
178
|
1716 |
%{ /* NOCONTEXT */
|
133
|
1717 |
extern __checkForFastNew();
|
|
1718 |
|
253
|
1719 |
if (__isSmallInteger(amount)) {
|
159
|
1720 |
if (! __checkForFastNew(_intVal(amount))) {
|
|
1721 |
RETURN (false);
|
|
1722 |
}
|
133
|
1723 |
}
|
|
1724 |
|
|
1725 |
%}.
|
|
1726 |
^ true
|
|
1727 |
!
|
|
1728 |
|
2
|
1729 |
turnGarbageCollectorOff
|
310
|
1730 |
"turn off the generational garbage collector by forcing new objects to be
|
|
1731 |
allocated directly in oldSpace (instead of newSpace)
|
178
|
1732 |
WARNING:
|
93
|
1733 |
This is somewhat dangerous: if collector is turned off,
|
77
|
1734 |
and too many objects are created, the system may run into trouble
|
|
1735 |
(i.e. oldSpace becomes full) and be forced to perform a full mark&sweep
|
202
|
1736 |
or even a compressing collect - making the overall realtime behavior worse.
|
93
|
1737 |
Use this only for special purposes or when realtime behavior
|
178
|
1738 |
is required for a limited time period."
|
|
1739 |
|
|
1740 |
%{ /* NOCONTEXT */
|
133
|
1741 |
__allocForceSpace(OLDSPACE);
|
1
|
1742 |
%}
|
|
1743 |
!
|
|
1744 |
|
2
|
1745 |
turnGarbageCollectorOn
|
202
|
1746 |
"turn garbage collector on again (see ObjectMemory>>turnGarbageCollectorOff)"
|
1
|
1747 |
|
178
|
1748 |
%{ /* NOCONTEXT */
|
133
|
1749 |
__allocForceSpace(9999);
|
1
|
1750 |
%}
|
178
|
1751 |
!
|
85
|
1752 |
|
|
1753 |
makeOld:anObject
|
93
|
1754 |
"move anObject into oldSpace.
|
133
|
1755 |
This method is for internal & debugging purposes only -
|
|
1756 |
it may vanish. Dont use it."
|
85
|
1757 |
%{
|
|
1758 |
if (__moveToOldSpace(anObject, __context) < 0) {
|
159
|
1759 |
RETURN (false);
|
93
|
1760 |
}
|
|
1761 |
%}.
|
|
1762 |
^ true
|
194
|
1763 |
!
|
|
1764 |
|
|
1765 |
tenureParameters:magic
|
|
1766 |
"this is pure magic and not for public eyes ...
|
202
|
1767 |
This method allows fine tuning the scavenger internals,
|
194
|
1768 |
in cooperation to some statistic & test programs.
|
202
|
1769 |
It is undocumented, secret and may vanish.
|
|
1770 |
If you play around here, the system may behave very strange."
|
194
|
1771 |
|
|
1772 |
%{ /* NOCONTEXT */
|
|
1773 |
__tenureParams(magic);
|
|
1774 |
%}.
|
178
|
1775 |
! !
|
|
1776 |
|
290
|
1777 |
!ObjectMemory class methodsFor:'object finalization'!
|
|
1778 |
|
|
1779 |
allShadowObjectsDo:aBlock
|
|
1780 |
"evaluate the argument, aBlock for all known shadow objects"
|
|
1781 |
%{
|
|
1782 |
__allShadowObjectsDo(&aBlock, __context);
|
|
1783 |
%}
|
|
1784 |
!
|
|
1785 |
|
|
1786 |
allChangedShadowObjectsDo:aBlock
|
|
1787 |
"evaluate the argument, aBlock for all known shadow objects which have
|
|
1788 |
lost a pointer recently."
|
|
1789 |
%{
|
|
1790 |
__allChangedShadowObjectsDo(&aBlock, __context);
|
|
1791 |
%}
|
|
1792 |
!
|
|
1793 |
|
291
|
1794 |
finalize
|
|
1795 |
"tell all weak objects that something happened."
|
|
1796 |
|
|
1797 |
self allChangedShadowObjectsDo:[:aShadowArray |
|
|
1798 |
aShadowArray lostPointer.
|
|
1799 |
]
|
|
1800 |
!
|
|
1801 |
|
290
|
1802 |
disposeInterrupt
|
|
1803 |
"this is triggered by the garbage collector,
|
|
1804 |
whenever any shadowArray looses a pointer."
|
|
1805 |
|
|
1806 |
FinalizationSemaphore notNil ifTrue:[
|
|
1807 |
"/
|
|
1808 |
"/ background finalizer is waiting ...
|
|
1809 |
"/
|
|
1810 |
FinalizationSemaphore signal
|
|
1811 |
] ifFalse:[
|
|
1812 |
"/
|
|
1813 |
"/ do it right here
|
|
1814 |
"/
|
291
|
1815 |
self finalize
|
290
|
1816 |
]
|
|
1817 |
!
|
|
1818 |
|
|
1819 |
startBackgroundFinalizationAt:aPriority
|
|
1820 |
"start a process doing finalization work in the background.
|
|
1821 |
Can be used to reduce the pauses created by finalization.
|
|
1822 |
Normally, these pauses are not noticed; however if you have (say)
|
|
1823 |
ten thousands of weak objects, these could become long enough to
|
|
1824 |
make background finalization usefull.
|
|
1825 |
WARNING: background finalization may lead to much delayed freeing of
|
|
1826 |
system resources. Especially, you may temporarily run out of free
|
|
1827 |
color table entries or fileDescriptors etc. Use at your own risk (if at all)"
|
|
1828 |
|
|
1829 |
|p|
|
|
1830 |
|
|
1831 |
"/
|
|
1832 |
"/ its not useful, to run it more than once
|
|
1833 |
"/
|
|
1834 |
BackgroundFinalizationProcess notNil ifTrue:[
|
|
1835 |
BackgroundFinalizationProcess priority:aPriority.
|
|
1836 |
^ self
|
|
1837 |
].
|
|
1838 |
|
|
1839 |
FinalizationSemaphore := Semaphore new.
|
|
1840 |
|
|
1841 |
p :=
|
|
1842 |
[
|
|
1843 |
[
|
|
1844 |
[true] whileTrue:[
|
|
1845 |
"
|
|
1846 |
wait till something to do ...
|
|
1847 |
"
|
|
1848 |
FinalizationSemaphore wait.
|
|
1849 |
"
|
|
1850 |
... and do it
|
|
1851 |
"
|
291
|
1852 |
self finalize
|
290
|
1853 |
]
|
|
1854 |
] valueOnUnwindDo:[
|
|
1855 |
BackgroundFinalizationProcess := nil.
|
|
1856 |
FinalizationSemaphore := nil
|
|
1857 |
]
|
|
1858 |
] newProcess.
|
|
1859 |
p name:'background finalizer'.
|
|
1860 |
p priority:aPriority.
|
|
1861 |
p resume.
|
|
1862 |
BackgroundFinalizationProcess := p
|
|
1863 |
|
|
1864 |
"
|
|
1865 |
ObjectMemory startBackgroundFinalizationAt:5
|
|
1866 |
"
|
|
1867 |
!
|
|
1868 |
|
|
1869 |
stopBackgroundFinalization
|
|
1870 |
"stop the background finalizer"
|
|
1871 |
|
|
1872 |
BackgroundFinalizationProcess notNil ifTrue:[
|
|
1873 |
BackgroundFinalizationProcess terminate.
|
|
1874 |
BackgroundFinalizationProcess := nil
|
|
1875 |
].
|
|
1876 |
|
|
1877 |
"
|
|
1878 |
ObjectMemory stopBackgroundFinalization
|
|
1879 |
"
|
|
1880 |
! !
|
|
1881 |
|
178
|
1882 |
!ObjectMemory class methodsFor:'physical memory access'!
|
93
|
1883 |
|
|
1884 |
newSpacePagesDo:aBlock
|
|
1885 |
"evaluates aBlock for all pages in the newSpace, passing
|
|
1886 |
the pages address as argument.
|
|
1887 |
For internal & debugging use only."
|
|
1888 |
%{
|
|
1889 |
if (__newSpacePagesDo(&aBlock COMMA_CON) < 0) {
|
159
|
1890 |
RETURN (false);
|
85
|
1891 |
}
|
|
1892 |
%}.
|
|
1893 |
^ true
|
|
1894 |
!
|
|
1895 |
|
|
1896 |
oldSpacePagesDo:aBlock
|
|
1897 |
"evaluates aBlock for all pages in the oldSpace, passing
|
|
1898 |
the pages address as argument.
|
93
|
1899 |
For internal & debugging use only."
|
85
|
1900 |
%{
|
|
1901 |
if (__oldSpacePagesDo(&aBlock COMMA_CON) < 0) {
|
159
|
1902 |
RETURN (false);
|
85
|
1903 |
}
|
|
1904 |
%}.
|
|
1905 |
^ true
|
|
1906 |
!
|
|
1907 |
|
93
|
1908 |
collectedOldSpacePagesDo:aBlock
|
|
1909 |
"evaluates aBlock for all pages in the prev. oldSpace, passing
|
|
1910 |
the pages address as argument.
|
|
1911 |
For internal & debugging use only."
|
|
1912 |
%{
|
|
1913 |
if (__collectedOldSpacePagesDo(&aBlock COMMA_CON) < 0) {
|
159
|
1914 |
RETURN (false);
|
93
|
1915 |
}
|
|
1916 |
%}.
|
|
1917 |
^ true
|
|
1918 |
!
|
|
1919 |
|
85
|
1920 |
pageIsInCore:aPageNumber
|
|
1921 |
"return true, if the page (as enumerated via oldSpacePagesDo:)
|
|
1922 |
is in memory; false, if currently paged out. For internal
|
93
|
1923 |
use / monitors only; may vanish.
|
|
1924 |
NOTICE: not all systems provide this information; on those that
|
|
1925 |
do not, true is returned for all pages."
|
85
|
1926 |
%{
|
|
1927 |
#ifdef HAS_MINCORE
|
|
1928 |
int pageSize = getpagesize();
|
|
1929 |
char result[10];
|
|
1930 |
INT addr;
|
|
1931 |
|
253
|
1932 |
if (__isSmallInteger(aPageNumber)) {
|
159
|
1933 |
addr = _intVal(aPageNumber) & ~(pageSize - 1);
|
85
|
1934 |
} else {
|
159
|
1935 |
addr = ((INT)aPageNumber) & ~(pageSize - 1);
|
85
|
1936 |
}
|
|
1937 |
if (mincore(addr, pageSize-1, result) < 0) {
|
159
|
1938 |
RETURN (true);
|
85
|
1939 |
}
|
|
1940 |
RETURN ((result[0] & 1) ? true : false);
|
|
1941 |
#endif
|
|
1942 |
%}.
|
|
1943 |
"OS does not supply this info - assume yes"
|
|
1944 |
^ true
|
|
1945 |
! !
|
|
1946 |
|
13
|
1947 |
!ObjectMemory class methodsFor:'low memory handling'!
|
|
1948 |
|
|
1949 |
memoryInterrupt
|
|
1950 |
"when a low-memory condition arises, ask all classes to
|
290
|
1951 |
remove possibly cached data. You may help the system a bit,
|
|
1952 |
in providing a lowSpaceCleanup method in your classes which have
|
|
1953 |
lots of data kept somewhere (usually, cached data).
|
|
1954 |
- this may or may not help."
|
13
|
1955 |
|
308
|
1956 |
Smalltalk allBehaviorsDo:[:aClass |
|
159
|
1957 |
aClass lowSpaceCleanup
|
13
|
1958 |
].
|
|
1959 |
|
178
|
1960 |
"/ self error:'almost out of memory'
|
|
1961 |
'almost out of memory' errorPrintNL.
|
|
1962 |
|
|
1963 |
LowSpaceSemaphore signalIf.
|
13
|
1964 |
! !
|
|
1965 |
|
1
|
1966 |
!ObjectMemory class methodsFor:'system management'!
|
|
1967 |
|
|
1968 |
loadClassBinary:aClassName
|
|
1969 |
"find the object file for aClassName and -if found - load it;
|
|
1970 |
this one loads precompiled object files"
|
|
1971 |
|
|
1972 |
|fName newClass upd|
|
|
1973 |
|
|
1974 |
fName := self fileNameForClass:aClassName.
|
|
1975 |
fName notNil ifTrue:[
|
202
|
1976 |
Class withoutUpdatingChangesDo:
|
159
|
1977 |
[
|
|
1978 |
self loadBinary:(fName , '.o')
|
|
1979 |
].
|
|
1980 |
newClass := self at:(aClassName asSymbol).
|
|
1981 |
(newClass notNil and:[newClass implements:#initialize]) ifTrue:[
|
|
1982 |
newClass initialize
|
|
1983 |
]
|
1
|
1984 |
]
|
|
1985 |
!
|
|
1986 |
|
77
|
1987 |
imageName
|
|
1988 |
"return the filename of the current image, or nil
|
|
1989 |
if not running from an image."
|
|
1990 |
|
|
1991 |
^ ImageName
|
159
|
1992 |
|
|
1993 |
"
|
202
|
1994 |
ObjectMemory imageName
|
|
1995 |
"
|
|
1996 |
!
|
|
1997 |
|
|
1998 |
imageBaseName
|
|
1999 |
"return a reasonable filename to use as baseName (i.e. without extension).
|
|
2000 |
This is the filename of the current image (without '.img') or,
|
|
2001 |
if not running from an image, the default name 'st'"
|
|
2002 |
|
|
2003 |
|nm|
|
|
2004 |
|
|
2005 |
nm := ImageName.
|
|
2006 |
(nm isNil or:[nm isBlank]) ifTrue:[
|
|
2007 |
^ 'st'
|
|
2008 |
].
|
|
2009 |
(nm endsWith:'.sav') ifTrue:[
|
|
2010 |
nm := nm copyTo:(nm size - 4)
|
|
2011 |
].
|
|
2012 |
(nm endsWith:'.img') ifTrue:[
|
|
2013 |
^ nm copyTo:(nm size - 4)
|
|
2014 |
].
|
|
2015 |
^ nm
|
|
2016 |
|
|
2017 |
"
|
|
2018 |
ObjectMemory imageBaseName
|
159
|
2019 |
"
|
77
|
2020 |
!
|
|
2021 |
|
22
|
2022 |
nameForSnapshot
|
159
|
2023 |
"return a reasonable filename to store the snapshot image into.
|
|
2024 |
This is the filename of the current image or,
|
22
|
2025 |
if not running from an image, the default name 'st.img'"
|
|
2026 |
|
202
|
2027 |
^ self imageBaseName , '.img'
|
|
2028 |
|
|
2029 |
"
|
|
2030 |
ObjectMemory nameForSnapshot
|
|
2031 |
"
|
|
2032 |
!
|
|
2033 |
|
|
2034 |
nameForSources
|
|
2035 |
"return a reasonable filename to store the sources into.
|
|
2036 |
This is the basename of the current image with '.img' replaced
|
|
2037 |
by '.src', or, if not running from an image, the default name 'st.src'"
|
|
2038 |
|
|
2039 |
^ self imageBaseName , '.src'
|
159
|
2040 |
|
|
2041 |
"
|
202
|
2042 |
ObjectMemory nameForSources
|
|
2043 |
"
|
|
2044 |
!
|
|
2045 |
|
|
2046 |
nameForChanges
|
|
2047 |
"return a reasonable filename to store the changes into.
|
|
2048 |
This is the basename of the current image with '.img' replaced
|
|
2049 |
by '.chg', or, if not running from an image, the default name 'st.chg'"
|
|
2050 |
|
|
2051 |
^ 'changes'.
|
|
2052 |
^ self imageBaseName , '.chg'
|
|
2053 |
|
|
2054 |
"
|
|
2055 |
ObjectMemory nameForChanges
|
159
|
2056 |
"
|
22
|
2057 |
!
|
|
2058 |
|
1
|
2059 |
snapShot
|
159
|
2060 |
"create a snapshot file containing all of the current state."
|
1
|
2061 |
|
22
|
2062 |
self snapShotOn:(self nameForSnapshot)
|
1
|
2063 |
|
159
|
2064 |
"
|
|
2065 |
ObjectMemory snapShot
|
|
2066 |
"
|
1
|
2067 |
!
|
|
2068 |
|
|
2069 |
snapShotOn:aFileName
|
|
2070 |
"create a snapshot in the given file"
|
|
2071 |
|
159
|
2072 |
|ok oldImageName|
|
|
2073 |
|
|
2074 |
"
|
|
2075 |
keep a save version - just in case something
|
|
2076 |
bad happens while writing the image.
|
|
2077 |
(could be st/x internal error or file-system errors etc)
|
|
2078 |
"
|
|
2079 |
(OperatingSystem isValidPath:aFileName) ifTrue:[
|
|
2080 |
OperatingSystem renameFile:aFileName to:(aFileName , '.sav').
|
|
2081 |
].
|
22
|
2082 |
|
93
|
2083 |
"
|
|
2084 |
give others a chance to fix things
|
|
2085 |
"
|
1
|
2086 |
self changed:#save.
|
13
|
2087 |
|
93
|
2088 |
"
|
|
2089 |
ST-80 compatibility; send #preSnapshot to all classes
|
|
2090 |
"
|
202
|
2091 |
Smalltalk allBehaviorsDo:[:aClass |
|
159
|
2092 |
aClass preSnapshot
|
93
|
2093 |
].
|
|
2094 |
|
159
|
2095 |
"
|
|
2096 |
save the name with it ...
|
|
2097 |
"
|
|
2098 |
oldImageName := ImageName.
|
|
2099 |
ImageName := aFileName.
|
|
2100 |
ok := self primSnapShotOn:aFileName.
|
|
2101 |
ImageName := oldImageName.
|
|
2102 |
|
|
2103 |
ok ifTrue:[
|
|
2104 |
Class addChangeRecordForSnapshot:aFileName.
|
|
2105 |
|
|
2106 |
|
|
2107 |
"
|
|
2108 |
ST-80 compatibility; send #postSnapshot to all classes
|
|
2109 |
"
|
202
|
2110 |
Smalltalk allBehaviorsDo:[:aClass |
|
159
|
2111 |
aClass postSnapshot
|
|
2112 |
].
|
|
2113 |
].
|
|
2114 |
^ ok
|
|
2115 |
|
|
2116 |
"
|
|
2117 |
ObjectMemory snapShotOn:'myimage.img'
|
|
2118 |
"
|
|
2119 |
!
|
|
2120 |
|
|
2121 |
primSnapShotOn:aFileName
|
|
2122 |
"create a snapshot in the given file.
|
|
2123 |
Low level entry. Does not notify classes or write an entry to
|
|
2124 |
the changes file. Also, no image backup is created. Returns true if
|
|
2125 |
the snapshot worked, false if it failed for some reason.
|
|
2126 |
This method should not be used in normal cases."
|
|
2127 |
|
|
2128 |
|ok|
|
|
2129 |
|
13
|
2130 |
%{ /* STACK:32000 */
|
|
2131 |
|
1
|
2132 |
OBJ __snapShotOn();
|
159
|
2133 |
OBJ funny = @symbol(funnySnapshotSymbol);
|
1
|
2134 |
|
56
|
2135 |
if (__isString(aFileName)) {
|
159
|
2136 |
BLOCKINTERRUPTS();
|
|
2137 |
ok = __snapShotOn(__context, _stringVal(aFileName), funny);
|
|
2138 |
UNBLOCKINTERRUPTS();
|
1
|
2139 |
}
|
159
|
2140 |
%}.
|
22
|
2141 |
^ ok
|
1
|
2142 |
!
|
|
2143 |
|
|
2144 |
applicationImageOn:aFileName for:startupClass selector:startupSelector
|
|
2145 |
"create a snapshot which will come up without any views
|
93
|
2146 |
but starts up an application by sending startupClass the startupSelector.
|
|
2147 |
EXPERIMENTAL and unfinished. Dont use this method."
|
1
|
2148 |
|
2
|
2149 |
|viewsKnown savedIdleBlocks savedTimeoutBlocks savedTranscript
|
|
2150 |
savedRoot|
|
1
|
2151 |
|
|
2152 |
viewsKnown := Display knownViews.
|
|
2153 |
savedIdleBlocks := Display idleBlocks.
|
|
2154 |
savedTimeoutBlocks := Display timeOutBlocks.
|
|
2155 |
savedTranscript := Transcript.
|
2
|
2156 |
savedRoot := RootView.
|
1
|
2157 |
|
10
|
2158 |
"a kludge: save image with modified knownViews, no idle- and timeoutblocks
|
|
2159 |
and also Transcript set to StdErr ..."
|
1
|
2160 |
|
|
2161 |
Display knownViews:nil.
|
|
2162 |
Display idleBlocks:nil.
|
|
2163 |
Display timeOutBlocks:nil.
|
2
|
2164 |
RootView := nil.
|
|
2165 |
|
1
|
2166 |
Transcript := Stderr.
|
10
|
2167 |
Smalltalk startupClass:startupClass selector:startupSelector arguments:nil.
|
1
|
2168 |
self snapShotOn:aFileName.
|
10
|
2169 |
Smalltalk startupClass:nil selector:nil arguments:nil.
|
1
|
2170 |
|
2
|
2171 |
RootView := savedRoot.
|
1
|
2172 |
Transcript := savedTranscript.
|
|
2173 |
Display knownViews:viewsKnown.
|
|
2174 |
Display idleBlocks:savedIdleBlocks.
|
|
2175 |
Display timeOutBlocks:savedTimeoutBlocks
|
|
2176 |
|
|
2177 |
"ObjectMemory applicationImageOn:'draw.img' for:DrawTool selector:#start"
|
|
2178 |
"ObjectMemory applicationImageOn:'pm.img' for:PMSimulator selector:#start"
|
|
2179 |
!
|
|
2180 |
|
|
2181 |
minimumApplicationImageOn:aFileName for:startupClass selector:startupSelector
|
|
2182 |
"create a snapshot which will come up without any views
|
|
2183 |
but starts up an application by sending startupClass the startupSelector.
|
93
|
2184 |
All unneeded info is stripped from the saved image.
|
|
2185 |
EXPERIMENTAL and unfinished. Dont use this method."
|
1
|
2186 |
|
|
2187 |
"create a temporary image, for continuation"
|
|
2188 |
self snapShotOn:'temp.img'.
|
|
2189 |
|
|
2190 |
Display knownViews do:[:aView |
|
159
|
2191 |
aView notNil ifTrue:[
|
|
2192 |
aView superView isNil ifTrue:[
|
|
2193 |
aView destroy
|
|
2194 |
]
|
|
2195 |
]
|
1
|
2196 |
].
|
|
2197 |
|
|
2198 |
self stripImage.
|
|
2199 |
|
|
2200 |
self applicationImageOn:aFileName for:startupClass selector:startupSelector.
|
|
2201 |
|
|
2202 |
"continue in old image"
|
|
2203 |
|
|
2204 |
OperatingSystem exec:(Arguments at:1)
|
159
|
2205 |
withArguments:#('smalltalk' '-i' 'temp.img') , (Arguments copyFrom:2)
|
1
|
2206 |
|
|
2207 |
"ObjectMemory minimumApplicationImageOn:'clock1.img' for:Clock selector:#start"
|
|
2208 |
"ObjectMemory applicationImageOn:'clock2.img' for:Clock selector:#start"
|
|
2209 |
!
|
|
2210 |
|
|
2211 |
stripImage
|
93
|
2212 |
"remove all unneeded stuff from the image - much more is possible here.
|
|
2213 |
EXPERIMENTAL and unfinished. Dont use this method."
|
1
|
2214 |
|
2
|
2215 |
"remove all class comments & source"
|
1
|
2216 |
|
2
|
2217 |
Smalltalk allBehaviorsDo:[:aClass |
|
159
|
2218 |
aClass setComment:nil.
|
|
2219 |
aClass methodArray do:[:aMethod |
|
|
2220 |
aMethod source:''.
|
|
2221 |
aMethod category:#none
|
|
2222 |
]
|
1
|
2223 |
].
|
|
2224 |
self garbageCollect
|
|
2225 |
! !
|