"
 COPYRIGHT (c) 1991 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.
"

Array variableSubclass:#WeakArray
       instanceVariableNames:'watcher dependents'
       classVariableNames:''
       poolDictionaries:''
       category:'System-Support'
!

WeakArray comment:'

COPYRIGHT (c) 1991 by Claus Gittinger
              All Rights Reserved

$Header: /cvs/stx/stx/libbasic/WeakArray.st,v 1.2 1993-11-08 02:32:36 claus Exp $
written feb 91 by claus
'!

!WeakArray class methodsFor:'documentation'!

documentation
"
WeakArrays are used to trace disposal of objects; in contrast to other
objects, references by WeakArrays will NOT keep an object from dying.
Instead, whenever an object kept in a WeakArray dies, its entry is nilled,
and the WeakArray informed by the storage manager. This is done by sending a 
disposeInterrupt.
This interrupt is cought here and informs the watcher and, if there is
a dependent, this one gets informed as well (I dont know, which of the
two mechanisms will survive in the long run - I started with the watcher,
but now switch to dependencies).
"
! !

!WeakArray class methodsFor:'instance creation'!

new:size
    |newArray|
 
    "this is a kludge: would like to set WEAK-flag in class
     initialize method, but no order of class-init is defined ...
     (therefore it could happen, that a WeakArray is used by other
      class inits before this init is evaluated. To avoid this,
      the WEAK bit is set when the first WeakArray is created)"

    self flags:5.
    ObjectMemory disposeInterruptHandler:self.
    newArray := self basicNew:size.
%{
    OBJ ok;
    OBJ __addShadowObject();

    ok = __addShadowObject(newArray, 0);
    if (ok == false) {
	/* 
	 * this happens when too many shadow objects are
	 * already there, collect garbage to get rid of
         * obsolete ones, and try again.
	 * since a full collect is expensive, we try
	 * a scavenge first, doing a full collect only if 
	 * that does not help.
	 */
	nonTenuringScavenge(__context);
	ok = __addShadowObject(newArray, 0);
	if (ok == false) {
	    /* try more ... */
	    scavenge(__context);
	    ok = __addShadowObject(newArray, 0);
	    if (ok == false) {
	        /* hard stuff - need full collect */
		__garbageCollect(__context);
		ok = __addShadowObject(newArray, 0);
		if (ok == false) {
	            /* mhmh - it seems that there are really many shadow 
		       objects around - force creation */
		    ok = __addShadowObject(newArray, 1);
		    if (ok == false) {
		        /* no chance - something must be wrong */
		        newArray = nil;
		    }
		}
	    }
	}
    }
%}
.
    ^ newArray
! !

!WeakArray class methodsFor:'dispose handling'!

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);
%}
!

disposeInterrupt
    "this is triggered by the garbage collector,
     whenever any shadowArray looses a pointer."

    self allChangedShadowObjectsDo:[:aShadowArray | 
        aShadowArray changed.
        aShadowArray watcher notNil ifTrue:[
            aShadowArray watcher informDispose
        ]
    ]
! !

!WeakArray methodsFor:'accessing'!

dependents 
    "return the dependents of the receiver"

    ^ dependents
!

dependents:aCollection
    "set the dependents of the receiver"

    dependents := aCollection
!

watcher
    "return the watcher of the receiver.
     The watcher-stuff is a leftover from an old implementation 
     and will vanish soon"

    ^ watcher
!

watcher:anObject
    "set the watcher of the receiver.
     The watcher-stuff is a leftover from an old implementation 
     and will vanish soon"

    watcher := anObject
! !