'From Squeak2.8 of 23 June 2000 [latest update: #2342] on 8 July 2000 at 5:14:11 pm'!
"Change Set:		JMMFlowWorkBackTo27
Date:			6 July 2000
Author:			johnmci@smalltalkconsulting.com

In order to get correspondents/flow to work with a 2.7 image you need this one little change set. This fixes various problems with race conditions on the external semaphore table. Also adds a method to BlockContext which was another patch to 2.8"!

Object subclass: #ExternalSemaphoreTable
	instanceVariableNames: ''
	classVariableNames: 'ProtectTable '
	poolDictionaries: ''
	category: 'System-Support'!

!ExternalSemaphoreTable commentStamp: '<historical>' prior: 0!
By John M McIntosh johnmci@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 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.!

!BlockContext methodsFor: 'controlling' stamp: 'JMM 7/6/2000 16:34'!
repeat
	"Evaluate the receiver repeatedly, ending only if the block explicitly returns."

	[self value. true] whileTrue! !


!ExternalSemaphoreTable class methodsFor: 'accessing' stamp: 'JMM 6/6/2000 20:36'!
clearExternalObjects
	"Clear the array of objects that have been registered for use in non-Smalltalk code."

	ProtectTable critical: [Smalltalk specialObjectsArray at: 39 put: Array new].
! !

!ExternalSemaphoreTable class methodsFor: 'accessing' stamp: 'JMM 6/6/2000 21:01'!
externalObjects
	^ProtectTable critical: [Smalltalk specialObjectsArray at: 39].! !

!ExternalSemaphoreTable class methodsFor: 'accessing' stamp: 'JMM 6/6/2000 20:44'!
registerExternalObject: anObject
	^ ProtectTable critical: [self safelyRegisterExternalObject: anObject]
! !

!ExternalSemaphoreTable class methodsFor: 'accessing' stamp: 'JMM 6/6/2000 20:57'!
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 _ 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 no empty slots, expand the array"
	firstEmptyIndex = 0 ifTrue: [
		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
! !

!ExternalSemaphoreTable class methodsFor: 'accessing' stamp: 'JMM 6/6/2000 20:59'!
safelyUnregisterExternalObject: anObject
	"Unregister the given object in the external objects array. Do nothing if it isn't registered.
	JMM change to return if we clear the element, since it should only appear once in the array"

	| objects |
	anObject ifNil: [^ self].
	objects _ Smalltalk specialObjectsArray at: 39.
	1 to: objects size do: [:i |
		(objects at: i) == anObject ifTrue: 
		[objects at: i put: nil.
		^self]].
! !

!ExternalSemaphoreTable class methodsFor: 'accessing' stamp: 'JMM 6/6/2000 20:45'!
unregisterExternalObject: anObject
	ProtectTable critical: [self safelyUnregisterExternalObject: anObject]
! !

!ExternalSemaphoreTable class methodsFor: 'initialize' stamp: 'JMM 6/6/2000 20:32'!
initialize
	ProtectTable _ Semaphore forMutualExclusion! !


!SystemDictionary methodsFor: 'special objects' stamp: 'JMM 6/6/2000 20:36'!
clearExternalObjects
	"Clear the array of objects that have been registered for use in non-Smalltalk code."
	"Smalltalk clearExternalObjects"

	ExternalSemaphoreTable clearExternalObjects
! !

!SystemDictionary methodsFor: 'special objects' stamp: 'JMM 6/6/2000 21:01'!
externalObjects
	"Return an array of objects that have been registered for use in non-Smalltalk code. Smalltalk objects should be referrenced by external code only via indirection through this array, thus allowing the objects to move during compaction. This array can be cleared when the VM re-starts, since variables in external code do not survive snapshots. Note that external code should not attempt to access a Smalltalk object, even via this mechanism, while garbage collection is in progress."
	"Smalltalk externalObjects"

	^ ExternalSemaphoreTable externalObjects
! !

!SystemDictionary methodsFor: 'special objects' stamp: 'JMM 6/6/2000 20:39'!
registerExternalObject: anObject
	"Register the given object in the external objects array and return its index. If it is already there, just return its index."

	^ExternalSemaphoreTable registerExternalObject: anObject! !

!SystemDictionary methodsFor: 'special objects' stamp: 'JMM 6/6/2000 20:40'!
unregisterExternalObject: anObject
	"Unregister the given object in the external objects array. Do nothing if it isn't registered."

	ExternalSemaphoreTable unregisterExternalObject: anObject! !

ExternalSemaphoreTable initialize!