"
 COPYRIGHT (c) 1993 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.
"
"{ Package: 'stx:libbasic' }"

Object subclass:#Registry
	instanceVariableNames:'registeredObjects handleArray tally indexTable'
	classVariableNames:''
	poolDictionaries:''
	category:'System-Support'
!

!Registry class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1993 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.
"
!

documentation
"
    Registries provide an easy interface to using WeakArrays. 
    A class, which wants to be informed of instance-death, can put a created object
    into a registry. The registry will create an executor, which is a (shallow-)copy 
    of the object, and watch out for death of the original object. When it dies, 
    the executor will be sent a #finalize message.
    The trick with the shallow copy is especially nice, you can think of it as
    being the original object which died.

    All objects, which keep external resources (such as fileDescriptors, fonts, 
    colormap-entries etc.) should be registered, so that the underlying resource
    can be freed when the object goes away.

    Of course, you too can use it to do whatever you need to do in case of the
    death of an object.

    Registries use #executor to aquire the copy of the original,
    this can be redefined in individual classes for faster copying 
    (typically, not all internal state, but only some device handles are needed for 
    finalization). If the to-be-registered object is large, this method may also
    return a stub (placeHolder) object. (i.e. there is no need for the copy to be
    of the same class as the original, as long as it implements #finalize and frees
    the relevant OS resources. Some classes return a specialized private-class instance,
    which only holds on the handle and implements #finalize.)
    Example uses are found in Form, Color, ExternalStream and Font

    [author:]
        Claus Gittinger

    [see also:]
        WeakArray WeakIdentityDictionary WeakIdentitySet
        Font Form Color Cursor ExternalStream
        
"
! !

!Registry methodsFor:'accessing'!

contents
    "return the collection of registered objects.
     Warning: this returns a weak collection."

    ^ registeredObjects

    "Modified: 16.1.1997 / 16:40:46 / cg"
! !

!Registry methodsFor:'dispose handling'!

informDispose:someHandle
    "send a dispose message - this is sent to the executor,
     since the original is already gone"

    someHandle finalize

    "Modified: 16.1.1997 / 17:23:46 / cg"
!

update:something with:aParameter from:changedObject
    "an instance has been destroyed - look which one it was"

    |executor
     index  "{ Class: SmallInteger }"
     sz     "{ Class: SmallInteger }"
     o myHandleArray wasBlocked|

    something == #ElementExpired ifTrue:[
        wasBlocked := OperatingSystem blockInterrupts.
        [
            myHandleArray := handleArray.
            sz := myHandleArray size.

            index := 1.
            [index <= sz] whileTrue:[
                o := registeredObjects at:index.
                o == 0 ifTrue:[
                    executor := myHandleArray at:index.
                    "remove the executor from the handle array before informing the executor.
                     This is critical in case of errors while executing the executor.
                     See ObjectMemory>>finalize"
                    registeredObjects at:index put:nil.
                    tally := tally - 1.
                    executor notNil ifTrue:[
                        myHandleArray at:index put:nil.

                        "/
                        "/ allow interrupts for a while ...
                        "/
                        wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
                        self informDispose:executor.
                        OperatingSystem blockInterrupts.

                        "/
                        "/ any change in an interrupt or dispose handling ?
                        "/
                        handleArray ~~ myHandleArray ifTrue:[
                            myHandleArray := handleArray.
                            sz := myHandleArray size.
                            "/ start again
                            index := 0.
                        ]
                    ]
                ].
                index := index + 1.
            ]
        ] ensure:[
            wasBlocked ifFalse:[
                OperatingSystem unblockInterrupts
            ]
        ].

        (sz > 50 and:[tally < (sz // 2)]) ifTrue:[
            "/ shrink
            self resize
        ]
    ] ifFalse:[
        something == #earlyRestart ifTrue:[
            handleArray notNil ifTrue:[
                handleArray atAllPut:nil.
            ]
        ]
    ].

    "Created: 15.6.1996 / 15:24:41 / cg"
    "Modified: 8.1.1997 / 14:05:02 / stefan"
    "Modified: 2.6.1997 / 18:15:23 / cg"
! !

!Registry methodsFor:'enumerating'!

detect:aBlock ifNone:exceptionValue
    registeredObjects notNil ifTrue:[
        registeredObjects validElementsDo:[:obj |
            (aBlock value:obj) ifTrue:[^ obj].
        ].
    ].
    ^ exceptionValue value
!

do:aBlock
    "evaluate aBlock for each registered object"

    registeredObjects notNil ifTrue:[
	registeredObjects validElementsDo:aBlock
    ]
! !

!Registry methodsFor:'private'!

repairTally
    |sz          "{ Class: SmallInteger }"
     cnt         "{ Class: SmallInteger }"
     executor wasBlocked|

    wasBlocked := OperatingSystem blockInterrupts.

    indexTable := WeakIdentityDictionary new.

    sz := registeredObjects size.
    cnt := 0.

    1 to:sz do:[:index |
        ((executor := registeredObjects at:index) notNil 
        and:[executor ~~ 0]) ifTrue:[
            indexTable at:executor put:index.
            cnt := cnt + 1.
        ] ifFalse:[
            handleArray at:index put:nil.
            registeredObjects at:index put:nil.
        ]
    ].

    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].

    "Created: 6.3.1997 / 22:31:09 / cg"
