[squeak-dev] The Inbox: System-hsj.452.mczcommits at source.squeak.org commits at source.squeak.orgWed Aug 17 14:15:15 UTC 2011
A new version of System was added to project The Inbox: http://source.squeak.org/inbox/System-hsj.452.mcz ==================== Summary ==================== Name: System-hsj.452 Author: hsj Time: 17 August 2011, 4:14:49.888 pm UUID: 9b7158fc-3a52-42f1-b44d-11264a79420b Ancestors: System-ul.451 Guard against max external object table size on Cog. The default is to raise an error if this were to occur. (see #maxExternalObjects:) Split ExternalSemaphoreTable mutex into separate ones for addition and removal. While removal may seem not needed, it is for the case where 1 thread tries to add, while 2 threads try to remove the same object. (If not, the added object could end up being removed unintentionally) This allows removal to take place while another process tries to add one, f.ex. as a result of trying to make free slots rather than grow by doing GC to trigger finalizers. (see #freedSlotsIn:ratherThanIncreaseSizeTo:) Both methods referred to above write warnings to the transcript, there may be better suited places to report these in Squeak. =============== Diff against System-ul.451 =============== Item was changed: Object subclass: #ExternalSemaphoreTable instanceVariableNames: '' + classVariableNames: 'ProtectAdd ProtectRemove ProtectTable' - classVariableNames: 'ProtectTable' poolDictionaries: '' category: 'System-Support'! + !ExternalSemaphoreTable commentStamp: 'HenrikSperreJohansen 8/17/2011 14:52' prior: 0! - !ExternalSemaphoreTable commentStamp: '<historical>' prior: 0! By John M McIntosh johnmci at smalltalkconsulting.com + This class was written to mange the external semaphore table. When I was writing a Socket test server I discovered various race conditions on the access to the externalSemaphore table. This new class uses class side methods to restrict access using two mutex semaphores, one for removal and one for additions to the table. It seemed cleaner to deligate the reponsibility here versus adding more code and another class variable to SystemDictionary - This class was written to mange the external semaphore table. When I was writing a Socket test server I discovered various race conditions on the access to the externalSemaphore table. This new class uses class side methods to restrict access using a mutex semaphore. It seemed cleaner to deligate the reponsibility here versus adding more code and another class variable to SystemDictionary + + Note that in Smalltalk recreateSpecialObjectsArray we still directly play with the table.! Item was changed: ----- Method: ExternalSemaphoreTable class>>clearExternalObjects (in category 'accessing') ----- clearExternalObjects "Clear the array of objects that have been registered for use in non-Smalltalk code." + "Only protect adds, concurrent removals would make little difference as to how empty the table is..." + ProtectAdd critical: [ + self unprotectedExternalObjects: Array new]. - - ProtectTable critical: [Smalltalk specialObjectsArray at: 39 put: Array new]. ! Item was added: + ----- Method: ExternalSemaphoreTable class>>collectionBasedOn:withRoomFor: (in category 'private') ----- + collectionBasedOn: aCollection withRoomFor: anObject + "Return a collection with room to store anObject, either aCollection itself with free slots, or a larger copy" + | sz newObjects newSize | + sz := aCollection size. + newSize := sz +20. "grow linearly" + (self freedSlotsIn: aCollection ratherThanIncreaseSizeTo: newSize) + ifTrue: [newObjects := aCollection] + ifFalse: [ + newObjects := aCollection species new: newSize. + newObjects replaceFrom: 1 to: sz with: aCollection startingAt: 1. + self unprotectedExternalObjects: newObjects.]. + ^newObjects! Item was added: + ----- Method: ExternalSemaphoreTable class>>freedSlotsIn:ratherThanIncreaseSizeTo: (in category 'private') ----- + freedSlotsIn: externalObjects ratherThanIncreaseSizeTo: newSize + "In some VM's, the external object table has a max size, which has to be increased for vm to reference them correctly." + "In that case, try to gc to free slots first before actually increasing the max size" + "Return whether I ended up freeing slots by GC'ing, or one should increase the size of " + ^Smalltalk vm maxExternalObjects + ifNotNil: [:maxSize | + (maxSize < newSize) and: + [| freedEnoughSlots | + Smalltalk garbageCollect. + "Do we have free slots now? If not, performing the GC didn't help and we still have to grow." + freedEnoughSlots := externalObjects includes: nil. + + freedEnoughSlots + ifTrue: ["If we did GC, warn we had to gc so actions could be taken if appropriate." + Transcript cr; show: TimeStamp now printString, + ' + WARNING: Had to GC to make room for more external objects. + If this happens often, it would be a good idea to either: + - Raise the maxExternalObjects size. + - Write your code to explicitly release them rather than wait for finalization.' ] + ifFalse: [Smalltalk vm maxExternalObjects: newSize]. + freedEnoughSlots]] + ifNil:[false]! Item was changed: ----- Method: ExternalSemaphoreTable class>>initialize (in category 'initialize') ----- initialize + ProtectAdd := Semaphore forMutualExclusion. + ProtectRemove := Semaphore forMutualExclusion! - ProtectTable := Semaphore forMutualExclusion! Item was changed: ----- Method: ExternalSemaphoreTable class>>registerExternalObject: (in category 'accessing') ----- registerExternalObject: anObject + ^ ProtectAdd critical: [self safelyRegisterExternalObject: anObject] - ^ ProtectTable critical: [self safelyRegisterExternalObject: anObject] ! Item was changed: ----- Method: ExternalSemaphoreTable class>>safelyRegisterExternalObject: (in category 'accessing') ----- safelyRegisterExternalObject: anObject "Register the given object in the external objects array and return its index. If it is already there, just return its index." | objects firstEmptyIndex obj sz newObjects | objects := Smalltalk specialObjectsArray at: 39. "find the first empty slot" + firstEmptyIndex := self slotFor: anObject in: objects. - firstEmptyIndex := 0. - 1 to: objects size do: [:i | - obj := objects at: i. - obj == anObject ifTrue: [^ i]. "object already there, just return its index" - (obj == nil and: [firstEmptyIndex = 0]) ifTrue: [firstEmptyIndex := i]]. + "if object has no empty slots, we need to get a collection which does" - "if no empty slots, expand the array" firstEmptyIndex = 0 ifTrue: [ + objects := self collectionBasedOn: objects + withRoomFor: anObject. + firstEmptyIndex := self slotFor: anObject in: objects.]. - sz := objects size. - newObjects := objects species new: sz + 20. "grow linearly" - newObjects replaceFrom: 1 to: sz with: objects startingAt: 1. - firstEmptyIndex := sz + 1. - Smalltalk specialObjectsArray at: 39 put: newObjects. - objects := newObjects]. objects at: firstEmptyIndex put: anObject. ^ firstEmptyIndex ! Item was added: + ----- Method: ExternalSemaphoreTable class>>slotFor:in: (in category 'private') ----- + slotFor: anObject in: aCollection + "find the first empty slot" + "The following was written in an atomic fashion using special methods with no suspension points, not sure if on purpose, but keeping it that way for now. + Uses should be protected by the ProtectTable semaphore anyhow, but... it's too much work to reason 100% about it" + + | firstEmptyIndex | + 1 to: aCollection size do: [:i | | obj | + obj := aCollection at: i. + obj == anObject ifTrue: [^ i]. "object already there, just return its index" + (firstEmptyIndex == nil and: [obj == nil]) ifTrue: [firstEmptyIndex := i]]. + ^firstEmptyIndex ifNil: [0]! Item was added: + ----- Method: ExternalSemaphoreTable class>>unprotectedExternalObjects (in category 'private') ----- + unprotectedExternalObjects + ^Smalltalk specialObjectsArray at: 39! Item was added: + ----- Method: ExternalSemaphoreTable class>>unprotectedExternalObjects: (in category 'private') ----- + unprotectedExternalObjects: aCollection + ^Smalltalk specialObjectsArray at: 39 put: aCollection! Item was changed: ----- Method: ExternalSemaphoreTable class>>unregisterExternalObject: (in category 'accessing') ----- unregisterExternalObject: anObject + ProtectRemove critical: [self safelyUnregisterExternalObject: anObject] - ProtectTable critical: [self safelyUnregisterExternalObject: anObject] ! Item was added: + ----- Method: SmalltalkImage>>maxExternalObjects (in category 'vm parameters') ----- + maxExternalObjects + "The size of array where external objects are registered. Only in Cog" + self isRunningCog ifFalse: [^nil]. + ^self vmParameterAt: 49! Item was added: + ----- Method: SmalltalkImage>>maxExternalObjects: (in category 'vm parameters') ----- + maxExternalObjects: aSize + "This method should never be called as result of normal program execution. + If it is however, handle it differently: + - In development, signal an error to promt user to set a bigger size at startup immediately. + - In production, accept the cost of potentially unhandled interrupts, but log the action for later review. + + See comment in maxExternalObjectsSilently: why this behaviour is desirable," + + "Can't find a place where development/production is decided. + Suggest Smalltalk image inProduction, but use an overridable temp meanwhile." + |inProduction| + + self isRunningCog ifFalse: [^0]. + + inProduction := false. + ^"Smalltalk image" inProduction + ifFalse: [self error: 'Not enough space for external objects, set a larger size at startup!!'] + ifTrue: [ + self maxExternalObjectsSilently: aSize. + Transcript cr; + show: 'WARNING: Had to increase size of external object table due to many concurrently in use!!'; cr; + show: 'You should increase this size at startup using #maxExternalObjectsSilently:'; + cr; + show: 'Current table size: ', self maxExternalObjects printString]! Item was added: + ----- Method: SmalltalkImage>>maxExternalObjectsSilently: (in category 'vm parameters') ----- + maxExternalObjectsSilently: aSize + "Changes the size of array where external objects are registered. + The size can only grow, and will always be the next power of two larger than the parameter. + + The intended use is to set the table size to some adequate maximum as part of a non-resuming image startUp. + + Setting this at any time other than start-up can potentially lose requests. + i.e. during the realloc new storage is allocated, the old contents are copied and then pointers are switched. + Requests occurring during copying won't be seen if they occur to indices already copied. " + + self isRunningCog ifFalse: [^0]. + "The vm-header field is a short, maximum 64k entries. Well, on most platforms anyways " + (aSize < 0 or: [aSize > 16rFFFF]) ifTrue: [^DomainError signalFrom: 0 to: 16rFFFF]. + ^self vmParameterAt: 49 put: aSize!
More information about the Squeak-dev mailing list |