AtomicInstaller.ns

Newspeak3
'Mirrors'
class AtomicInstaller usingPlatform: p <Platform> vmMirror: vmm <VMMirror> = (
(* This handles adding, removing and modifying stuff.

What remains unaddressed is changing classes of individual objects, and changing superclasses of individual classes. These can of course be handled elsewhere, but not as part of a broader atomic transaction as is done here. The API of this class should be extended to deal with these requirements.

The process of an atomic install is as follows:

We construct a map, upodateMap, of old objects to revised objects. Eventually, we will do a one way become: of
the old objects into the new ones. The map is populated with mixins, classes and instances that need to be modified
as keys, and their revised version as values.

The input consists of a tuple of IntermediateClassDeclarations, and a map, existingMixinMap, associating each IntermediateClassDeclaration with its corresponding existing mixin (if it has one). Each element in the tuple describes an ''outermost'' mixin and its nested mixins. By ''outermost mixin'' we mean a mixin that is not nested within any other mixin being processed at this time. It could be a top level mixin, but it could also be a nested mixin provided its enclosing mixins are not subject to change.

We distinguish between new and existing mixins. We use the map in order to do this.  This is essential, since we cannot assume a global namespace in which to look up mixins to see if they exist or not.

New mixins are simply created per their description, recursively including their nested mixins. These new mixins are gathered in the results list returned by the nsyallation process (#install:withExistingMixins:), as are the mixins created to replace existing ones (described below).

For each existing top level mixin, we add any nested mixins that correspond to nested mixins of the revised mixin to existingMixinMap in #augmentExistingMixinMap:withNestedClasses:inExistingMixin: recursively, before any other processing. We then process each top level mixin in order.

If the mixin described by the IntermediateClassDeclaration exists, we store the existing mixin as a key in updateMap, and create a new one per the description, stored as the corresponding value in updateMap.

For each existing mixin, we also go through all its invocations.
 We  collect the invocation and all its subclasses in a map called existingClasses, which maps  depth in the inheritance hierarchy to sets of existing classes classes at that depth. This gives us the set of existing classes that will require modification - either because their mixin has changed, or their superclass has changed. The data structure allows us to easily traverse the set of existing classes in order, base classes first.

We then recursively process the nested mixins of each mixin being processed.

Next, we go through the existing classes. For each class we produce a new class which we store in updateMap, keyed by the old class.  It is important not to use the class name as a key, as we cannot assume a global namespace in Newspeak.
The new class may differ in its own structure (because its mixin differs) or only in having a revised superclass,
or both.

Because we traverse the classes in increasing depth order we are assured that a class' superclass has either already been processed, and can be looked up in  updateMap, or it has not changed. This is essential, because the new class points at its up-to-date superclass and uses data derived from it.

If the layout of a class has changed, we also process all its instances. For each existing instance of an old class whose shape has changed, we create an instance of the new class, taking care to copy the data of fields shared between the old and new classes from the old instance to the new one. Each such processed object is placed as a key in updateMap, with the new version as the corresponding value.

At this point, we can do the one way become: and the installation is complete.


Some care is needed to ensure atomic install works with shape changes to InstanceMixin, ClassMixin, Class or Metaclass. Installing such changes involves processing their instances twice: first to create the new definition and second to reallocate to the new shape, which requires the new definition.

Let A be the old definition
Let B be the new definition with the old shape
Let C be the new definition with the new shape
Let D be the old definition with the new shape

We need the bulk become to include, in order,

B -> C
A -> C

They must appear in this order so C adopts the identity hash (and possible class index) of A rather than that of B. We must also not include A -> D, as it makes no sense to forward an identity to two objects.


( * :bug: Rename doesn't propagate down.
AA -> BB
but
AA`Nested stays AA`Nested should be BB`Nested* )

Copyright (c) 2009-2010 Gilad Bracha
Copyright (c) 2011-2015 Ryan Macnak

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the ''Software''), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED ''AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.
*)
|
private IdentityMap = p squeak IdentityDictionary.
private List = p collections List.
private InstanceMixin = p kernel InstanceMixin.
private ClassMixin = p kernel ClassMixin.
private MethodDictionary = p squeak MethodDictionary.
private ClassOrganizer = p squeak ClassOrganizer.

private vmmirror = vmm.

private updateMixinsAndClasses <IdentityMap[OldObject,NewObject]>
private updateInstances <IdentityMap[OldObject,NewObject]>
private existingClasses <IdentityMap[HierarchyDepth,Set[Class]]>
|) (
private augmentExistingMixinMap: map withNestedClasses: nestedClasses inExistingMixin: mixin = (
	nestedClasses do:
		[:nestedClass <IntermediateClassDeclaration> |
		| name existingNestedMixin |
		name:: nestedClass simpleName.
		existingNestedMixin:: mixin nestedMixins at: name ifAbsent: [nil].
		nil = existingNestedMixin ifFalse:
			[map at: nestedClass put: existingNestedMixin.
			augmentExistingMixinMap: map
				withNestedClasses: nestedClass instanceSide nestedClasses
				inExistingMixin: existingNestedMixin]]
)
private cleanup = (
	updateMixinsAndClasses: nil.
	updateInstances: nil.
	existingClasses: nil.
)
conflictingMethodsNamed: n <Symbol> in: m <AbstractMixin> = (
	Error signal: 'Attempting to install class with multiple methods with selector ', n, ' in mixin ', m name
)
private depthFor: klassArg <Class> ^<Integer> = (
	| klass d |
	d: 0.
	klass: klassArg.
	[klass isNil] whileFalse: [klass: klass superclass. d: d+1].
	^d
)
public install: intermediates <List[IntermediateClassDeclaration]>
 withExistingMixins: existingMixinMap <Map[IntermediateClassDeclaration, InstanceMixin]> = (
	| results |
	setup.
	results:: intermediates collect:
		[:classDecl <IntermediateClassDeclaration> |
		(existingMixinMap includesKey: classDecl) ifTrue:
			[augmentExistingMixinMap: existingMixinMap
				withNestedClasses: classDecl instanceSide nestedClasses
				inExistingMixin: (existingMixinMap at: classDecl)].
		processClassDeclaration: classDecl in: existingMixinMap].
	processExistingClasses.
	installAll.
	vmmirror flushCache. (* Clear all lookup caches *)
	cleanup.

	^results (* <List[InstanceMixin]> *)
)
private installAll = (
	| updateCount oldObjects newObjects index |
	updateCount:: updateMixinsAndClasses size + updateInstances size.
	oldObjects:: Array new: updateCount.
	newObjects:: Array new: updateCount.
	index: 1.
	updateInstances keysAndValuesDo:
		[:old :new |
		oldObjects at: index put: old.
		newObjects at: index put: new.
		index: index + 1].
	(* Put updated mixins and classes last, so A -> C follows B -> C (see class comment). *)
	updateMixinsAndClasses keysAndValuesDo:
		[:old :new |
		oldObjects at: index put: old.
		newObjects at: index put: (updateInstances at: old ifAbsent: [new]). (* Follow B to avoid B -> C, A -> B. *)
		index: index + 1].

	oldObjects elementsForwardIdentityToEvenIfImmutable: newObjects.

	(* As of 2673, the VM ensures objects whose references are deleted in a one-way become cannot be resurrected by allInstances/allObjects.
	hadLayoutChange ifTrue: [vmmirror fullGC]. (* Ensure that objects newly made unreachable by the one-way become will not be enumerated by future uses of someInstance/nextInstance. See discussion of issue #82 and comments in ClassBuilder update:to:. *) *)
)
private layoutHasChangedBetween: oldClass <Behavior> and: newClass <Behavior> ^<Boolean> = (
	^oldClass allInstVarNames ~= newClass allInstVarNames
)
private methodDictionaryFor: mixin <AbstractMixin> from: imixin <IntermediateMixin> ^<MethodDictionary> = (
	|
	methods = imixin assembleMethods.
	mdict = MethodDictionary new: methods size.
	|
	methods do:
		[:imethod <IntermediateMethod> |
		imethod methodMixin: mixin.
		(mdict includesKey: imethod selector) ifTrue: [
			conflictingMethodsNamed: imethod selector in: mixin
			].
		mdict at: imethod selector put: imethod compiledMethod].
	^mdict
)
private newClassFor: oldClass <Class> ^<Class> = (
	| newSuperclass newMixin newClass |

	newSuperclass:: updateMixinsAndClasses at: oldClass superclass ifAbsent: [oldClass superclass].
	newMixin:: updateMixinsAndClasses at: oldClass mixin ifAbsent: [oldClass mixin].

#BOGUS yourself. (* Name not quite right.  Should reflect new name, but should keep the same form as the old name if it's like This`9087#450 *)
	newClass:: newMixin apply: newSuperclass withName: newMixin simpleName.
	newClass setEnclosingObjectSlot: oldClass enclosingObjectSlot.
	(* organization and category: they live in the mixin *)

	^newClass
)
private noteUpdateOf: existingMixin <InstanceMixin | nil> to: newMixin <InstanceMixin> = (
	existingMixin isNil ifTrue: [^self].

	updateMixinsAndClasses at: existingMixin put: newMixin.
	updateMixinsAndClasses at: existingMixin classMixin put: newMixin classMixin.

	existingMixin applications do: [:app | sortClass: app].
)
private processClassDeclaration: classDecl <IntermediateClassDeclaration>
 in: existingMixinMap <IdentityMap[IntermediateClassDeclaration, InstanceMixin]>
 ^<InstanceMixin> = (
	|
	mixin <Mixin>
	classMixin <ClassMixin>
	existingMixin <Mixin>
	|

	mixin:: InstanceMixin new.
	classMixin:: ClassMixin new.

	mixin cachedHeaderSource: classDecl headerSource.
	mixin cachedConstructorName: classDecl factoryName.
	assert: [classDecl factoryName notNil] message: 'Missing factory name'.
	mixin category: classDecl category.
	mixin name: classDecl simpleName.
	mixin classMixin: classMixin.
	mixin methodDictionary: (methodDictionaryFor: mixin from: classDecl instanceSide).
	mixin slots: (classDecl instanceSide assembleSlots collect:
		[:s <IntermediateSlotDeclaration> | {s simpleName. s isMutable. s accessModifier}]) asArray.

	classMixin instanceMixin: mixin.
	classMixin methodDictionary: (methodDictionaryFor: classMixin from: classDecl classSide).

	setOrganizationFor: mixin basedOn: classDecl instanceSide.
	setOrganizationFor: classMixin basedOn: classDecl classSide.

	existingMixin:: existingMixinMap at: classDecl ifAbsent: [nil].
	noteUpdateOf: existingMixin to: mixin.

	nil = existingMixin ifFalse:
		[(* If this is the top-most thing changed in this installation and not a top level class, the enclosingMixin won't otherwise be set and would incorrectly end up nil. *)
		mixin enclosingMixin: existingMixin enclosingMixin.
		mixin classMixin enclosingMixin: existingMixin enclosingMixin].

	classDecl instanceSide nestedClasses do:
		[:nestedClassDecl <IntermediateClassDeclaration> |
		| nestedMixin <InstanceMixin> |
		nestedMixin:: processClassDeclaration: nestedClassDecl in: existingMixinMap.
		mixin nestedMixins at: nestedMixin simpleName put: nestedMixin.
		nestedMixin enclosingMixin: mixin.
		nestedMixin classMixin enclosingMixin: mixin].

	^mixin
)
private processExistingClass: oldClass <Class> = (
	| newClass <Class> |
	newClass:: newClassFor: oldClass.

	updateMixinsAndClasses at: oldClass put: newClass.
	updateMixinsAndClasses at: (vmmirror classOf: oldClass) put: (vmmirror classOf: newClass).
)
private processExistingClasses = (
	(* Process superclasses before subclasses. Create all new classes before remapping any instances. *)
	existingClasses keys asSortedCollection do:
		[:inheritanceDepth <Integer> |
		(existingClasses at: inheritanceDepth) do:
			[:oldClass <Class> | processExistingClass: oldClass]].

	existingClasses valuesDo:
		[:depthSet <Set[Class]> |
		depthSet do:
			[:oldClass <Class> | processInstancesOf: oldClass]].
)
private processInstancesOf: oldClass <Class> = (
	|
	newClass <Class> = updateMixinsAndClasses at: oldClass.
	oldSlotNames <Array[Symbol]>
	newSlotCount <Integer>
	remapIndices <Array[Integer]>
	|
	(layoutHasChangedBetween: oldClass and: newClass) ifFalse: [^self].

	(* Heuristic: choose the latter slot if a slot name is duplicated to favor overriding slots. *)
	oldSlotNames:: oldClass allInstVarNames.
	remapIndices:: newClass allInstVarNames collect:
		[:newSlotName | oldSlotNames lastIndexOf: newSlotName ifAbsent: 0].
	newSlotCount:: remapIndices size.

	(vmmirror allInstancesOf: oldClass) do:
		[:oldInstance |
		(* Avoid A -> D (see class comment). *)
		(updateMixinsAndClasses includesKey: oldInstance) ifFalse:
			[ | newInstance = vmmirror instantiateFixedClass: newClass. |
			(* Copy state from oldInstance to newInstance. *)
			1 to: newSlotCount do: [:newIndex |
				| oldIndex value |
				oldIndex:: remapIndices at: newIndex.
				0 == oldIndex ifFalse: [
					value:: vmmirror ifFail: [halt] namedSlotOf: oldInstance at: oldIndex.
					vmmirror ifFail: [halt] namedSlotOf: newInstance at: newIndex put: value]].

			updateInstances at: oldInstance put: newInstance]].
)
private setOrganizationFor: mixin <AbstractMixin> basedOn: intermediate <IntermediateMixin> = (
	| org = ClassOrganizer defaultList: {}. |
	intermediate assembleMethods do:
		[:imethod <IntermediateMethod> |
		imethod isSynthetic ifFalse:
			[assert: [imethod category notNil] message: 'Missing category'.
			org classify: imethod selector under: imethod category.]].
	mixin organization: org.
)
private setup = (
	updateMixinsAndClasses: IdentityMap new.
	updateInstances: IdentityMap new.
	existingClasses: IdentityMap new.
)
private sortClass: app <Class> = (
	| classes depth |
	depth:: depthFor: app.
	classes:: existingClasses at: depth ifAbsentPut: [List new].
	classes add: app.
	app subclassesDo: [:sc | sortClass: sc].
)
) : (
)