!

resize
    |sz          "{ Class: SmallInteger }"
     dstIndex    "{ Class: SmallInteger }"
     realNewSize "{ Class: SmallInteger }"
     newObjects newHandles wasBlocked 
     executor|

    sz := registeredObjects size.

    (sz > 50 and:[tally < (sz // 2)]) ifTrue:[
        "/ shrink

        wasBlocked := OperatingSystem blockInterrupts.

        sz := registeredObjects size.
        realNewSize := tally * 3 // 2.
        newObjects := WeakArray new:realNewSize.
        newHandles := Array new:realNewSize.
        indexTable := WeakIdentityDictionary new.

        dstIndex := 1.
        1 to:sz do:[:index |
            (executor := registeredObjects at:index) notNil ifTrue:[
                dstIndex > realNewSize ifTrue:[
                    'Registry [error]: size given is too small in resize' errorPrintCR.
                    self repairTally.
                    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
                    ^ self
                ].
                newObjects at:dstIndex put:executor.
                newHandles at:dstIndex put:(handleArray at:index).
                indexTable at:executor put:dstIndex.

                dstIndex := dstIndex + 1
            ]
        ].

        registeredObjects removeDependent:self.
        newObjects addDependent:self.
        registeredObjects := newObjects.
        handleArray := newHandles.

        wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
    ]

    "Created: 16.1.1997 / 18:08:00 / cg"
    "Modified: 6.3.1997 / 22:29:58 / cg"
!

unregister:anObject atIndex:index
    "strictly private"

    handleArray at:index put:nil.
    registeredObjects at:index put:nil.
    (anObject notNil and:[anObject ~~ 0]) ifTrue:[ 
        indexTable removeKey:anObject ifAbsent:[]
    ].
    tally := tally - 1.
! !

!Registry methodsFor:'queries'!

isEmpty
    ^ tally == 0
! !

!Registry methodsFor:'registering objects'!

register:anObject
    "register anObject, so that a copy of it gets the disposed message
     when anObject dies (some time in the future)"

    |executor|

    executor := anObject executor.
    executor notNil ifTrue:[
        self register:anObject as:executor.
    ].
!

register:anObject as:aHandle
    "register anObject, so that I later receive informDispose: with aHandle
     (some time in the future)"

    |newColl newPhantoms
     size  "{ Class: SmallInteger }"
     index "{ Class: SmallInteger }"
     p wasBlocked idx0|

    wasBlocked := OperatingSystem blockInterrupts.

    registeredObjects size == 0 "isNil" ifTrue:[
        registeredObjects := WeakArray new:10.
        registeredObjects addDependent:self.
        handleArray := Array basicNew:10.
        indexTable := WeakIdentityDictionary new.

        registeredObjects at:1 put:anObject.
        handleArray at:1 put:aHandle.
        indexTable at:anObject put:1.

        tally := 1.
        ObjectMemory addDependent:self.
        wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
        ^ self
    ].

    "/
    "/ allow interrupts to be handled here
    "/ (but continue with interrupts disabled)
    "/
    wasBlocked ifFalse:[
        OperatingSystem unblockInterrupts.
        OperatingSystem blockInterrupts.
    ].

    "/ index := registeredObjects identityIndexOf:anObject ifAbsent:0.
    index := indexTable at:anObject ifAbsent:0.
    index ~~ 0 ifTrue:[
        "/ double check ...
        (registeredObjects at:index) ~~ anObject ifTrue:[
            ('Registry [warning]: index table clobbered') errorPrintCR.
        ].

        "already registered"
        
        handleArray at:index put:aHandle.
"/        ('Registry [info]: object (' , (registeredObjects at:index) printString , ') is already registered') infoPrintCR.
        wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
        ^ self
    ].

    "/
    "/ allow interrupts to be handled here
    "/ (but continue with interrupts disabled)
    "/
    wasBlocked ifFalse:[
        OperatingSystem unblockInterrupts.
        OperatingSystem blockInterrupts.
    ].

    "/
    "/ search for a free slot ...
    "/ on the fly look for leftovers (should no longer happen)
    "/
    idx0 := 1.
    index := registeredObjects identityIndexOf:nil startingAt:idx0.
    [index ~~ 0] whileTrue:[
        "is there a leftover ?"
        p := handleArray at:index.
        p isNil ifTrue:[
            registeredObjects at:index put:anObject.
            handleArray at:index put:aHandle.
            indexTable at:anObject put:index.

            tally := tally + 1.
            wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
            ^ self
        ].

        "/ mhmh - a registeredObject vanished, but its
        "/ executor is still there ...

        "/
        "/ this may happen, if the registries dispose handling is 
        "/ currently being executed by a lower priority process,
        "/ and the registeredObject has already been nilled,
        "/ but the executor is being notified (in the other process).

"/        'Registry [info]: leftOver executor: ' infoPrint. p infoPrintCR.

"/        "tell the executor"
"/        handleArray at:index put:nil.
"/        tally := tally - 1.
"/        self informDispose:p.
"/        p := nil.

        idx0 := index + 1.
        index := registeredObjects identityIndexOf:nil startingAt:idx0.
    ].

    "no free slot, add at the end"

    size := registeredObjects size.
    index := size + 1.
    newColl := WeakArray new:(size * 2).
    newColl replaceFrom:1 to:size with:registeredObjects.
    registeredObjects removeDependent:self.
    registeredObjects := newColl.
    registeredObjects addDependent:self.
    registeredObjects at:index put:anObject.

    newPhantoms := Array basicNew:(size * 2).
    newPhantoms replaceFrom:1 to:size with:handleArray.
    handleArray := newPhantoms.
    handleArray at:index put:aHandle.
    indexTable at:anObject put:index.

    tally := tally + 1.

    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].

    "Modified: / 7.1.1997 / 16:56:03 / stefan"
    "Modified: / 22.4.1998 / 11:09:23 / cg"
!

registerChange:anObject
    "a registered object has changed, create a new executor"

    |index wasBlocked executor|

    executor := anObject executor.
    executor isNil ifTrue:[
        self unregister:anObject.
        ^ self.
    ].

    wasBlocked := OperatingSystem blockInterrupts.
    registeredObjects isNil ifTrue:[
        index := 0
    ] ifFalse:[
        "/ index := registeredObjects identityIndexOf:anObject ifAbsent:0.
        index := indexTable at:anObject ifAbsent:0.
    ].
    index ~~ 0 ifTrue:[
        handleArray at:index put:executor.
    ] ifFalse:[
        self register:anObject as:executor
    ].
    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].

    "Modified: 6.3.1997 / 22:24:15 / cg"
