'From Croquet1.0beta of 11 April 2006 [latest update: #1] on 24 August 2008 at 10:51:07 am'!

!CDeepCopier methodsFor: 'like fullCopy' stamp: 'eem 6/11/2008 16:32'!
checkDeep
	"Write exceptions in the Transcript.  Every class that implements veryDeepInner: must copy all its inst vars.  Danger is that a user will add a new instance variable and forget to copy it.  This check is only run by hand once in a while to make sure nothing was forgotten.  
(Please do not remove this method.)
	DeepCopier new checkDeep 	"

	Transcript
		cr;
		show: 'Instance variables shared with the original object when it is copied'.
	(self systemNavigation allClassesImplementing: #veryDeepInner:) do: 
			[:aClass | | mm |
			(mm := aClass instVarNames size) > 0 ifTrue:
				[aClass instSize - mm + 1 to: aClass instSize do: 
					[:index | 
					((aClass compiledMethodAt: #veryDeepInner:) writesField: index) ifFalse:
						[Transcript
							cr;
							show: aClass name;
							space;
							show: (aClass allInstVarNames at: index)]]]]! !

!CDeepCopier methodsFor: 'like fullCopy' stamp: 'eem 6/11/2008 16:33'!
checkVariables
	"Check that no indexes of instance vars have changed in certain classes.  If you get an error in this method, an implementation of veryDeepCopyWith: needs to be updated.  The idea is to catch a change while it is still in the system of the programmer who made it.  
	DeepCopier new checkVariables	"

	self checkBasicClasses.

	"Every class that implements veryDeepInner: must copy all its inst vars.  Danger is that a user will add a new instance variable and forget to copy it.  So check that the last one is mentioned in the copy method."
	(self systemNavigation allClassesImplementing: #veryDeepInner:) do: 
			[:aClass | 
			((aClass compiledMethodAt: #veryDeepInner:) writesField: aClass instSize) 
				ifFalse: 
					[aClass instSize > 0 
						ifTrue: [self warnIverNotCopiedIn: aClass sel: #veryDeepInner:]]].
	(self systemNavigation allClassesImplementing: #veryDeepCopyWith:) do: 
			[:aClass | | meth |
			meth := aClass compiledMethodAt: #veryDeepCopyWith:.
			meth size > 20 & (meth literals includes: #veryDeepCopyWith:) not 
				ifTrue: 
					[(meth writesField: aClass instSize) 
						ifFalse: [self warnIverNotCopiedIn: aClass sel: #veryDeepCopyWith:]]]! !

!CDeepCopier methodsFor: 'like fullCopy' stamp: 'eem 6/11/2008 16:37'!
fixDependents
	"They are not used much, but need to be right"

	DependentsFields associationsDo:
		[:pair |
		 pair value do:
			[:dep |
			 (references at: dep ifAbsent: [nil]) ifNotNil:
				[:newDep| | newModel |
				 newModel := references at: pair key ifAbsent: [pair key].
				 newModel addDependent: newDep]]].
! !

!CDeepCopier methodsFor: 'like fullCopy' stamp: 'eem 6/11/2008 16:41'!
mapUniClasses
	"For new Uniclasses, map their class vars to the new objects.  And their additional class instance vars.  (scripts slotInfo) and cross references like (player321)."
	"Players also refer to each other using associations in the References dictionary.  Search the methods of our Players for those.  Make new entries in References and point to them."
| pp |

	newUniClasses ifFalse: [^ self].	"All will be siblings.  uniClasses is empty"
"Uniclasses use class vars to hold onto siblings who are referred to in code"
pp := Player class superclass instSize.
uniClasses do: [:playersClass | "values = new ones"
	playersClass classPool associationsDo: [:assoc |
		assoc value: (assoc value veryDeepCopyWith: self)].
	playersClass scripts: (playersClass privateScripts veryDeepCopyWith: self).	"pp+1"
	"(pp+2) slotInfo was deepCopied in copyUniClass and that's all it needs"
	pp+3 to: playersClass class instSize do: [:ii | 
		playersClass instVarAt: ii put: 
			((playersClass instVarAt: ii) veryDeepCopyWith: self)].
	].

"Make new entries in References and point to them."
References keys "copy" do: [:playerName | | oldPlayer newKey |
	oldPlayer := References at: playerName.
	(references includesKey: oldPlayer) ifTrue: [
		newKey := (references at: oldPlayer) "new player" uniqueNameForReference.
		"now installed in References"
		(references at: oldPlayer) renameTo: newKey]].
uniClasses "values" do: [:newClass | | oldSelList newSelList |
	oldSelList := OrderedCollection new.   newSelList := OrderedCollection new.
	newClass selectorsDo: [:sel | 
		(newClass compiledMethodAt: sel)	 literals do: [:assoc |
			assoc isVariableBinding ifTrue: [
				(References associationAt: assoc key ifAbsent: [nil]) == assoc ifTrue: [
					| newKey newAssoc |
					newKey := (references at: assoc value ifAbsent: [assoc value]) 
									externalName asSymbol.
					(assoc key ~= newKey) & (References includesKey: newKey) ifTrue: [
						newAssoc := References associationAt: newKey.
						newClass methodDictionary at: sel put: 
							(newClass compiledMethodAt: sel) clone.	"were sharing it"
						(newClass compiledMethodAt: sel)
							literalAt: ((newClass compiledMethodAt: sel) literals indexOf: assoc)
							put: newAssoc.
						(oldSelList includes: assoc key) ifFalse: [
							oldSelList add: assoc key.  newSelList add: newKey]]]]]].
	oldSelList with: newSelList do: [:old :new |
			newClass replaceSilently: old to: new]].	"This is text replacement and can be wrong"! !


!FarRefMap methodsFor: 'accessing' stamp: 'eem 6/11/2008 17:35'!
add: farRef
	"Include farRef as one of the receiver's elements, but only if
	not already present. Answer farRef."

	farRef ifNil: [self error: 'Sets cannot meaningfully contain nil as an element'].
	mutex critical: [| index |
		index := self findElementOrFlag: (farRef valueOn: island).
		(array at: index) == flag ifTrue:[self atNewIndex: index put: farRef].
		].
	^farRef! !

!FarRefMap methodsFor: 'accessing' stamp: 'eem 6/11/2008 17:35'!
do: aBlock

	tally = 0 ifTrue:[^self].
	mutex critical: [| obj |
		1 to: array size do:[:i|
			((obj := array at: i) == nil or:[obj == flag]) ifFalse:[aBlock value: obj].
		].
	].! !

!FarRefMap methodsFor: 'private' stamp: 'eem 6/11/2008 17:35'!
finalizeValues

	mutex critical: [
		| length oldIndex newIndex element |
		length := array size.
		1 to: length do:[:index|
			(array at: index) ifNil:[
				tally := tally - 1.
				oldIndex := index.
				[oldIndex = length
					ifTrue: [oldIndex := 1]
					ifFalse: [oldIndex := oldIndex + 1].
				(element := array at: oldIndex) == flag] whileFalse:[
					newIndex := self findElementOrFlag: element.
					oldIndex = newIndex ifFalse: [array swap: oldIndex with: newIndex].
				].
			].
		].
	].! !

!FarRefMap methodsFor: 'private' stamp: 'eem 6/11/2008 17:36'!
growTo: anInteger
	"Grow the elements array and reinsert the old elements"

	mutex critical: [
		| oldElements |
		oldElements := array.
		array := WeakArray new: anInteger.
		array atAllPut: flag.
		tally := 0.
		oldElements do:[:obj | (obj == flag or: [obj == nil]) ifFalse: [
			array at: (self findElementOrFlag: (obj valueOn: island)) put: obj.
			tally := tally + 1.
			]].
		].! !


!ScriptProcess methodsFor: 'private' stamp: 'eem 6/11/2008 11:28'!
newScript
	suspendedContext := [self privateRunMsg.
						   self suspend] asContext.
	flags := 0.
	priority := Processor initialScriptPriority.
	scheduler := Processor activeProcess scheduler.
	island := Processor activeProcess island! !