"
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
Object subclass:#ObjectMemory
instanceVariableNames:''
classVariableNames:'InternalErrorHandler UserInterruptHandler TimerInterruptHandler
SpyInterruptHandler StepInterruptHandler ExceptionInterruptHandler
ErrorInterruptHandler MemoryInterruptHandler SignalInterruptHandler
ChildSignalInterruptHandler DisposeInterruptHandler
RecursionInterruptHandler IOInterruptHandler
CustomInterruptHandler
AllocationFailureSignal LowSpaceSemaphore
IncrementalGCLimit FreeSpaceGCLimit
BackgroundCollectProcess BackgroundFinalizationProcess
FinalizationSemaphore
Dependents
ImageName'
poolDictionaries:''
category:'System-Support'
!
ObjectMemory comment:'
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.30 1995-03-08 23:38:52 claus Exp $
'!
!ObjectMemory class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
version
"
$Header: /cvs/stx/stx/libbasic/ObjectMemory.st,v 1.30 1995-03-08 23:38:52 claus Exp $
"
!
documentation
"
This class contains access methods to the system memory -
in previous versions this stuff used to be in the Smalltalk class.
It has been separated for better overall structure.
There are no instances of ObjectMemory - all is done in class methods.
Many methods here are for debuging purposes only, and not standard.
Do not depend on them being there - some may vanish ...
(especially those, that depend on a specific GC implementation)
Warning:
The InterruptHandler variables are known by the runtime system -
they are the objects that get an interrupt message when the event
occurs. You may not remove them.
Class variables:
InternalErrorHandler gets informed (by VM), when some runtime
error occurs (usually fatal)
UserInterruptHandler gets informed (by VM) when CNTL-C is pressed
TimerInterruptHandler gets alarm timer interrupts (from VM)
SpyInterruptHandler another alarm timer (from VM)
StepInterruptHandler gets single step interrupts (from VM)
ExceptionInterruptHandler gets floating point exceptions (from VM)
ErrorInterruptHandler gets graphic device errors (from VM)
MemoryInterruptHandler gets soon-out-of-memory conditions (from VM)
SignalInterruptHandler gets unix signals (from VM)
ChildSignalInterruptHandler gets child death signals (from VM)
DisposeInterruptHandler gets informed, when an object is disposed from
a shadowArray (from VM)
RecursionInterruptHandler gets recursion limit violations (from VM)
IOInterruptHandler gets SIGIO unix signals (from VM)
CustomInterruptHandler gets custom interrupts (from VM)
IncrementalGCLimit number of bytes, that must be allocated since
last full garbage collect to turn the incremental
collector on (at idle time).
FreeSpaceGCLimit low limit on freeSpace at which incremental
gc starts to run at idle time.
Dependents keep my dependents locally (its faster) for
all those registries
LowSpaceSemaphore a semaphore signalled whenever the system is
running in low memory (i.e. the memory manager
ran into memory shortage and feels that it
may soon be no longer grant allocation requests).
You can have a process waiting on this semaphore
which starts to remove (i.e. nil-out) objects
or preform other cleanup actions.
AllocationFailureSignal signal raised when a new fails (see Behavior)
When this signal is raised, the meomory manager
is really in trouble (i.e. above feelings where
correct)
BackgroundCollectProcess created by startBackgroundCollectorAt:
BackgroundFinalizationProcess created by startBackgroundFinalizationAt:
"
!
caching
"
The system uses various caches to speed up method-lookup.
Currently, there is a three-level cache hierarchy:
inline-cache keeps the target of the last send at the caller-
side (i.e. every send goes through its private
1-slot inline-cache, where the address of the last
called function at this call location is kept.)
polymorph-inline-cache keeps a limited list of all targets ever reached
at this call location. The list is automatically
flushed if it grows too large, or the overall number
of poly-chache entries exceeds a limit.
method-lookup-cache a global cache. Hashes on class-selector pairs,
returning the target method.
Whenever methods are added or removed from the system, or the inheritance
hierarchy changes, some or all caches have to be flushed.
The flushXXX methods perform the task of flushing various caches.
All standard methods in Behavior call for cache flushing, when things change;
however, if you use the low level access methods in Behavior
(for example: #setSuperclass:) special care has to be taken.
In some situations, not all caches need flushing, for example a change
in an interpreted method (currently) needs no flushing of the inline caches.
Also, flushing can be limited to entries for a specific class for most changes.
To be 'on the brigth side of live', use ObjectMemory>>flushCaches (which
flushes all of them), when in doubt of which caches should be flushed.
It is better flush too much - otherwise you may end up in a wrong method after
a send.
"
!
interrupts
"
Handling of interrupts (i.e. unix-signals) is done via handler objects, which
get a #XXXInterrupt-message sent. This is more flexible than (say) signalling
a semaphore, since the handler-object may do anything to react on the signal
(of course, it can also signal a semaphore to emulate the above behavior).
Another reason for having handler objects is that they allow interrupt handling
without any context switch, for high speed interrupt response.
However, special care is needed, since it is not defined, which process gets
the interrupt and will do the processing.
Typically, the handlers are set during early initialization of the system
by sending 'ObjectMemory XXXInterruptHandler:aHandler' and not changed later.
(see Smalltalk>>initialize or ProcessorScheduler>>initialize).
To setup your own handler, create some object which responds to #xxxInterrupt,
and make it the handler using the above method.
Interrupt messages sent to handlers are:
internalError:<someString> - internal interpreter/GC errors
userInterrupt - ^C interrupt
customInterrupt - custom interrupt
ioInterrupt - SIGIO interrupt
timerInterrupt - alarm timer (SIGALRM)
errorInterrupt - display error
spyInterrupt - spy timer interrupt (SIGVTALARM)
stepInterrupt - single step interrupt
disposeInterrupt - finalization required
recursionInterrupt - recursion (stack) overflow
memoryInterrupt - soon running out of memory
fpExceptionInterrupt - floating point exception (SIGFPE)
childSignalInterrupt - death of a child process (SIGCHILD)
signalInterrupt:<number> - unix signal (if other than above signals)
"
!
garbageCollection
"
Currently, Smalltalk/X uses a two-level memory hierachy.
Objects are created in a so-called newSpace, which is relatively small.
This newSpace is cleaned by a scavenge-operation, whenever becoming
full. Scavenging means, that all still-live objects (i.e. referenced by some
other) are copied over to another memory area, leaving all unreferenced
objects as garbage behind. After this copying, these two semispaces exchange their
roles - i.e. objects are copied ping-pong like between these semispaces.
Once an object survives enough of these copying operations, the next scavenge
will move it into the so called oldSpace, which is much larger, and not
processed by the scavenger.
This movement of an object from newSpace to oldSpace is called 'tenure'.
Scavenging occurs automatically, and is usually done fast enough to go
unnoticed (typically, it takes some 5 to 50ms to perform a scavenge,
depending on how many live objects are in the newspace).
Interrestingly, the scavenger performs better, if many garbage objects
are to be reclaimed, since less object-copying has to be done. Therefore,
the best-case scavenge time is almost zero, if there is only garbage in
the newSpace. In contrast, the worst-case is when all newSpace objects are still
living. To honor this situation, the system uses an adaptive tenure-count,
which adjusts the number of scavenges required for tenure (the so called
'tenureAge') according to the fill-grade of the newSpace.
To reclaim oldspace, the system uses three algorithms: mark&sweep, a copying
(and compressing) baker-type collector and an incremental mark&sweep.
The mark&sweep runs whenever the oldspace becomes full, putting dead objects
onto a free list. If a memory request cannot be served from this freelist,
and the total size of objects on the freelist exceeds a threshold, the system
will compress the oldspace to make the free-space into one big area.
This compress is done by copying all live objects into a newly allocated
area, and freeing the previous memory afterwards (baker collector).
Since a compressing oldspace collect leads to a noticable pause of the system,
the memory manager tries hard to avoid oldspace compression.
(actually, if enough real memory is available to hold both spaces in physical
memory, the compress is pretty fast).
The incremental mark&sweep runs in the background, whenever the system is idle
(see ProcessorSceduler>>waitForEventOrTimeout). Like the normal mark&sweep,
this incremental collector follows object references and marks reachable objects
on its way. This is done 'a few objects-at-a-time', to not disrupt the system
noticable.
Incremental collection is controlled by the variables 'IncrementalGCLimit' and
'FreeSpaceGCLimit':
the ProcessorScheduler will perform incremental GC steps at idle time,
if the total space allocated since the last full collect exceeds
IncrementalGCLimit,
or if there are less than 'FreeSpaceGCLimit' bytes available in free store.
The defaults are set in ObjectMemory>>initialize and can be changed in your
startup 'smalltalk.rc'-file. Setting them to nil will turn incremental GC off.
For example, setting IncrementalGCLimit to 500000 will start the background collector
whenever 500k bytes have been allocated - usually very seldom. Setting it to some
small number (say 10000) will have it run very often.
Setting FreeSpaceGCLimit to (say) 1mio lets the system try to always keep
1meg of freeSpace. If less memory is available, more oldSPace will be allocated
for. This may prevent the system from running into a GC pause when memory is
allocated in peaks (but only, if the incremental GC can keep up with allocation
rate).
Having the background GC running often should not hurt the performance of your
smalltalk processes, since the IGC only runs at idle times.
(there are some short delays in event processing, since the IGC's steps may take
some XX ms.)
However, if you are not alone on your machine (i.e. a timesharing system) or
you have other Unix processes to run, you should not run the IGC too often,
since it may hurt other users/unix processes.
Since this collector only runs at idle times, even a low priority background
process will prevent it from doing its work. You may want to start a somewhat
higher priority background collect (say at prio 4), which also preempts these
background processes. (see ObjectMemory>>startBackgroundCollectorAt:).
Beginning with 2.10.4, a third space, called fixSpace has been added.
Objects in this space are never moved or garbage collected.
This space is currently used for (some) symbols only, but additional constant
objects may be put into it in the future (true, false, some basic classes etc.).
A plan for 2.11 is to offer an arbitrary number of spaces, which can be
attached and detached at runtime. This will allow easy share of object
with remote systems and separating objects into a per application/package
space. (be prepared for changes in the future and make your application
independ of the VM internals)
hints & tricks:
normally, there is no need to call for an explicit garbage collection, or
modify the default parameters.
The memory system should adapt reasonable and provide good performance
for a wide range of allocation patterns (see Example3 below for an exception).
However, there may be situations, in which hints and/or explicit
control over allocation can speedup your programs; but please:
- if you think you have to play around with the memory policies,
first check your program - you may find useless allocations
or bad uses of collections. A typical error that is made is to
create large collections using the #, (comma) concatenation method,
which shows square behavior, since it allocates many, many temporary
collections. Also, watch out for #copyWith:, #add: etc.
All of these create a new collection. Remember, that most collections
offer methods to preallocate some space; for example, 'Set new:' creates
an empty set, but preallocates space to avoid resizing over and over.
An especially bad performace dog is to use #add: on fix-size collection
objects (such as Strings or Arrays), since in addition to allocating
lots of garbage, a #become: operation is required for EACH element
added. NEVER use Arrays for growing/shrinking data - use OrderedCollection
instead. (if you really need an array, use asArray afterwards)
- if you are going to allocate huge data structures, think about
optimizing space. For example, if you allocate a million instances of
some object, each added instance variable makes up 4Mb of additional
memory need.
Also, for Byte-valued, Integer-valued and Float like objects, special
collections are provided, which store their values directly inside (instead
of a reference to the object). A FloatArray consisting of 1 million floats
requires about 4mb of memory, while an Array of Floats requires 4mb for the
references to the floats, PLUS 20Mb for the floats themself.
- check if you really need fast access to all of these objects; you may
try to only keep some subset in memory, and use binary storage or
(if this is too slow) optimized store/retrieve methods and keep the bigger
part in a file.
(How about a DiskArray class, which does this transparent ?
See the FileText class for some ideas and something to start with ...)
Hint / Example 1:
you are about to allocate a huge data structure, which is known to
survive long. In this case, it is better to have these objects move into the
oldspace sooner, to avoid the copying overhead during scavenges.
To do this, you can call ObjectMemory>>tenure after allocation, which
forces all new-objects immediately into the oldspace.
Make certain, that not to many (ideally no) short-living objects are in the
newspace when doing this.
Another alternative is to tell the system that all allocation should be
done directly in the oldspace. This completely avoids the scavenging overhead
for these objects. To do so, use ObjectMemory>>turnGarbageCollectorOff
before the allocation, and ObjectMemory>>turnGarbageCollectorOn afterwards.
Keep in mind, that do-loops may allocate block-objects and other temporaries,
so there is a danger of making things worse due to having all those temporaries
in the oldspace afterwards. (which is not a fatal situation, but will
force the system to do an oldspace collect earlier, which may not be your
intention).
Hint / Example 2:
you know in advance, that a certain (big) amount of memory will be needed.
For example, the fileBrowser wants to show a huge file in its text-view.
In this case, it is better to tell the memory system in advance, how much
memory will be needed, since otherwise many compresses and reallocations will
occur (the memory system will allocate additional memory in chunks of smaller
256k pieces, if a compress failes. Thus, if you are going to allocate (say) 1Mb of
strings, it will perform 5 compressing GC's).
This is done using ObjectMemory>>moreOldSpace: or ObjectMemory announceSpaceNeed:.
In the above example, you would do 'ObjectMemory announceSpaceNeed:500000', which
avoids those annoying 5 compressing GC's.
BTW: if you have other smalltalk processes (threads) running which should not be
paused if possible, it is better to use #announceSpaceNeed. This tries to avoid
pausing in other processes and sometimes succeeds, while moreOldSpace will always
block the whole system for a while. However, there is no 'no-pause' guarantee.
The amount of automatic increase (in case the oldSpace becomes full) is 256k by
default. This number can be changed with ObjectMemory>>oldSpaceIncrement:.
Hint / Example3:
There are rare cases, when an explicit GC makes a difference: since
object finalization is done at GC time, objects which keep operatingSystem
resources may be finalized late. This is normally no problem, except if
the system is running out of resources. For example, allocating new colors
may fail if many colors have already been allocated in the past - even
though these colors are actually free. The Depth8Image calls for an
explicit GC, whenever it fails to allocate a color for a bitmap, to force
finalization of free, but not yet finalized colors.
Hint 4:
If you run in too small of physical memory, the incremental GC may have a
bad effect on your working set: since it touches pages (which may otherwise
not be needed at the moment, the operating system is forced to steal other
(possibly more useful) pages from your set of incore pages.
You may get better performance, if you turn off the incremental GC while
processing a big data structure.
Warning: many of the methods found here are not standard and may not even be available in
future versions of ST/X. Use them only in very special situations or experiments.
Let me know about additional special features you think are useful, and about
special features you are using - this provides the feedback required to decide
which methods are to be removed or kept or enhanced in future versions.
"
! !
!ObjectMemory class methodsFor:'initialization'!
initialize
"initialize the class"
AllocationFailureSignal isNil ifTrue:[
ErrorSignal isNil ifTrue:[super initialize].
AllocationFailureSignal := ErrorSignal newSignalMayProceed:true.
AllocationFailureSignal nameClass:self message:#allocationFailureSignal.
AllocationFailureSignal notifierString:'allocation failure'.
LowSpaceSemaphore := Semaphore new.
].
DisposeInterruptHandler := self.
IncrementalGCLimit := 500000.
FreeSpaceGCLimit := nil.
MemoryInterruptHandler := self
! !
!ObjectMemory class methodsFor:'signal access'!
allocationFailureSignal
"return the signal raised when an object allocation failed"
^ AllocationFailureSignal
! !
!ObjectMemory class methodsFor:'semaphore access'!
lowSpaceSemaphore
"return the semaphore that is signalled when the system detects a
low space condition. Usually, some time after this, an allocationFailure
will happen. You can have a cleanup process sitting in that semaphore and
start to release object."
^ LowSpaceSemaphore
! !
!ObjectMemory class methodsFor:'dependents access'!
dependents
"return the colleciton of my dependents"
^ Dependents
!
dependents:aCollection
"set the dependents collection"
Dependents := aCollection
!
dependentsDo:aBlock
"evaluate aBlock for all of my dependents.
Since this is performed at startup time (under the scheduler),
this is redefined here to catch abort signals.
Thus, if any error occurs in a #returnFromSnapshot,
the user can press abort to continue."
|deps|
deps := Dependents.
deps notNil ifTrue:[
deps do:[:each |
AbortSignal handle:[:ex |
ex return
] do:[
aBlock value:each
]
]
]
! !
!ObjectMemory class methodsFor:'cache management'!
flushInlineCachesForClass:aClass
"flush inlinecaches for calls to aClass."
%{ /* NOCONTEXT */
__flushInlineCachesFor(aClass);
%}
!
flushInlineCachesWithArgs:nargs
"flush inlinecaches for calls with nargs arguments"
%{ /* NOCONTEXT */
__flushInlineCaches(_intVal(nargs));
%}
!
flushInlineCachesFor:aClass withArgs:nargs
"flush inlinecaches for calls to aClass with nargs arguments"
%{ /* NOCONTEXT */
__flushInlineCachesForAndNargs(aClass, _intVal(nargs));
%}
!
flushInlineCaches
"flush all inlinecaches"
%{ /* NOCONTEXT */
__flushAllInlineCaches();
%}
!
flushMethodCacheFor:aClass
"flush the method cache for sends to aClass"
%{ /* NOCONTEXT */
__flushMethodCacheFor(aClass);
%}
!
flushMethodCache
"flush the method cache"
%{ /* NOCONTEXT */
__flushMethodCache();
%}
!
flushCachesFor:aClass
"flush method and inline caches for aClass"
%{ /* NOCONTEXT */
__flushMethodCacheFor(aClass);
__flushInlineCachesFor(aClass);
%}
!
flushCaches
"flush method and inline caches for all classes"
%{ /* NOCONTEXT */
__flushMethodCache();
__flushAllInlineCaches();
%}
! !
!ObjectMemory class methodsFor:'enumerating'!
allObjectsDo:aBlock
"evaluate the argument, aBlock for all objects in the system.
There is one caveat: if a compressing oldSpace collect
occurs while looping over the objects, the loop cannot be
continued (for some internal reasons). In this case, false
is returned."
|work|
%{ /* NOREGISTER - work may not be placed into a register here */
nonTenuringScavenge(__context);
/*
* allObjectsDo needs a temporary to hold newSpace objects
*/
if (__allObjectsDo(&aBlock, &work COMMA_CON) < 0) {
RETURN (false);
}
%}.
^ true
!
allOldObjectsDo:aBlock
"evaluate the argument, aBlock for all old objects in the system.
For debugging and tests only - do not use"
%{
if (__allObjectsDo(&aBlock, (OBJ *)0 COMMA_CON) < 0) {
RETURN (false);
}
%}.
^ true
! !
!ObjectMemory class methodsFor:'interrupt handler access'!
internalErrorHandler
"return the handler for ST/X internal errors.
An internal error is reported for example when a methods
bytecode is not a ByteArray, the selector table is not an Array
etc.
Those should not occur in normal circumstances."
^ InternalErrorHandler
!
userInterruptHandler
"return the handler for CNTL-C interrupt handling"
^ UserInterruptHandler
!
userInterruptHandler:aHandler
"set the handler for CNTL-C interrupt handling"
UserInterruptHandler := aHandler
!
timerInterruptHandler
"return the handler for timer interrupts"
^ TimerInterruptHandler
!
timerInterruptHandler:aHandler
"set the handler for timer interrupts"
TimerInterruptHandler := aHandler
!
spyInterruptHandler
"return the handler for spy-timer interrupts"
^ SpyInterruptHandler
!
spyInterruptHandler:aHandler
"set the handler for spy-timer interrupts"
SpyInterruptHandler := aHandler
!
stepInterruptHandler
"return the handler for single step interrupts"
^ StepInterruptHandler
!
stepInterruptHandler:aHandler
"set the handler for single step interrupts"
StepInterruptHandler := aHandler
!
exceptionInterruptHandler
"return the handler for floating point exception interrupts"
^ ExceptionInterruptHandler
!
errorInterruptHandler
"return the handler for display error interrupts"
^ ErrorInterruptHandler
!
errorInterruptHandler:aHandler
"set the handler for display error interrupts"
ErrorInterruptHandler := aHandler
!
signalInterruptHandler
"return the handler for UNIX-signal interrupts"
^ SignalInterruptHandler
!
signalInterruptHandler:aHandler
"set the handler for UNIX-signal interrupts"
SignalInterruptHandler := aHandler
!
childSignalInterruptHandler
"return the handler for UNIX-death-of-a-childprocess-signal interrupts"
^ ChildSignalInterruptHandler
!
disposeInterruptHandler
"return the handler for object disposal interrupts"
^ DisposeInterruptHandler
!
disposeInterruptHandler:aHandler
"set the handler for object disposal interrupts"
DisposeInterruptHandler := aHandler
!
recursionInterruptHandler
"return the handler for recursion/stack overflow interrupts"
^ RecursionInterruptHandler
!
recursionInterruptHandler:aHandler
"set the handler for recursion/stack overflow interrupts"
RecursionInterruptHandler := aHandler
!
ioInterruptHandler
"return the handler for I/O available signal interrupts (SIGIO/SIGPOLL)"
^ IOInterruptHandler
!
ioInterruptHandler:aHandler
"set the handler for I/O available signal interrupts (SIGIO/SIGPOLL)"
IOInterruptHandler := aHandler
!
customInterruptHandler
"return the handler for custom interrupts"
^ CustomInterruptHandler
!
customInterruptHandler:aHandler
"set the handler for custom interrupts"
CustomInterruptHandler := aHandler
! !
!ObjectMemory class methodsFor:'queries'!
newSpaceSize
"return the total size of the new space - this is usually fix"
%{ /* NOCONTEXT */
extern unsigned __newSpaceSize();
RETURN ( _MKSMALLINT(__newSpaceSize()) );
%}
"
ObjectMemory newSpaceSize
"
!
oldSpaceSize
"return the total size of the old space. - may grow slowly"
%{ /* NOCONTEXT */
extern unsigned __oldSpaceSize();
RETURN ( _MKSMALLINT(__oldSpaceSize()) );
%}
"
ObjectMemory oldSpaceSize
"
!
fixSpaceSize
"return the total size of the fix space."
%{ /* NOCONTEXT */
extern unsigned __fixSpaceSize();
RETURN ( _MKSMALLINT(__fixSpaceSize()) );
%}
"
ObjectMemory fixSpaceSize
"
!
newSpaceUsed
"return the number of bytes allocated for new objects.
The returned value is usually obsolete as soon as you do
something with it ..."
%{ /* NOCONTEXT */
extern unsigned __newSpaceUsed();
RETURN ( _MKSMALLINT(__newSpaceUsed()) );
%}
"
ObjectMemory newSpaceUsed
"
!
oldSpaceUsed
"return the number of bytes allocated for old objects.
(This includes the free lists)"
%{ /* NOCONTEXT */
extern unsigned __oldSpaceUsed();
RETURN ( _MKSMALLINT(__oldSpaceUsed()) );
%}
"
ObjectMemory oldSpaceUsed
"
!
fixSpaceUsed
"return the number of bytes allocated for old objects in fix space."
%{ /* NOCONTEXT */
extern unsigned __fixSpaceUsed();
RETURN ( _MKSMALLINT(__fixSpaceUsed()) );
%}
"
ObjectMemory fixSpaceUsed
"
!
freeSpace
"return the number of bytes in the compact free area.
(oldSpaceUsed + freeSpaceSize = oldSpaceSize)"
%{ /* NOCONTEXT */
extern unsigned __oldSpaceSize(), __oldSpaceUsed();
RETURN ( _MKSMALLINT(__oldSpaceSize() - __oldSpaceUsed()) );
%}
"
ObjectMemory freeSpace
"
!
freeListSpace
"return the number of bytes in the free lists.
(which is included in oldSpaceUsed)"
%{ /* NOCONTEXT */
extern unsigned __freeListSpace();
RETURN ( _MKSMALLINT(__freeListSpace()) );
%}
"
ObjectMemory freeListSpace
"
!
bytesUsed
"return the number of bytes allocated for objects -
this number is not exact, since some objects may already be dead
(i.e. not yet reclaimed by the garbage collector).
If you need the exact number, you have to loop over all
objects and ask for the bytesize using ObjectMemory>>sizeOf:."
%{ /* NOCONTEXT */
extern unsigned __oldSpaceUsed(), __newSpaceUsed(), __freeListSpace();
RETURN ( _MKSMALLINT(__oldSpaceUsed() + __newSpaceUsed() - __freeListSpace()) );
%}
"
ObjectMemory bytesUsed
"
!
oldSpaceAllocatedSinceLastGC
"return the number of bytes allocated for old objects since the
last oldspace garbage collect occured. This information is used
by ProcessorScheduler to decide when to start the incremental
background GC."
%{ /* NOCONTEXT */
extern unsigned __oldSpaceAllocatedSinceLastGC();
RETURN ( _MKSMALLINT(__oldSpaceAllocatedSinceLastGC()) );
%}
"
ObjectMemory oldSpaceAllocatedSinceLastGC
"
!
tenureAge
"return the current tenure age - thats the number of times
an object has to survive scavenges to be moved into oldSpace.
For statistic/debugging only - this method may vanish"
%{ /* NOCONTEXT */
extern unsigned __tenureAge();
RETURN ( _MKSMALLINT(__tenureAge()) );
%}
!
lastScavangeReclamation
"returns the number of bytes replacimed by the last scavenge.
For statistic only - this may vanish."
%{ /* NOCONTEXT */
extern int __newSpaceReclaimed();
RETURN ( _MKSMALLINT(__newSpaceReclaimed()) );
%}
"percentage of reclaimed objects is returned by:
((ObjectMemory lastScavangeReclamation)
/ (ObjectMemory newSpaceSize)) * 100.0
"
!
runsSingleOldSpace
"return true, if the system runs in a single oldSpace or
false, if it has given up baker-collection. The memory
system will always drop the second semispace when running out of
virtual memory, or the baker-limit is reached.
OBSOLETE:
the system may now decide at any time to switch between
single and double-space algorithms, depending on the overall memory
size. You will now almost always get false as result, since the
second semispaces are only allocated when needed, and released
afterwards.
"
%{ /* NOCONTEXT */
extern char *collectedOldStartPtr;
RETURN ( ((collectedOldStartPtr == (char *)0) ? true : false) );
%}
"
ObjectMemory runsSingleOldSpace
"
!
incrementalGCPhase
"returns the internal state of the incremental GC.
The meaning of those numbers is a secret :-).
This is for debugging and monitoring only - and may vanish"
%{ /* NOCONTEXT */
extern int __incrGCphase();
RETURN (_MKSMALLINT(__incrGCphase()));
%}
!
scavengeCount
"return the number of scavenges that occurred since startup"
%{ /* NOCONTEXT */
extern int __scavengeCount();
RETURN (_MKSMALLINT(__scavengeCount()));
%}
"
ObjectMemory scavengeCount
"
!
markAndSweepCount
"return the number of mark&sweep collects that occurred since startup"
%{ /* NOCONTEXT */
extern int __markAndSweepCount();
RETURN (_MKSMALLINT(__markAndSweepCount()));
%}
"
ObjectMemory markAndSweepCount
"
!
garbageCollectCount
"return the number of compressing collects that occurred since startup"
%{ /* NOCONTEXT */
extern int __garbageCollectCount();
RETURN (_MKSMALLINT(__garbageCollectCount()));
%}
"
ObjectMemory garbageCollectCount
"
!
numberOfObjects
"return the number of objects in the system."
|tally|
tally := 0.
self allObjectsDo:[:obj | tally := tally + 1].
^ tally
"
ObjectMemory numberOfObjects
"
!
printReferences:anObject
"for debugging: print referents to anObject.
WARNING:
this method will vanish;
use ObjectMemory>>whoReferences: or anObject>>allOwners."
%{
_printRefChain(__context, anObject);
%}
!
collectObjectsWhich:aBlock
"helper for the whoReferences queries. Returns a collection
of objects for which aBlock returns true."
|aCollection|
aCollection := IdentitySet new.
self allObjectsDo:[:o |
(aBlock value:o) ifTrue:[
aCollection add:o
]
].
(aCollection size == 0) ifTrue:[
"actually this cannot happen - there is always one"
^ nil
].
^ aCollection
!
whoReferences:anObject
"return a collection of objects referencing the argument, anObject"
^ self collectObjectsWhich:[:o | o references:anObject]
"
(ObjectMemory whoReferences:Transcript) printNL
"
!
whoReferencesInstancesOf:aClass
"return a collection of objects refering to instances
of the argument, aClass"
^ self collectObjectsWhich:[:o | o referencesInstanceOf:aClass]
"
(ObjectMemory whoReferencesInstancesOf:SystemBrowser) printNL
"
!
whoReferencesDerivedInstancesOf:aClass
"return a collection of objects refering to instances
of the argument, aClass or a subclass of it."
^ self collectObjectsWhich:[:o | o referencesDerivedInstanceOf:aClass]
"
(ObjectMemory whoReferencesDerivedInstancesOf:View) printNL
"
!
addressOf:anObject
"return the core address of anObject as an integer
- since objects may move around, the returned value is invalid after the
next scavenge/collect.
Use only for debugging."
%{ /* NOCONTEXT */
if (! _isNonNilObject(anObject)) {
RETURN ( nil );
}
RETURN ( _MKSMALLINT( (int)anObject ) );
%}
"
|p|
p := Point new.
(ObjectMemory addressOf:p) printNL.
ObjectMemory scavenge.
(ObjectMemory addressOf:p) printNL.
"
!
objectAt:anAddress
"return whatever anAddress points to as object.
BIG BIG DANGER ALERT:
this method is only to be used for debugging
ST/X itself - you can easily (and badly) crash the system.
This method will be removed from the final shipping version"
|low high|
low := anAddress bitAnd:16rFFFF.
high := (anAddress bitShift:16) bitAnd:16rFFFF.
%{
if (__bothSmallInteger(low, high)) {
RETURN ((OBJ)((_intVal(high) << 16) | _intVal(low)));
}
%}
!
sizeOf:anObject
"return the size of anObject in bytes.
Use only for debugging/memory monitoring."
%{ /* NOCONTEXT */
RETURN ( _isNonNilObject(anObject) ? _MKSMALLINT(_qSize(anObject)) : _MKSMALLINT(0) )
%}
"
|hist big nw|
hist := Array new:100 withAll:0.
big := 0.
ObjectMemory allObjectsDo:[:o |
nw := (ObjectMemory sizeOf:o) // 4 + 1.
nw > 100 ifTrue:[
big := big + 1
] ifFalse:[
hist at:nw put:(hist at:nw) + 1
].
].
hist printNL.
big printNL
"
!
spaceOf:anObject
"return the memory space, in which anObject is.
- since objects may move between spaces, returned value is invalid after the
next scavenge/collect.
For debugging only; Dont use this method; it may vanish."
%{ /* NOCONTEXT */
if (! _isNonNilObject(anObject)) {
RETURN ( nil );
}
RETURN ( _MKSMALLINT( _qSpace(anObject) ) );
%}
!
flagsOf:anObject
"For debugging only; Dont use this method; it may vanish."
%{ /* NOCONTEXT */
if (! _isNonNilObject(anObject)) {
RETURN ( nil );
}
RETURN ( _MKSMALLINT( anObject->o_flags ) );
%}
"
F_ISREMEMBERED 1 /* a new-space thing being refd by some oldSpace thing */
F_ISFORWARDED 2 /* a forwarded object (you will never see this here) */
F_DEREFERENCED 4 /* a collection after grow (not currently used) */
F_ISONLIFOLIST 8 /* a non-lifo-context-referencing-obj already on list */
F_MARK 16 /* mark bit for background collector */
"
!
ageOf:anObject
"return the number of scavenges, an object has survived
in new space. For old objects and living contexts, the returned number
is invalid.
For debugging only; Dont use this method; it may vanish."
%{ /* NOCONTEXT */
if (! _isNonNilObject(anObject)) {
RETURN ( 0 );
}
RETURN ( _MKSMALLINT( _GET_AGE(anObject) ) );
%}
"
|p|
p := Point new.
(ObjectMemory ageOf:p) printNL.
ObjectMemory tenuringScavenge.
(ObjectMemory spaceOf:p) printNL.
ObjectMemory tenuringScavenge.
(ObjectMemory spaceOf:p) printNL.
ObjectMemory tenuringScavenge.
(ObjectMemory spaceOf:p) printNL.
ObjectMemory tenuringScavenge.
(ObjectMemory spaceOf:p) printNL.
"
! !
!ObjectMemory class methodsFor:'garbage collection'!
scavenge
"collect young objects, without aging (i.e. no tenure).
Can be used to quickly get rid of shortly before allocated
stuff. This is relatively fast (compared to oldspace collect).
An example where a non-tenuring scavenge makes sense is when
allocating some OperatingSystem resource (a Color, File or View)
and the OS runs out of resources. In this case, the scavenge may
free some ST-objects and therefore (by signalling the WeakArrays
or Registries) free the OS resources too.
Of course, only recently allocated resources will be freed this
way. If none was freed, a full collect will be needed."
%{
nonTenuringScavenge(__context);
%}
"
ObjectMemory scavenge
"
!
tenuringScavenge
"collect newspace stuff, with aging (i.e. objects old enough
will be moved into the oldSpace).
Use this for debugging and testing only - the system performs
this automatically when the newspace fills up.
This is relatively fast (compared to oldspace collect)"
%{
scavenge(__context);
%}
"
ObjectMemory tenuringScavenge
"
!
tenure
"force all living new stuff into old-space - effectively making
all living young objects become old objects.
This is relatively fast (compared to oldspace collect).
This method should only be used in very special situations:
for example, when building up some long-living data structure
in a time critical application.
To do so, you have to do a scavenge followed by a tenure after the
objects are created. Be careful, to not reference any other chunk-
data when calling for a tenure (this will lead to lots of garbage in
the oldspace).
In normal situations, explicit tenures are not needed."
%{
tenure(__context);
%}
"
ObjectMemory tenure
"
"
... build up long living objects ...
ObjectMemory scavenge.
ObjectMemory tenure
... continue - objects created above are now in oldSpace ...
"
!
garbageCollect
"search for and free garbage in the oldSpace (newSpace is cleaned automatically)
performing a COMPRESSING garbage collect.
This can take a long time - especially, if paging is involved
(when no paging is involved, its faster than I thought :-).
If no memory is available for the compress, or the system has been started with
the -Msingle option, this does a non-COMPRESSING collect."
%{
if (! __garbageCollect(__context)) {
markAndSweep(__context);
}
%}
"
ObjectMemory garbageCollect
"
!
reclaimSymbols
"reclaim unused symbols;
Unused symbols are (currently) not reclaimed automatically,
but only upon request with this method. It takes some time
to do this ...
Future versions may do this automatically, while garbage collecting."
%{
__reclaimSymbols(__context);
%}
"
ObjectMemory reclaimSymbols
"
!
markAndSweep
"mark/sweep garbage collector.
perform a full mark&sweep collect.
Warning: this may take some time."
%{
markAndSweep(__context);
%}
"
ObjectMemory markAndSweep
"
!
gcStep
"one incremental garbage collect step.
Mark or sweep some small number of objects. This
method will return after a reasonable (short) time.
This is used by the ProcessorScheduler at idle times.
Returns true, if an incremental GC cycle has finished."
%{
extern int __incrGCstep();
RETURN (__incrGCstep(__context) ? true : false);
%}
!
incrementalGC
"perform one round of incremental GC steps.
The overall effect of this method is the same as calling markAndSweep.
However, #incrementalGC is interruptable while #markAndSweep
blocks for a while. Thus this method can be called from a low
prio (background) process to collect without disturbing
foreground processes too much.
For example, someone allocating huge amounts of memory could
ask for the possibility of a quick allocation using
#checkForFastNew: and try a #incrementalGC if not. In many
cases, this can avoid a pause (in the higher prio processes) due to
a blocking GC."
[self gcStep] whileFalse:[]
"
ObjectMemory incrementalGC
"
!
gcStepIfUseful
"If either the IncrementalGCLimit or the FreeSpaceGCLimits have been
reached, perform one incremental garbage collect step.
Return true, if more gcSteps are required to finish the cycle,
false if done with a gc round.
If no limit has been reached yet, do nothing and return false.
This is called by the ProcessorScheduler at idle times."
|done limit free|
limit := IncrementalGCLimit.
(limit notNil and:[self oldSpaceAllocatedSinceLastGC > limit]) ifTrue:[
^ ObjectMemory gcStep not
].
limit := FreeSpaceGCLimit.
(limit notNil and:[(self freeSpace + self freeListSpace) < limit]) ifTrue:[
done := ObjectMemory gcStep.
done ifTrue:[
"/
"/ finished with this cycle;
"/ if reclaimed space is below limit, we have to allocate more
"/ oldSpace, to avoid excessive gcSteps (due to freeSpaceLimit
"/ still not reached)
"/
free := self freeSpace + self freeListSpace.
free < limit ifTrue:[
self moreOldSpace:(limit - free + (64*1024))
].
^ false
].
^ true
].
^ false
!
verboseGarbageCollect
"perform a compessing garbage collect and show some informational
output on the Transcript"
|nBytesBefore nReclaimed|
nBytesBefore := self oldSpaceUsed.
self garbageCollect.
nReclaimed := nBytesBefore - self oldSpaceUsed.
nReclaimed > 0 ifTrue:[
Transcript show:'reclaimed '.
nReclaimed > 1024 ifTrue:[
nReclaimed > (1024 * 1024) ifTrue:[
Transcript show:(nReclaimed // (1024 * 1024)) printString.
Transcript showCr:' Mb.'
] ifFalse:[
Transcript show:(nReclaimed // 1024) printString.
Transcript showCr:' Kb.'
]
] ifFalse:[
Transcript show:nReclaimed printString.
Transcript showCr:' bytes.'
]
]
"
ObjectMemory verboseGarbageCollect
"
!
startBackgroundCollectorAt:aPriority
"start a process doing incremental GC in the background.
Use this, if you have suspendable background processes which
run all the time, and therefore would prevent the idle-collector
from running. See documentation in this class for more details."
|p|
"/
"/ its not useful, to run it more than once
"/
BackgroundCollectProcess notNil ifTrue:[
BackgroundCollectProcess priority:aPriority.
^ self
].
p :=
[
[
[true] whileTrue:[
self gcStepIfUseful ifTrue:[
"
perform a full cycle
"
self incrementalGC
].
"
wait a bit
"
(Delay forSeconds:5) wait
]
] valueOnUnwindDo:[
BackgroundCollectProcess := nil
]
] newProcess.
p name:'background collector'.
p priority:aPriority.
p resume.
BackgroundCollectProcess := p
"
the following lets the backgroundCollector run at prio 5
whenever 100000 bytes have been allocated, OR freeSpace drops
below 1meg. Having the system keep 1meg as reserve for peak allocation.
Doing this may reduce pauses due to inevitable collects when running
out of freeSpace, if the collector can keep up with allocation rate.
"
"
ObjectMemory incrementalGCLimit:100000.
ObjectMemory freeSpaceGCLimit:1000000.
ObjectMemory startBackgroundCollectorAt:5
"
!
stopBackgroundCollector
"stop the background collector"
BackgroundCollectProcess notNil ifTrue:[
BackgroundCollectProcess terminate.
BackgroundCollectProcess := nil
]
"
ObjectMemory stopBackgroundCollector
"
! !
!ObjectMemory class methodsFor:'garbage collector control'!
freeSpaceGCLimit:aNumber
"set the freeSpace limit for incremental GC activation.
The system will start doing incremental background GC, once less than this number
of bytes are available in the compact free space.
The default is nil; setting it to nil will turn this trigger off.
This is EXPERIMENTAL; dont set it to non-nil, since it may lead to
a looping collect if after the IGC, the freeSpace does not climb above
the limit."
FreeSpaceGCLimit := aNumber
"
the following will try to always keep at least 1meg of free space
(in the background)
"
"
ObjectMemory freeSpaceGCLimit:1000000.
"
"
turn it off (i.e. let the system hit the wall ...)
"
"
ObjectMemory freeSpaceGCLimit:nil.
"
!
freeSpaceGCLimit
"return the freeSpace limit for incremental GC activation.
The system will start doing incremental background GC, once less than this number
of bytes are available in the compact free space.
The default is 100000; setting it to nil will turn this trigger off."
^ FreeSpaceGCLimit
"
ObjectMemory freeSpaceGCLimit
"
!
incrementalGCLimit:aNumber
"set the allocatedSinceLastGC limit for incremental GC activation.
The system will start doing incremental background GC, once more than this number
of bytes have been allocated since the last GC.
The default is 500000; setting it to nil will turn this trigger off."
IncrementalGCLimit := aNumber
"
ObjectMemory incrementalGCLimit:500000. 'do incr. GC very seldom'
ObjectMemory incrementalGCLimit:100000. 'medium'
ObjectMemory incrementalGCLimit:10000. 'do incr. GC very often'
ObjectMemory incrementalGCLimit:nil. 'never'
"
!
incrementalGCLimit
"return the allocatedSinceLastGC limit for incremental GC activation.
The system will start doing incremental background GC, once more than this number
of bytes have been allocated since the last GC.
The default is 500000; setting it to nil will turn this trigger off."
^ IncrementalGCLimit
"
ObjectMemory incrementalGCLimit
"
!
moreOldSpace:howMuch
"allocate howMuch bytes more for old objects.
This is done automatically, when running out of space, but makes
sense, if its known in advance that a lot of memory is needed to
avoid multiple reallocations and compresses.
This (currently) implies a compressing garbage collect - so its slow.
Notice: this is a nonstandard interface - use only in special situations."
%{
if (__isSmallInteger(howMuch))
__moreOldSpace(__context, _intVal(howMuch));
%}
"
ObjectMemory moreOldSpace:1000000
"
!
announceSpaceNeed:howMuch
"announce to the memory system, that howMuch bytes of memory will be needed
soon. The VM tries to prepare itself for this allocation to be performed
with less overhead. For example, it could preallocate some memory in one
big chunk (instead of doing many smaller reallocations later).
Notice: this is a nonstandard interface - use only in special situations.
Also, this does a background collect before the big chunk of memory is
allocated, not locking other processes while doing so."
(howMuch < (self newSpaceSize // 2)) ifTrue:[
self scavenge.
].
(self checkForFastNew:howMuch) ifFalse:[
(howMuch > (self newSpaceSize // 2)) ifFalse:[
self scavenge.
].
self incrementalGC.
(self checkForFastNew:howMuch) ifFalse:[
self moreOldSpace:howMuch
]
]
"
ObjectMemory announceSpaceNeed:100000
"
!
announceOldSpaceNeed:howMuch
"announce to the memory system, that howMuch bytes of memory will be needed
soon, which is going to live longer (whatever that means).
It first checks if the memory can be allocated without forcing a compressing
GC. If not, the oldSpace is increased. This may also lead to a slow compressing
collect. However, many smaller increases are avoided afterwards. Calling this
method before allocating huge chunks of data may provide better overall performance.
Notice: this is a nonstandard interface - use only in special situations."
(self checkForFastNew:howMuch) ifFalse:[
self incrementalGC.
(self checkForFastNew:howMuch) ifFalse:[
self moreOldSpace:howMuch
]
]
"
ObjectMemory announceOldSpaceNeed:1000000
"
!
oldSpaceIncrement
"return the oldSpaceIncrement value. Thats the amount by which
more memory is allocated in case the oldSpace gets filled up.
In normal situations, the default value used in the VM is fine
and there is no need to change it."
%{ /* NOCONTEXT */
extern unsigned __oldSpaceIncrement();
RETURN (_MKSMALLINT( __oldSpaceIncrement(-1) ));
%}
"
ObjectMemory oldSpaceIncrement
"
!
oldSpaceIncrement:amount
"set the oldSpaceIncrement value. Thats the amount by which
more memory is allocated in case the oldSpace gets filled up.
In normal situations, the default value used in the VM is fine
and there is no need to change it. This method returns the
previous increment value."
%{ /* NOCONTEXT */
extern unsigned __oldSpaceIncrement();
if (__isSmallInteger(amount)) {
RETURN (_MKSMALLINT( __oldSpaceIncrement(_intVal(amount)) ));
}
%}
"to change increment to 1Meg:"
"
ObjectMemory oldSpaceIncrement:1024*1024
"
!
fastMoreOldSpaceAllocation:aBoolean
"this method turns on/off fastMoreOldSpace allocation.
By default, this is turned off (false), which means that in case of
a filled-up oldSpace, a GC is tried first before more oldSpace is allocated.
This strategy is ok for the normal operation of the system,
but behaves badly, if the program allocates huge data structures (say a
game tree of 30Mb in size) which survives and therefore will not be reclaimed
by a GC.
Of course while building this tree, and the memory becomes full, the system
would not know in advance, that the GC will not reclaim anything.
Setting fastOldSpaceIncrement to true will avoid this, by forcing the
memory system to allocate more memory right away, without doing a GC first.
WARNING: make certain that this flag is turned off, after your huge data
is allocated, since otherwise the system may continue to increase its
virtual memory without ever checking for garbage.
This method returns the previous value of the flag."
%{ /* NOCONTEXT */
RETURN (__fastMoreOldSpaceAllocation(aBoolean == true ? 1 : 0) ? true : false);
%}
!
checkForFastNew:amount
"this method returns true, if amount bytes could be allocated
quickly (i.e. without forcing a full GC or compress).
This can be used for smart background processes, which want to
allocate big chunks of data without disturbing foreground processes
too much. Such a process would check for fast-allocation, and perform
incremental GC-steps if required. Thus, avoiding the long blocking pause
due to a forced (non-incremental) GC. Especially: doing so will not block
higher priority foreground processes.
This is experimental and not guaranteed to be in future versions."
%{ /* NOCONTEXT */
extern __checkForFastNew();
if (__isSmallInteger(amount)) {
if (! __checkForFastNew(_intVal(amount))) {
RETURN (false);
}
}
%}.
^ true
!
turnGarbageCollectorOff
"turn off garbage collector by forcing new objects to be
allocated in oldSpace (instead of newSpace)
WARNING:
This is somewhat dangerous: if collector is turned off,
and too many objects are created, the system may run into trouble
(i.e. oldSpace becomes full) and be forced to perform a full mark&sweep
or even a compressing collect - making the overall realtime behavior worse.
Use this only for special purposes or when realtime behavior
is required for a limited time period."
%{ /* NOCONTEXT */
__allocForceSpace(OLDSPACE);
%}
!
turnGarbageCollectorOn
"turn garbage collector on again (see ObjectMemory>>turnGarbageCollectorOff)"
%{ /* NOCONTEXT */
__allocForceSpace(9999);
%}
!
makeOld:anObject
"move anObject into oldSpace.
This method is for internal & debugging purposes only -
it may vanish. Dont use it."
%{
if (__moveToOldSpace(anObject, __context) < 0) {
RETURN (false);
}
%}.
^ true
!
tenureParameters:magic
"this is pure magic and not for public eyes ...
This method allows fine tuning the scavenger internals,
in cooperation to some statistic & test programs.
It is undocumented, secret and may vanish.
If you play around here, the system may behave very strange."
%{ /* NOCONTEXT */
__tenureParams(magic);
%}.
! !
!ObjectMemory class methodsFor:'object finalization'!
allShadowObjectsDo:aBlock
"evaluate the argument, aBlock for all known shadow objects"
%{
__allShadowObjectsDo(&aBlock, __context);
%}
!
allChangedShadowObjectsDo:aBlock
"evaluate the argument, aBlock for all known shadow objects which have
lost a pointer recently."
%{
__allChangedShadowObjectsDo(&aBlock, __context);
%}
!
finalize
"tell all weak objects that something happened."
self allChangedShadowObjectsDo:[:aShadowArray |
aShadowArray lostPointer.
]
!
disposeInterrupt
"this is triggered by the garbage collector,
whenever any shadowArray looses a pointer."
FinalizationSemaphore notNil ifTrue:[
"/
"/ background finalizer is waiting ...
"/
FinalizationSemaphore signal
] ifFalse:[
"/
"/ do it right here
"/
self finalize
]
!
startBackgroundFinalizationAt:aPriority
"start a process doing finalization work in the background.
Can be used to reduce the pauses created by finalization.
Normally, these pauses are not noticed; however if you have (say)
ten thousands of weak objects, these could become long enough to
make background finalization usefull.
WARNING: background finalization may lead to much delayed freeing of
system resources. Especially, you may temporarily run out of free
color table entries or fileDescriptors etc. Use at your own risk (if at all)"
|p|
"/
"/ its not useful, to run it more than once
"/
BackgroundFinalizationProcess notNil ifTrue:[
BackgroundFinalizationProcess priority:aPriority.
^ self
].
FinalizationSemaphore := Semaphore new.
p :=
[
[
[true] whileTrue:[
"
wait till something to do ...
"
FinalizationSemaphore wait.
"
... and do it
"
self finalize
]
] valueOnUnwindDo:[
BackgroundFinalizationProcess := nil.
FinalizationSemaphore := nil
]
] newProcess.
p name:'background finalizer'.
p priority:aPriority.
p resume.
BackgroundFinalizationProcess := p
"
ObjectMemory startBackgroundFinalizationAt:5
"
!
stopBackgroundFinalization
"stop the background finalizer"
BackgroundFinalizationProcess notNil ifTrue:[
BackgroundFinalizationProcess terminate.
BackgroundFinalizationProcess := nil
].
"
ObjectMemory stopBackgroundFinalization
"
! !
!ObjectMemory class methodsFor:'physical memory access'!
newSpacePagesDo:aBlock
"evaluates aBlock for all pages in the newSpace, passing
the pages address as argument.
For internal & debugging use only."
%{
if (__newSpacePagesDo(&aBlock COMMA_CON) < 0) {
RETURN (false);
}
%}.
^ true
!
oldSpacePagesDo:aBlock
"evaluates aBlock for all pages in the oldSpace, passing
the pages address as argument.
For internal & debugging use only."
%{
if (__oldSpacePagesDo(&aBlock COMMA_CON) < 0) {
RETURN (false);
}
%}.
^ true
!
collectedOldSpacePagesDo:aBlock
"evaluates aBlock for all pages in the prev. oldSpace, passing
the pages address as argument.
For internal & debugging use only."
%{
if (__collectedOldSpacePagesDo(&aBlock COMMA_CON) < 0) {
RETURN (false);
}
%}.
^ true
!
pageIsInCore:aPageNumber
"return true, if the page (as enumerated via oldSpacePagesDo:)
is in memory; false, if currently paged out. For internal
use / monitors only; may vanish.
NOTICE: not all systems provide this information; on those that
do not, true is returned for all pages."
%{
#ifdef HAS_MINCORE
int pageSize = getpagesize();
char result[10];
INT addr;
if (__isSmallInteger(aPageNumber)) {
addr = _intVal(aPageNumber) & ~(pageSize - 1);
} else {
addr = ((INT)aPageNumber) & ~(pageSize - 1);
}
if (mincore(addr, pageSize-1, result) < 0) {
RETURN (true);
}
RETURN ((result[0] & 1) ? true : false);
#endif
%}.
"OS does not supply this info - assume yes"
^ true
! !
!ObjectMemory class methodsFor:'low memory handling'!
memoryInterrupt
"when a low-memory condition arises, ask all classes to
remove possibly cached data. You may help the system a bit,
in providing a lowSpaceCleanup method in your classes which have
lots of data kept somewhere (usually, cached data).
- this may or may not help."
Smalltalk allBehaviors do:[:aClass |
aClass lowSpaceCleanup
].
"/ self error:'almost out of memory'
'almost out of memory' errorPrintNL.
LowSpaceSemaphore signalIf.
! !
!ObjectMemory class methodsFor:'system management'!
loadClassBinary:aClassName
"find the object file for aClassName and -if found - load it;
this one loads precompiled object files"
|fName newClass upd|
fName := self fileNameForClass:aClassName.
fName notNil ifTrue:[
Class withoutUpdatingChangesDo:
[
self loadBinary:(fName , '.o')
].
newClass := self at:(aClassName asSymbol).
(newClass notNil and:[newClass implements:#initialize]) ifTrue:[
newClass initialize
]
]
!
imageName
"return the filename of the current image, or nil
if not running from an image."
^ ImageName
"
ObjectMemory imageName
"
!
imageBaseName
"return a reasonable filename to use as baseName (i.e. without extension).
This is the filename of the current image (without '.img') or,
if not running from an image, the default name 'st'"
|nm|
nm := ImageName.
(nm isNil or:[nm isBlank]) ifTrue:[
^ 'st'
].
(nm endsWith:'.sav') ifTrue:[
nm := nm copyTo:(nm size - 4)
].
(nm endsWith:'.img') ifTrue:[
^ nm copyTo:(nm size - 4)
].
^ nm
"
ObjectMemory imageBaseName
"
!
nameForSnapshot
"return a reasonable filename to store the snapshot image into.
This is the filename of the current image or,
if not running from an image, the default name 'st.img'"
^ self imageBaseName , '.img'
"
ObjectMemory nameForSnapshot
"
!
nameForSources
"return a reasonable filename to store the sources into.
This is the basename of the current image with '.img' replaced
by '.src', or, if not running from an image, the default name 'st.src'"
^ self imageBaseName , '.src'
"
ObjectMemory nameForSources
"
!
nameForChanges
"return a reasonable filename to store the changes into.
This is the basename of the current image with '.img' replaced
by '.chg', or, if not running from an image, the default name 'st.chg'"
^ 'changes'.
^ self imageBaseName , '.chg'
"
ObjectMemory nameForChanges
"
!
snapShot
"create a snapshot file containing all of the current state."
self snapShotOn:(self nameForSnapshot)
"
ObjectMemory snapShot
"
!
snapShotOn:aFileName
"create a snapshot in the given file"
|ok oldImageName|
"
keep a save version - just in case something
bad happens while writing the image.
(could be st/x internal error or file-system errors etc)
"
(OperatingSystem isValidPath:aFileName) ifTrue:[
OperatingSystem renameFile:aFileName to:(aFileName , '.sav').
].
"
give others a chance to fix things
"
self changed:#save.
"
ST-80 compatibility; send #preSnapshot to all classes
"
Smalltalk allBehaviorsDo:[:aClass |
aClass preSnapshot
].
"
save the name with it ...
"
oldImageName := ImageName.
ImageName := aFileName.
ok := self primSnapShotOn:aFileName.
ImageName := oldImageName.
ok ifTrue:[
Class addChangeRecordForSnapshot:aFileName.
"
ST-80 compatibility; send #postSnapshot to all classes
"
Smalltalk allBehaviorsDo:[:aClass |
aClass postSnapshot
].
].
^ ok
"
ObjectMemory snapShotOn:'myimage.img'
"
!
primSnapShotOn:aFileName
"create a snapshot in the given file.
Low level entry. Does not notify classes or write an entry to
the changes file. Also, no image backup is created. Returns true if
the snapshot worked, false if it failed for some reason.
This method should not be used in normal cases."
|ok|
%{ /* STACK:32000 */
OBJ __snapShotOn();
OBJ funny = @symbol(funnySnapshotSymbol);
if (__isString(aFileName)) {
BLOCKINTERRUPTS();
ok = __snapShotOn(__context, _stringVal(aFileName), funny);
UNBLOCKINTERRUPTS();
}
%}.
^ ok
!
applicationImageOn:aFileName for:startupClass selector:startupSelector
"create a snapshot which will come up without any views
but starts up an application by sending startupClass the startupSelector.
EXPERIMENTAL and unfinished. Dont use this method."
|viewsKnown savedIdleBlocks savedTimeoutBlocks savedTranscript
savedRoot|
viewsKnown := Display knownViews.
savedIdleBlocks := Display idleBlocks.
savedTimeoutBlocks := Display timeOutBlocks.
savedTranscript := Transcript.
savedRoot := RootView.
"a kludge: save image with modified knownViews, no idle- and timeoutblocks
and also Transcript set to StdErr ..."
Display knownViews:nil.
Display idleBlocks:nil.
Display timeOutBlocks:nil.
RootView := nil.
Transcript := Stderr.
Smalltalk startupClass:startupClass selector:startupSelector arguments:nil.
self snapShotOn:aFileName.
Smalltalk startupClass:nil selector:nil arguments:nil.
RootView := savedRoot.
Transcript := savedTranscript.
Display knownViews:viewsKnown.
Display idleBlocks:savedIdleBlocks.
Display timeOutBlocks:savedTimeoutBlocks
"ObjectMemory applicationImageOn:'draw.img' for:DrawTool selector:#start"
"ObjectMemory applicationImageOn:'pm.img' for:PMSimulator selector:#start"
!
minimumApplicationImageOn:aFileName for:startupClass selector:startupSelector
"create a snapshot which will come up without any views
but starts up an application by sending startupClass the startupSelector.
All unneeded info is stripped from the saved image.
EXPERIMENTAL and unfinished. Dont use this method."
"create a temporary image, for continuation"
self snapShotOn:'temp.img'.
Display knownViews do:[:aView |
aView notNil ifTrue:[
aView superView isNil ifTrue:[
aView destroy
]
]
].
self stripImage.
self applicationImageOn:aFileName for:startupClass selector:startupSelector.
"continue in old image"
OperatingSystem exec:(Arguments at:1)
withArguments:#('smalltalk' '-i' 'temp.img') , (Arguments copyFrom:2)
"ObjectMemory minimumApplicationImageOn:'clock1.img' for:Clock selector:#start"
"ObjectMemory applicationImageOn:'clock2.img' for:Clock selector:#start"
!
stripImage
"remove all unneeded stuff from the image - much more is possible here.
EXPERIMENTAL and unfinished. Dont use this method."
"remove all class comments & source"
Smalltalk allBehaviorsDo:[:aClass |
aClass setComment:nil.
aClass methodArray do:[:aMethod |
aMethod source:''.
aMethod category:#none
]
].
self garbageCollect
! !