!

unregister:anObject
    "remove registration of anObject, without telling the executor;
     should be sent, if we are no more interested in destruction of
     anObject (i.e. it no longer holds external resources)."

    |index wasBlocked|

    registeredObjects notNil ifTrue:[
        wasBlocked := OperatingSystem blockInterrupts.
        "/ index := registeredObjects identityIndexOf:anObject ifAbsent:0.
        index := indexTable at:anObject ifAbsent:0.
        index ~~ 0 ifTrue:[
            self unregister:anObject atIndex:index.
        ].
        wasBlocked ifFalse:[OperatingSystem unblockInterrupts].

        self resize
    ]

    "Modified: 16.1.1997 / 18:08:42 / cg"
!

unregisterAllForWhich:aBlock
    "remove registration of all entries, for which the argument block
     evaluates to true.
     should be sent, if we are no more interested in destruction of
     a group of objects (i.e. it no longer holds external resources)."

    |n "{ Class: SmallInteger }"
     obj wasBlocked any|

    registeredObjects notNil ifTrue:[
	any := false.
	wasBlocked := OperatingSystem blockInterrupts.
	n := registeredObjects size.

	1 to:n do:[:index |
	    obj := registeredObjects at:index.
	    (obj notNil and:[obj ~~ 0]) ifTrue:[
		(aBlock value:obj) ifTrue:[
		    self unregister:obj atIndex:index.
		    any := true.
		]
	    ]
	].
	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
	any ifTrue:[ self resize ]
    ]

    "Created: 16.1.1997 / 16:39:18 / cg"
    "Modified: 16.1.1997 / 18:08:47 / cg"
!

unregisterAllForWhichHandle:aBlock
    |n "{ Class: SmallInteger }"
     obj handle wasBlocked any|

    registeredObjects notNil ifTrue:[
	any := false.
	wasBlocked := OperatingSystem blockInterrupts.
	n := registeredObjects size.

	1 to:n do:[:index |
	    obj := registeredObjects at:index.
	    handle := handleArray at:index.
	    handle notNil ifTrue:[
		(aBlock value:handle) ifTrue:[
		    self unregister:obj atIndex:index.
		    any := true.
		]
	    ]
	].
	wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
	any ifTrue:[ self resize ]
    ]
! !

!Registry class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic/Registry.st,v 1.64 2013-06-03 18:02:40 cg Exp $'
!

version_CVS
    ^ '$Header: /cvs/stx/stx/libbasic/Registry.st,v 1.64 2013-06-03 18:02:40 cg Exp $'
! !