'From Squeak3.1alpha of 4 February 2001 [latest update: #3710] on 24 February 2001 at 5:34:34 pm'! "Change Set: WeakObjectFields-ar Date: 11 February 2001 Author: Andreas Raab Make both, DependentsFields and EventsFields in Object hold on to weak references."! Array weakSubclass: #DependentsArray instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Objects'! !DependentsArray commentStamp: '' prior: 0! An array of (weak) dependents of some object.! Collection subclass: #EventMessageSet instanceVariableNames: 'receivers messages ' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Objects'! !EventMessageSet commentStamp: '' prior: 0! A set of messages sent when an event is triggered. Holds only weakly to the receivers of those messages. Instance variables: receivers weak receivers of messages. messages array of messages to be sent.! WeakKeyDictionary subclass: #WeakIdentityKeyDictionary instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Collections-Weak'! !WeakIdentityKeyDictionary commentStamp: '' prior: 0! This class represents an identity dictionary with weak keys.! !Object methodsFor: 'dependents access' stamp: 'ar 2/11/2001 01:55'! addDependent: anObject "Make the given object one of the receiver's dependents." | dependents | dependents _ self dependents. (dependents includes: anObject) ifFalse: [self myDependents: (dependents copyWithDependent: anObject)]. ^ anObject! ! !Object methodsFor: 'events' stamp: 'ar 2/11/2001 02:22'! removeEvent: eventName | events | events _ self myEvents ifNil:[^self]. events removeKey: eventName ifAbsent:[]. events isEmpty ifTrue:[self myEvents: nil].! ! !Object methodsFor: 'events' stamp: 'ar 2/11/2001 02:34'! trigger: anEventSymbol "Evaluate all message sends registered for anEventSymbol." | msgSet any | msgSet _ (self myEvents ifNil:[^self]) at: anEventSymbol ifAbsent:[^self]. any _ false. msgSet do:[:msg| msg value. any _ true]. any ifFalse:[self removeEvent: anEventSymbol].! ! !Object methodsFor: 'events' stamp: 'ar 2/11/2001 02:34'! trigger: anEventSymbol withArguments: anArray "Evaluate all message sends registered for anEventSymbol and pass anArray to the registered actions." | msgSet any | msgSet _ (self myEvents ifNil:[^self]) at: anEventSymbol ifAbsent:[^self]. any _ false. msgSet do:[:msg| msg valueWithArguments: anArray. any _ true]. any ifFalse:[self removeEvent: anEventSymbol].! ! !Object methodsFor: 'events' stamp: 'ar 2/11/2001 02:13'! when: anEventSymbol perform: aMessageSend "Register aMessageSend as action for anEventSymbol." | events | (events _ self myEvents) ifNil: [self myEvents: (events _ IdentityDictionary new)]. (events at: anEventSymbol ifAbsentPut: [EventMessageSet new]) add: aMessageSend! ! !Collection methodsFor: 'copying' stamp: 'ar 2/11/2001 01:55'! copyWithDependent: newElement "Answer a new collection with newElement added (as last element if sequenceable)." ^self copyWith: newElement! ! !Array methodsFor: 'copying' stamp: 'ar 2/11/2001 01:55'! copyWithDependent: newElement self size = 0 ifTrue:[^DependentsArray with: newElement]. ^self copyWith: newElement! ! !DependentsArray methodsFor: 'copying' stamp: 'ar 2/24/2001 17:30'! copyWith: newElement "Re-implemented to not copy any niled out dependents" ^self class streamContents:[:s| self do:[:item| s nextPut: item]. s nextPut: newElement].! ! !DependentsArray methodsFor: 'enumerating' stamp: 'ar 2/11/2001 01:52'! do: aBlock "Refer to the comment in Collection|do:." | dep | 1 to: self size do:[:i| (dep _ self at: i) ifNotNil:[aBlock value: dep]].! ! !DependentsArray methodsFor: 'enumerating' stamp: 'ar 2/11/2001 01:50'! select: aBlock "Refer to the comment in Collection|select:." | aStream | aStream _ WriteStream on: (self species new: self size). self do:[:obj| (aBlock value: obj) ifTrue: [aStream nextPut: obj]]. ^ aStream contents! ! !EventMessageSet methodsFor: 'initialize' stamp: 'ar 2/11/2001 02:25'! initialize: n receivers _ WeakArray new: n. messages _ Array new: n.! ! !EventMessageSet methodsFor: 'adding' stamp: 'ar 2/11/2001 02:28'! add: aMessageSend "Add aMessageSend to the set of messages to be sent when the receiver is activated" | index | index _ receivers indexOf: nil. index = 0 ifTrue:[ receivers _ receivers copyWith: nil. messages _ messages copyWith: nil. index _ receivers size]. receivers at: index put: aMessageSend receiver. messages at: index put: (aMessageSend clone receiver: nil). ^aMessageSend! ! !EventMessageSet methodsFor: 'enumerating' stamp: 'ar 2/11/2001 02:29'! do: aBlock | rcvr | 1 to: receivers size do:[:i| rcvr _ receivers at: i. rcvr ifNil:[messages at: i put: nil] "nil them out on the fly" ifNotNil:[aBlock value: ((messages at: i) clone receiver: rcvr)]].! ! !Object class methodsFor: 'class initialization' stamp: 'ar 2/11/2001 02:00'! flushDependents DependentsFields keysAndValuesDo:[:key :dep| key ifNotNil:[key removeDependent: nil]. ]. DependentsFields finalizeValues.! ! !Object class methodsFor: 'class initialization' stamp: 'ar 2/11/2001 02:31'! flushEvents "Object flushEvents" | msgSet | EventsFields keysAndValuesDo:[:rcvr :evtDict| rcvr ifNotNil:[ "make sure we don't modify evtDict while enumerating" evtDict keys do:[:evtName| msgSet _ evtDict at: evtName ifAbsent:[nil]. (msgSet == nil or:[msgSet isEmpty]) ifTrue:[rcvr removeEvent: evtName]]]]. EventsFields finalizeValues. ! ! !Object class methodsFor: 'class initialization' stamp: 'ar 2/11/2001 01:37'! initialize "Object initialize" EventsFields ifNil:[self initializeEventsFields]. DependentsFields ifNil:[self initializeDependentsFields].! ! !Object class methodsFor: 'class initialization' stamp: 'ar 2/11/2001 01:41'! initializeDependentsFields "Object initialize" DependentsFields _ WeakIdentityKeyDictionary new. ! ! !Object class methodsFor: 'class initialization' stamp: 'ar 2/11/2001 01:41'! initializeEventsFields "Object initialize" EventsFields _ WeakIdentityKeyDictionary new. ! ! !Object class methodsFor: 'class initialization' stamp: 'ar 2/11/2001 01:45'! reInitializeDependentsFields "Object reInitializeDependentsFields" | oldFields | oldFields _ DependentsFields. DependentsFields _ WeakIdentityKeyDictionary new. oldFields keysAndValuesDo:[:obj :deps| deps do:[:d| obj addDependent: d]]. ! ! !Object class methodsFor: 'class initialization' stamp: 'ar 2/11/2001 02:15'! reInitializeEventsFields "Object reInitializeEventsFields" | oldFields | oldFields _ EventsFields. EventsFields _ WeakIdentityKeyDictionary new. oldFields keysAndValuesDo:[:rcvr :evtDict| evtDict keysAndValuesDo:[:evt :msgSet| msgSet do:[:msg| rcvr when: evt perform: msg]]]. ! ! !EventMessageSet class methodsFor: 'instance creation' stamp: 'ar 2/11/2001 02:25'! new ^self new: 1! ! !EventMessageSet class methodsFor: 'instance creation' stamp: 'ar 2/11/2001 02:25'! new: n ^self basicNew initialize: n! ! !SystemDictionary methodsFor: 'memory space' stamp: 'ar 2/11/2001 02:36'! garbageCollect "Primitive. Reclaims all garbage and answers the number of bytes of available space." Object flushDependents. Object flushEvents. ^self primitiveGarbageCollect! ! !SystemDictionary methodsFor: 'memory space' stamp: 'ar 2/11/2001 02:16'! primitiveGarbageCollect "Primitive. Reclaims all garbage and answers the number of bytes of available space." ^ self primBytesLeft! ! !SystemDictionary methodsFor: 'snapshot and quit' stamp: 'ar 2/24/2001 17:34'! snapshot: save andQuit: quit embedded: embeddedFlag "Mark the changes file and close all files. If save is true, save the current state of this Smalltalk in the image file. If quit is true, then exit to the outer shell. The latter part of this method runs when resuming a previously saved image. The resume logic checks for a document file to process when starting up." | resuming msg sourceLink | Object flushDependents. Object flushEvents. save & (SourceFiles at: 2) notNil ifTrue: [msg _ (quit ifTrue: ['----QUIT----'] ifFalse: ['----SNAPSHOT----']) , Date dateAndTimeNow printString. sourceLink _ ' priorSource: ' , LastQuitLogPosition printString. self assureStartupStampLogged. LastQuitLogPosition _ (SourceFiles at: 2) setToEnd; position. self logChange: msg , sourceLink. Transcript cr; show: msg]. self processShutDownList: quit. Cursor write show. save ifTrue: [resuming _ embeddedFlag ifTrue: [self snapshotEmbeddedPrimitive] ifFalse: [self snapshotPrimitive]. "<-- PC frozen here on image file" resuming == false "guard against failure" ifTrue: ["Time to reclaim segment files is immediately after a save" Smalltalk at: #ImageSegment ifPresent: [:theClass | theClass reclaimObsoleteSegmentFiles]]] ifFalse: [resuming _ false]. quit & (resuming == false) ifTrue: [self quitPrimitive]. Cursor normal show. self setGCParameters. resuming == true ifTrue: [self clearExternalObjects]. self processStartUpList: resuming == true. resuming == true ifTrue:[ self setPlatformPreferences. self readDocumentFile]. Smalltalk isMorphic ifTrue: [SystemWindow wakeUpTopWindowUponStartup]. "Now it's time to raise an error" resuming == nil ifTrue:[self error:'Failed to write image file (disk full?)']. ^ resuming! ! !WeakKeyDictionary methodsFor: 'accessing' stamp: 'ar 2/11/2001 02:21'! keysDo: aBlock "Evaluate aBlock for each of the receiver's keys." self associationsDo: [:association | association key ifNotNil:[aBlock value: association key]].! ! !WeakIdentityKeyDictionary methodsFor: 'private' stamp: 'ar 2/11/2001 01:41'! scanFor: anObject "ar 10/21/2000: The method has been copied to this location to indicate that whenever #scanFor: changes #scanForNil: must be changed in the receiver as well." "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements." | element start finish | start _ (anObject identityHash \\ array size) + 1. finish _ array size. "Search from (hash mod size) to the end." start to: finish do: [:index | ((element _ array at: index) == nil or: [element key == anObject]) ifTrue: [^ index ]]. "Search from 1 to where we started." 1 to: start-1 do: [:index | ((element _ array at: index) == nil or: [element key == anObject]) ifTrue: [^ index ]]. ^ 0 "No match AND no empty slot"! ! !WeakIdentityKeyDictionary methodsFor: 'private' stamp: 'ar 2/11/2001 01:41'! scanForNil: anObject "Private. Scan the key array for the first slot containing nil (indicating an empty slot). Answer the index of that slot." | start finish | start _ (anObject identityHash \\ array size) + 1. finish _ array size. "Search from (hash mod size) to the end." start to: finish do: [:index | (array at: index) == nil ifTrue: [^ index ]]. "Search from 1 to where we started." 1 to: start-1 do: [:index | (array at: index) == nil ifTrue: [^ index ]]. ^ 0 "No match AND no empty slot"! ! Object initialize! "Postscript: Reinitialize Object" Object reInitializeDependentsFields. Object reInitializeEventsFields. !