Bert Freudenberg uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-bf.473.mcz

==================== Summary ====================

Name: System-bf.473
Author: bf
Time: 24 March 2012, 12:58:14.567 am
UUID: 7cbf3ed3-b852-44ca-ba5e-8a2579ed3aff
Ancestors: System-eem.472

Fix mapping classes that changed shape when loading from an ImageSegment.
Apart from correcting the source formatting in comeFullyUpOnReload:, the real addition is "aFake becomeForward: aReal" causing the imported classes to be mapped to the actual classes. Before, only the instances were remapped to the actual classes. Also, prevent doIts from entering the system.

=============== Diff against System-eem.472 ===============

Item was changed:
  ----- Method: ImageSegment>>comeFullyUpOnReload: (in category 'fileIn/Out') -----
  comeFullyUpOnReload: smartRefStream
+ 	"fix up the objects in the segment that changed size.  An object in the segment is the wrong size for the modern version of the class. Construct a fake class that is the old size.  Replace the modern class with the old one in outPointers.  Load the segment. Traverse the instances, making new instances by copying fields, and running conversion messages.  Keep the new instances.  Bulk forward become the old to the new.  Let go of the fake objects and classes.
+ 	After the install (below), arrayOfRoots is filled in. Globalize new classes.  Caller may want to do some special install on certain objects in arrayOfRoots.
- 	"fix up the objects in the segment that changed size.  An
- object in the segment is the wrong size for the modern version of the
- class.  Construct a fake class that is the old size.  Replace the
- modern class with the old one in outPointers.  Load the segment.
- Traverse the instances, making new instances by copying fields, and
- running conversion messages.  Keep the new instances.  Bulk forward
- become the old to the new.  Let go of the fake objects and classes.
- 	After the install (below), arrayOfRoots is filled in.
- Globalize new classes.  Caller may want to do some special install on
- certain objects in arrayOfRoots.
  	May want to write the segment out to disk in its new form."
  
+ 	| mapFakeClassesToReal ccFixups receiverClasses rootsToUnhiberhate myProject forgetDoItsClasses |
- 	| mapFakeClassesToReal ccFixups receiverClasses rootsToUnhiberhate myProject |
  
+ 	forgetDoItsClasses := Set new.
+ 	RecentlyRenamedClasses := nil.		"in case old data hanging around"
- 	RecentlyRenamedClasses := nil.		"in case old data
- hanging around"
  	mapFakeClassesToReal := smartRefStream reshapedClassesIn: outPointers.
+ 		"Dictionary of just the ones that change shape. Substitute them in outPointers."
- 		"Dictionary of just the ones that change shape.
- Substitute them in outPointers."
  	ccFixups := self remapCompactClasses: mapFakeClassesToReal
  				refStrm: smartRefStream.
+ 	ccFixups ifFalse: [^ self error: 'A class in the file is not compatible'].
- 	ccFixups ifFalse: [^ self error: 'A class in the file is not
- compatible'].
  	endMarker := segment nextObject. 	"for enumeration of objects"
  	endMarker == 0 ifTrue: [endMarker := 'End' clone].
  	self fixCapitalizationOfSymbols.
  	arrayOfRoots := self loadSegmentFrom: segment outPointers: outPointers.
  		"Can't use install.  Not ready for rehashSets"
  	mapFakeClassesToReal isEmpty ifFalse: [
+ 		self reshapeClasses: mapFakeClassesToReal refStream: smartRefStream
- 		self reshapeClasses: mapFakeClassesToReal refStream:
- smartRefStream
  	].
+ 	"When a Project is stored, arrayOfRoots has all objects in the project, except those in outPointers"
- 	"When a Project is stored, arrayOfRoots has all objects in
- the project, except those in outPointers"
  	arrayOfRoots do: [:importedObject | | existing |
  		((importedObject isMemberOf: WideString) or: [importedObject isMemberOf: WideSymbol]) ifTrue: [
  			importedObject mutateJISX0208StringToUnicode.
  			importedObject class = WideSymbol ifTrue: [
  				"self halt."
+ 				Symbol hasInterned: importedObject asString ifTrue: [:multiSymbol |
+ 					multiSymbol == importedObject ifFalse: [
+ 						importedObject becomeForward: multiSymbol.
- 				Symbol hasInterned: 
- importedObject asString ifTrue: [:multiSymbol |
- 					multiSymbol == importedObject
- ifFalse: [
- 						importedObject
- becomeForward: multiSymbol.
  					].
  				].
  			].
  		].
  		(importedObject isKindOf: TTCFontSet) ifTrue: [
+ 			existing := TTCFontSet familyName: importedObject familyName
+ 						pointSize: importedObject pointSize.	"supplies default"
+ 			existing == importedObject ifFalse: [importedObject becomeForward: existing].
- 			existing := TTCFontSet familyName:
- importedObject familyName
- 						pointSize:
- importedObject pointSize.	"supplies default"
- 			existing == importedObject ifFalse:
- [importedObject becomeForward: existing].
  		].
  	].
+ 	"Smalltalk garbageCollect.   MultiSymbol rehash.  These take time and are not urgent, so don't to them.  In the normal case, no bad MultiSymbols will be found."
- 	"Smalltalk garbageCollect.   MultiSymbol rehash.  These take
- time and are not urgent, so don't to them.  In the normal case, no
- bad MultiSymbols will be found."
  
  	receiverClasses := self restoreEndianness.		"rehash sets"
  	smartRefStream checkFatalReshape: receiverClasses.
  
  	"Classes in this segment."
  	arrayOfRoots do: [:importedObject |
+ 		importedObject class class == Metaclass ifTrue: [
+ 			forgetDoItsClasses add: importedObject.
+ 			self declare: importedObject]].
- 		importedObject class class == Metaclass ifTrue: [self
- declare: importedObject]].
  	arrayOfRoots do: [:importedObject |
  		(importedObject isKindOf: CompiledMethod) ifTrue: [
+ 			importedObject sourcePointer > 0 ifTrue: [importedObject zapSourcePointer]].
- 			importedObject sourcePointer > 0 ifTrue:
- [importedObject zapSourcePointer]].
  		(importedObject isKindOf: Project) ifTrue: [
  			myProject := importedObject.
  			importedObject ensureChangeSetNameUnique.
  			Project addingProject: importedObject.
  			importedObject restoreReferences.
  			self dependentsRestore: importedObject]].
  
  	rootsToUnhiberhate := arrayOfRoots select: [:importedObject |
  		importedObject respondsTo: #unhibernate
  	"ScriptEditors and ViewerFlapTabs"
  	].
  	myProject ifNotNil: [
+ 		myProject world setProperty: #thingsToUnhibernate toValue: rootsToUnhiberhate asArray.
- 		myProject world setProperty: #thingsToUnhibernate
- toValue: rootsToUnhiberhate
  	].
  
  	mapFakeClassesToReal isEmpty ifFalse: [
+ 		mapFakeClassesToReal keysAndValuesDo: [:aFake :aReal |
+ 			aFake indexIfCompact > 0 ifTrue: [aFake becomeUncompact].
+ 			aFake removeFromSystemUnlogged.
+ 			aFake becomeForward: aReal].
- 		mapFakeClassesToReal keys do: [:aFake |
- 			aFake indexIfCompact > 0 ifTrue: [aFake
- becomeUncompact].
- 			aFake removeFromSystemUnlogged].
  		SystemOrganization removeEmptyCategories].
+ 	forgetDoItsClasses do: [:c | c forgetDoIts].
  	"^ self"
  !