[Vm-dev] VM Maker: Cog.pharo-EstebanLorenzano.165.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Jul 8 16:29:25 UTC 2014


Esteban Lorenzano uploaded a new version of Cog to project VM Maker:
http://source.squeak.org/VMMaker/Cog.pharo-EstebanLorenzano.165.mcz

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

Name: Cog.pharo-EstebanLorenzano.165
Author: EstebanLorenzano
Time: 8 July 2014, 6:28:52.430348 pm
UUID: 26d372d3-dbb3-4c67-9402-21e879ab1e22
Ancestors: Cog-EstebanLorenzano.164

empty log message

=============== Diff against Cog-eem.163 ===============

Item was changed:
+ SystemOrganization addCategory: #Cog!
+ SystemOrganization addCategory: 'Cog-Benchmarks-DeltaBlue'!
+ SystemOrganization addCategory: 'Cog-Benchmarks-Richards'!
+ SystemOrganization addCategory: 'Cog-Benchmarks-SMark'!
+ SystemOrganization addCategory: 'Cog-Benchmarks-Shootout'!
+ SystemOrganization addCategory: 'Cog-Bootstrapping'!
+ SystemOrganization addCategory: 'Cog-Morphing Bytecode Set'!
+ SystemOrganization addCategory: 'Cog-ProcessorPlugins'!
+ SystemOrganization addCategory: 'Cog-Processors'!
+ SystemOrganization addCategory: 'Cog-Processors-Tests'!
+ SystemOrganization addCategory: 'Cog-Scripting'!
+ SystemOrganization addCategory: 'Cog-Scripts'!
+ SystemOrganization addCategory: 'Cog-Tests'!
- SystemOrganization addCategory: #'Cog-Benchmarks-DeltaBlue'!
- SystemOrganization addCategory: #'Cog-Benchmarks-Richards'!
- SystemOrganization addCategory: #'Cog-Benchmarks-SMark'!
- SystemOrganization addCategory: #'Cog-Benchmarks-Shootout'!
- SystemOrganization addCategory: #'Cog-Bootstrapping'!
- SystemOrganization addCategory: #'Cog-Morphing Bytecode Set'!
- SystemOrganization addCategory: #'Cog-ProcessorPlugins'!
- SystemOrganization addCategory: #'Cog-Processors'!
- SystemOrganization addCategory: #'Cog-Processors-Tests'!
- SystemOrganization addCategory: #'Cog-Scripting'!
- SystemOrganization addCategory: #'Cog-Scripts'!
- SystemOrganization addCategory: #'Cog-Tests'!
- SystemOrganization addCategory: #'Cog-Benchmarks'!

Item was changed:
  Object subclass: #SpurBootstrap
+ 	instanceVariableNames: 'oldHeap newHeap oldHeapSize newHeapSize oldHeapNumObjs newHeapNumObjs map reverseMap classToIndex oldInterpreter lastClassTablePage literalMap methodClasses installedPrototypes sizeSym rehashSym classMetaclass imageType'
- 	instanceVariableNames: 'oldHeap newHeap oldHeapSize newHeapSize oldHeapNumObjs newHeapNumObjs map reverseMap classToIndex oldInterpreter lastClassTablePage literalMap methodClasses installedPrototypes sizeSym rehashSym classMetaclass'
  	classVariableNames: 'ImageHeaderFlags ImageName ImageScreenSize TransformedImage'
  	poolDictionaries: 'VMObjectIndices'
  	category: 'Cog-Bootstrapping'!
  
  !SpurBootstrap commentStamp: 'eem 9/11/2013 05:45' prior: 0!
  SpurBootstrap bootstraps an image in SpurMemoryManager format from a Squeak V3 + closures format.
  
  e.g.
  	(SpurBootstrap32 new on: '/Users/eliot/Cog/startreader.image')
  		transform;
  		launch
  
  Bootstrap issues:
  - should it implement a deterministic Symbol identityHash? This means set a Symbol's identityHash at instance creation time
    based on its string hash so that e.g. MethodDIctionary instances have a deterministic order and don't need to be rehashed on load.
  - should it collapse ContextPart and MethodContext down onto Context (and perhaps eliminate BlockContext)?
  
  Instance Variables
  	classToIndex:			<Dictionary>
  	lastClassTablePage:	<Integer>
  	map:					<Dictionary>
  	methodClasses:		<Set>
  	newHeap:				<SpurMemoryManager>
  	oldHeap:				<NewObjectMemory>
  	oldInterpreter:			<StackInterpreterSimulator>
  	reverseMap:			<Dictionary>
  	symbolMap:				<Dictionary>
  
  classToIndex
  	- oldClass to new classIndex map
  
  lastClassTablePage
  	- oop in newHeap of last classTable page.  U<sed in validation to filter-out class table.
  
  methodClasses
  	- cache of methodClassAssociations for classes in which modified methods are installed
  
  map
  	- oldObject to newObject map
  
  newHeap
  	- the output, bootstrapped image
  
  oldHeap
  	- the input, image
  
  oldInterpreter
  	- the interpreter associated with oldHeap, needed for a hack to grab WeakArray
  
  reverseMap
  	- newObject to oldObject map
  
  symbolMap
  	- symbol toi symbol oop in oldHeap, used to map prototype methdos to methods in oldHeap!

Item was changed:
+ ----- Method: SpurBootstrap class>>CharacterPROTOTYPEclone (in category 'method prototypes squeak') -----
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEclone (in category 'method prototypes') -----
  CharacterPROTOTYPEclone
  	"Answer the receiver, because Characters are unique."
  	^self!

Item was added:
+ ----- Method: SpurBootstrap class>>CharacterPROTOTYPEsetValue: (in category 'method prototypes') -----
+ CharacterPROTOTYPEsetValue: newValue
+ 	self error: 'Characters are immutable'!

Item was changed:
+ ----- Method: SpurBootstrap class>>CharacterPROTOTYPEshallowCopy (in category 'method prototypes pharo') -----
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEshallowCopy (in category 'method prototypes') -----
  CharacterPROTOTYPEshallowCopy
  	"Answer the receiver, because Characters are unique."
  	^self!

Item was changed:
  ----- Method: SpurBootstrap class>>ClassBuilderPROTOTYPEcomputeFormat:instSize:forSuper:ccIndex: (in category 'method prototypes') -----
  ClassBuilderPROTOTYPEcomputeFormat: type instSize: newInstSize forSuper: newSuper ccIndex: ccIndex
  	"Compute the new format for making oldClass a subclass of newSuper.
  	 Answer the format or nil if there is any problem."
  	| instSize isVar isWords isPointers isWeak |
  	type == #compiledMethod ifTrue:
  		[newInstSize > 0 ifTrue:
  			[self error: 'A compiled method class cannot have named instance variables'.
  			^nil].
  		^CompiledMethod format].
  	instSize := newInstSize + (newSuper ifNil:[0] ifNotNil:[newSuper instSize]).
  	instSize > 65535 ifTrue:
  		[self error: 'Class has too many instance variables (', instSize printString,')'.
  		^nil].
  	type == #normal ifTrue:[isVar := isWeak := false. isWords := isPointers := true].
  	type == #bytes ifTrue:[isVar := true. isWords := isPointers := isWeak := false].
  	type == #words ifTrue:[isVar := isWords := true. isPointers := isWeak := false].
  	type == #variable ifTrue:[isVar := isPointers := isWords := true. isWeak := false].
  	type == #weak ifTrue:[isVar := isWeak := isWords := isPointers := true].
  	type == #ephemeron ifTrue:[isVar := false. isWeak := isWords := isPointers := true].
  	type == #immediate ifTrue:[isVar := isWeak := isPointers := false. isWords := true].
  	(isPointers not and: [instSize > 0]) ifTrue:
  		[self error: 'A non-pointer class cannot have named instance variables'.
  		^nil].
  	^self format: instSize variable: isVar words: isWords pointers: isPointers weak: isWeak!

Item was changed:
  ----- Method: SpurBootstrap class>>ClassBuilderPROTOTYPEformat:variable:words:pointers:weak: (in category 'method prototypes') -----
  ClassBuilderPROTOTYPEformat: nInstVars variable: isVar words: isWords pointers: isPointers weak: isWeak
  	"Compute the format for the given instance specfication.
  	 Above Cog Spur the class format is
  		<5 bits inst spec><16 bits inst size>
  	 where the 5-bit inst spec is
  			0	= 0 sized objects (UndefinedObject True False et al)
  			1	= non-indexable objects with inst vars (Point et al)
  			2	= indexable objects with no inst vars (Array et al)
  			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
  			4	= weak indexable objects with inst vars (WeakArray et al)
  			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
  			6	= unused
  			7	= immediates (SmallInteger, Character)
  			8	= unused
  			9	= reserved for 64-bit indexable
  		10-11	= 32-bit indexable (Bitmap)
  		12-15	= 16-bit indexable
  		16-23	= 8-bit indexable
  		24-31	= compiled methods (CompiledMethod)"
  	| instSpec |
  	instSpec := isWeak
  					ifTrue:
  						[isVar
  							ifTrue: [4]
  							ifFalse: [5]]
  					ifFalse:
  						[isPointers
  							ifTrue:
  								[isVar
  									ifTrue: [nInstVars > 0 ifTrue: [3] ifFalse: [2]]
  									ifFalse: [nInstVars > 0 ifTrue: [1] ifFalse: [0]]]
  							ifFalse:
  								[isVar
  									ifTrue: [isWords ifTrue: [12] ifFalse: [16]]
  									ifFalse: [7]]].
  	^(instSpec bitShift: 16) + nInstVars!

Item was changed:
  ----- Method: SpurBootstrap class>>ClassBuilderPROTOTYPEsuperclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes') -----
  ClassBuilderPROTOTYPEsuperclass: aClass
  	immediateSubclass: t instanceVariableNames: f 
  	classVariableNames: d poolDictionaries: s category: cat
  	"This is the standard initialization message for creating a
  	 new immediate class as a subclass of an existing class."
  	| env |
  	aClass instSize > 0
  		ifTrue: [^self error: 'cannot make an immediate subclass of a class with named fields'].
  	aClass isVariable
  		ifTrue: [^self error: 'cannot make an immediate subclass of a class with indexed instance variables'].
  	aClass isPointers
  		ifFalse: [^self error: 'cannot make an immediate subclass of a class without pointer fields'].
  	"Cope with pre-environment and environment versions. Simplify asap."
  	env := (Smalltalk classNamed: #EnvironmentRequest)
  				ifNil: [aClass environment]
  				ifNotNil: [:erc| erc signal ifNil: [aClass environment]].
  	^self 
  		name: t
  		inEnvironment: env
  		subclassOf: aClass
  		type: #immediate
  		instanceVariableNames: f
  		classVariableNames: d
  		poolDictionaries: s
  		category: cat!

Item was changed:
  ----- Method: SpurBootstrap class>>ClassBuilderPROTOTYPEupdate:to: (in category 'method prototypes') -----
  ClassBuilderPROTOTYPEupdate: oldClass to: newClass
  	"Convert oldClass, all its instances and possibly its meta class into newClass,
  	 instances of newClass and possibly its meta class. The process is surprisingly
  	 simple in its implementation and surprisingly complex in its nuances and potentially
  	 bad side effects.
  	 We can rely on two assumptions (which are critical):
  		#1: The method #updateInstancesFrom: will not create any lasting pointers to
  			 'old' instances ('old' is quote on quote since #updateInstancesFrom: will do
  			 a become of the old vs. the new instances and therefore it will not create
  			 pointers to *new* instances before the #become: which are *old* afterwards)
  		#2: The non-preemptive execution of the critical piece of code guarantees that
  			 nobody can get a hold by 'other means' (such as process interruption and
  			 reflection) on the old instances.
  	 Given the above two, we know that after #updateInstancesFrom: there are no pointers
  	 to any old instances. After the forwarding become there will be no pointers to the old
  	 class or meta class either.
  	 Andreas Raab, 2/27/2003 23:42"
  	| meta |
  	meta := oldClass isMeta.
  	"Note: Everything from here on will run without the ability to get interrupted
  	to prevent any other process to create new instances of the old class."
  	["Note: The following removal may look somewhat obscure and needs an explanation.
  	  When we mutate the class hierarchy we create new classes for any existing subclass.
  	  So it may look as if we don't have to remove the old class from its superclass. However,
  	  at the top of the hierarchy (the first class we reshape) that superclass itself is not newly
  	  created so therefore it will hold both the oldClass and newClass in its (obsolete or not)
  	  subclasses. Since the #become: below will transparently replace the pointers to oldClass
  	  with newClass the superclass would have newClass in its subclasses TWICE. With rather
  	  unclear effects if we consider that we may convert the meta-class hierarchy itself (which
  	  is derived from the non-meta class hierarchy).
  	  Due to this problem ALL classes are removed from their superclass just prior to converting
  	  them. Here, breaking the superclass/subclass invariant really doesn't matter since we will
  	  effectively remove the oldClass (becomeForward:) just a few lines below."
  
  		oldClass superclass removeSubclass: oldClass.
  		oldClass superclass removeObsoleteSubclass: oldClass.
  
  		"make sure that the VM cache is clean"
  		oldClass methodDict do: [:cm | cm flushCache].
  		
  		"Convert the instances of oldClass into instances of newClass"
  		newClass updateInstancesFrom: oldClass.
  
  		meta
  			ifTrue:
  				[oldClass becomeForward: newClass.
  				 oldClass updateMethodBindingsTo: oldClass binding]
  			ifFalse:
  				[{oldClass. oldClass class} elementsForwardIdentityTo: {newClass. newClass class}.
  				 oldClass updateMethodBindingsTo: oldClass binding.
  				 oldClass class updateMethodBindingsTo: oldClass class binding].
  
  		"eem 5/31/2014 07:22 At this point there used to be a garbage collect whose purpose was
  		 to ensure no old instances existed after the becomeForward:.  Without the GC it was possible
  		 to resurrect old instances using e.g. allInstancesDo:.  This was because the becomeForward:
  		 updated references from the old objects to new objects but didn't destroy the old objects.
  		 But as of late 2013/early 2014 becomeForward: has been modified to free all the old objects."]
  			valueUnpreemptively!

Item was added:
+ ----- Method: SpurBootstrap class>>ContextPROTOTYPEallInstances (in category 'method prototypes pharo') -----
+ ContextPROTOTYPEallInstances
+ 	"Answer all instances of the receiver."
+ 	<primitive: 177>
+ 	"The primitive can fail because memory is low.  If so, fall back on the old
+ 	 enumeration code, which gives the system a chance to GC and/or grow.
+ 	 Because aBlock might change the class of inst (for example, using become:),
+ 	 it is essential to compute next before aBlock value: inst.
+ 	 Only count until thisContext since this context has been created only to
+ 	 compute the existing instances."
+ 	| inst insts next |
+ 	insts := WriteStream on: (Array new: 64).
+ 	inst := self someInstance.
+ 	[inst == thisContext or: [inst == nil]] whileFalse:
+ 		[next := inst nextInstance.
+ 		 insts nextPut: inst.
+ 		 inst := next].
+ 	^insts contents!

Item was added:
+ ----- Method: SpurBootstrap class>>ContextPROTOTYPEallInstancesDo: (in category 'method prototypes pharo') -----
+ ContextPROTOTYPEallInstancesDo: aBlock
+ 	"Evaluate aBlock with each of the current instances of the receiver."
+ 	| instances inst next |
+ 	instances := self allInstancesOrNil.
+ 	instances ifNotNil:
+ 		[instances do: aBlock.
+ 		 ^self].
+ 	"allInstancesOrNil can fail because memory is low.  If so, fall back on the old
+ 	 enumeration code.  Because aBlock might change the class of inst (for example,
+ 	 using become:), it is essential to compute next before aBlock value: inst.
+ 	 Only count until thisContext since evaluation of aBlock will create new contexts."
+ 	inst := self someInstance.
+ 	[inst == thisContext or: [inst == nil]] whileFalse:
+ 		[next := inst nextInstance.
+ 		 aBlock value: inst.
+ 		 inst := next]!

Item was changed:
+ ----- Method: SpurBootstrap class>>MethodContextPROTOTYPEallInstances (in category 'method prototypes squeak') -----
- ----- Method: SpurBootstrap class>>MethodContextPROTOTYPEallInstances (in category 'method prototypes') -----
  MethodContextPROTOTYPEallInstances
  	"Answer all instances of the receiver."
  	<primitive: 177>
  	"The primitive can fail because memory is low.  If so, fall back on the old
  	 enumeration code, which gives the system a chance to GC and/or grow.
  	 Because aBlock might change the class of inst (for example, using become:),
  	 it is essential to compute next before aBlock value: inst.
  	 Only count until thisContext since this context has been created only to
  	 compute the existing instances."
  	| inst insts next |
  	insts := WriteStream on: (Array new: 64).
  	inst := self someInstance.
  	[inst == thisContext or: [inst == nil]] whileFalse:
  		[next := inst nextInstance.
  		 insts nextPut: inst.
  		 inst := next].
  	^insts contents!

Item was changed:
+ ----- Method: SpurBootstrap class>>MethodContextPROTOTYPEallInstancesDo: (in category 'method prototypes squeak') -----
- ----- Method: SpurBootstrap class>>MethodContextPROTOTYPEallInstancesDo: (in category 'method prototypes') -----
  MethodContextPROTOTYPEallInstancesDo: aBlock
  	"Evaluate aBlock with each of the current instances of the receiver."
  	| instances inst next |
  	instances := self allInstancesOrNil.
  	instances ifNotNil:
  		[instances do: aBlock.
  		 ^self].
  	"allInstancesOrNil can fail because memory is low.  If so, fall back on the old
  	 enumeration code.  Because aBlock might change the class of inst (for example,
  	 using become:), it is essential to compute next before aBlock value: inst.
  	 Only count until thisContext since evaluation of aBlock will create new contexts."
  	inst := self someInstance.
  	[inst == thisContext or: [inst == nil]] whileFalse:
  		[next := inst nextInstance.
  		 aBlock value: inst.
  		 inst := next]!

Item was added:
+ ----- Method: SpurBootstrap class>>ProtoObjectPROTOTYPEidentityHash (in category 'method prototypes pharo') -----
+ ProtoObjectPROTOTYPEidentityHash
+ 	"For identityHash values returned by primitive 75, answer
+ 	 such values times 2^8.  Otherwise, match the existing
+ 	 identityHash implementation"
+ 
+ 	^self basicIdentityHash * 256 "bitShift: 8"!

Item was changed:
+ ----- Method: SpurBootstrap class>>ProtoObjectPROTOTYPEscaledIdentityHash (in category 'method prototypes squeak') -----
- ----- Method: SpurBootstrap class>>ProtoObjectPROTOTYPEscaledIdentityHash (in category 'method prototypes') -----
  ProtoObjectPROTOTYPEscaledIdentityHash
  	"For identityHash values returned by primitive 75, answer
  	 such values times 2^8.  Otherwise, match the existing
  	 identityHash implementation"
  
  	^self identityHash * 256 "bitShift: 8"!

Item was added:
+ ----- Method: SpurBootstrap class>>SlotClassBuilderPROTOTYPEcomputeFormat:instSize:forSuper:ccIndex: (in category 'as yet unclassified') -----
+ SlotClassBuilderPROTOTYPEcomputeFormat: type instSize: newInstSize forSuper: newSuper ccIndex: ccIndex
+ 	"Compute the new format for making oldClass a subclass of newSuper.
+ 	 Answer the format or nil if there is any problem."
+ 	| instSize isVar isWords isPointers isWeak |
+ 	type == #compiledMethod ifTrue:
+ 		[newInstSize > 0 ifTrue:
+ 			[self error: 'A compiled method class cannot have named instance variables'.
+ 			^nil].
+ 		^CompiledMethod format].
+ 	instSize := newInstSize + (newSuper ifNil:[0] ifNotNil:[newSuper instSize]).
+ 	instSize > 65535 ifTrue:
+ 		[self error: 'Class has too many instance variables (', instSize printString,')'.
+ 		^nil].
+ 	type == #normal ifTrue:[isVar := isWeak := false. isWords := isPointers := true].
+ 	type == #bytes ifTrue:[isVar := true. isWords := isPointers := isWeak := false].
+ 	type == #words ifTrue:[isVar := isWords := true. isPointers := isWeak := false].
+ 	type == #variable ifTrue:[isVar := isPointers := isWords := true. isWeak := false].
+ 	type == #weak ifTrue:[isVar := isWeak := isWords := isPointers := true].
+ 	type == #ephemeron ifTrue:[isVar := false. isWeak := isWords := isPointers := true].
+ 	type == #immediate ifTrue:[isVar := isWeak := isPointers := false. isWords := true].
+ 	(isPointers not and: [instSize > 0]) ifTrue:
+ 		[self error: 'A non-pointer class cannot have named instance variables'.
+ 		^nil].
+ 	^self format: instSize variable: isVar words: isWords pointers: isPointers weak: isWeak!

Item was added:
+ ----- Method: SpurBootstrap class>>SlotClassBuilderPROTOTYPEformat:variable:words:pointers:weak: (in category 'as yet unclassified') -----
+ SlotClassBuilderPROTOTYPEformat: nInstVars variable: isVar words: isWords pointers: isPointers weak: isWeak
+ 	"Compute the format for the given instance specfication.
+ 	 Above Cog Spur the class format is
+ 		<5 bits inst spec><16 bits inst size>
+ 	 where the 5-bit inst spec is
+ 			0	= 0 sized objects (UndefinedObject True False et al)
+ 			1	= non-indexable objects with inst vars (Point et al)
+ 			2	= indexable objects with no inst vars (Array et al)
+ 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 			4	= weak indexable objects with inst vars (WeakArray et al)
+ 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 			6	= unused
+ 			7	= immediates (SmallInteger, Character)
+ 			8	= unused
+ 			9	= reserved for 64-bit indexable
+ 		10-11	= 32-bit indexable (Bitmap)
+ 		12-15	= 16-bit indexable
+ 		16-23	= 8-bit indexable
+ 		24-31	= compiled methods (CompiledMethod)"
+ 	| instSpec |
+ 	instSpec := isWeak
+ 					ifTrue:
+ 						[isVar
+ 							ifTrue: [4]
+ 							ifFalse: [5]]
+ 					ifFalse:
+ 						[isPointers
+ 							ifTrue:
+ 								[isVar
+ 									ifTrue: [nInstVars > 0 ifTrue: [3] ifFalse: [2]]
+ 									ifFalse: [nInstVars > 0 ifTrue: [1] ifFalse: [0]]]
+ 							ifFalse:
+ 								[isVar
+ 									ifTrue: [isWords ifTrue: [12] ifFalse: [16]]
+ 									ifFalse: [7]]].
+ 	^(instSpec bitShift: 16) + nInstVars!

Item was added:
+ ----- Method: SpurBootstrap class>>SlotClassBuilderPROTOTYPEsuperclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'as yet unclassified') -----
+ SlotClassBuilderPROTOTYPEsuperclass: aClass
+ 	immediateSubclass: t instanceVariableNames: f 
+ 	classVariableNames: d poolDictionaries: s category: cat
+ 	"This is the standard initialization message for creating a
+ 	 new immediate class as a subclass of an existing class."
+ 	| env |
+ 	aClass instSize > 0
+ 		ifTrue: [^self error: 'cannot make an immediate subclass of a class with named fields'].
+ 	aClass isVariable
+ 		ifTrue: [^self error: 'cannot make an immediate subclass of a class with indexed instance variables'].
+ 	aClass isPointers
+ 		ifFalse: [^self error: 'cannot make an immediate subclass of a class without pointer fields'].
+ 	"Cope with pre-environment and environment versions. Simplify asap."
+ 	env := (Smalltalk classNamed: #EnvironmentRequest)
+ 				ifNil: [aClass environment]
+ 				ifNotNil: [:erc| erc signal ifNil: [aClass environment]].
+ 	^self 
+ 		name: t
+ 		inEnvironment: env
+ 		subclassOf: aClass
+ 		type: #immediate
+ 		instanceVariableNames: f
+ 		classVariableNames: d
+ 		poolDictionaries: s
+ 		category: cat!

Item was added:
+ ----- Method: SpurBootstrap class>>SlotClassBuilderPROTOTYPEupdate:to: (in category 'as yet unclassified') -----
+ SlotClassBuilderPROTOTYPEupdate: oldClass to: newClass
+ 	"Convert oldClass, all its instances and possibly its meta class into newClass,
+ 	 instances of newClass and possibly its meta class. The process is surprisingly
+ 	 simple in its implementation and surprisingly complex in its nuances and potentially
+ 	 bad side effects.
+ 	 We can rely on two assumptions (which are critical):
+ 		#1: The method #updateInstancesFrom: will not create any lasting pointers to
+ 			 'old' instances ('old' is quote on quote since #updateInstancesFrom: will do
+ 			 a become of the old vs. the new instances and therefore it will not create
+ 			 pointers to *new* instances before the #become: which are *old* afterwards)
+ 		#2: The non-preemptive execution of the critical piece of code guarantees that
+ 			 nobody can get a hold by 'other means' (such as process interruption and
+ 			 reflection) on the old instances.
+ 	 Given the above two, we know that after #updateInstancesFrom: there are no pointers
+ 	 to any old instances. After the forwarding become there will be no pointers to the old
+ 	 class or meta class either.
+ 	 Andreas Raab, 2/27/2003 23:42"
+ 	| meta |
+ 	meta := oldClass isMeta.
+ 	"Note: Everything from here on will run without the ability to get interrupted
+ 	to prevent any other process to create new instances of the old class."
+ 	["Note: The following removal may look somewhat obscure and needs an explanation.
+ 	  When we mutate the class hierarchy we create new classes for any existing subclass.
+ 	  So it may look as if we don't have to remove the old class from its superclass. However,
+ 	  at the top of the hierarchy (the first class we reshape) that superclass itself is not newly
+ 	  created so therefore it will hold both the oldClass and newClass in its (obsolete or not)
+ 	  subclasses. Since the #become: below will transparently replace the pointers to oldClass
+ 	  with newClass the superclass would have newClass in its subclasses TWICE. With rather
+ 	  unclear effects if we consider that we may convert the meta-class hierarchy itself (which
+ 	  is derived from the non-meta class hierarchy).
+ 	  Due to this problem ALL classes are removed from their superclass just prior to converting
+ 	  them. Here, breaking the superclass/subclass invariant really doesn't matter since we will
+ 	  effectively remove the oldClass (becomeForward:) just a few lines below."
+ 
+ 		oldClass superclass removeSubclass: oldClass.
+ 		oldClass superclass removeObsoleteSubclass: oldClass.
+ 
+ 		"make sure that the VM cache is clean"
+ 		oldClass methodDict do: [:cm | cm flushCache].
+ 		
+ 		"Convert the instances of oldClass into instances of newClass"
+ 		newClass updateInstancesFrom: oldClass.
+ 
+ 		meta
+ 			ifTrue:
+ 				[oldClass becomeForward: newClass.
+ 				 oldClass updateMethodBindingsTo: oldClass binding]
+ 			ifFalse:
+ 				[{oldClass. oldClass class} elementsForwardIdentityTo: {newClass. newClass class}.
+ 				 oldClass updateMethodBindingsTo: oldClass binding.
+ 				 oldClass class updateMethodBindingsTo: oldClass class binding].
+ 
+ 		"eem 5/31/2014 07:22 At this point there used to be a garbage collect whose purpose was
+ 		 to ensure no old instances existed after the becomeForward:.  Without the GC it was possible
+ 		 to resurrect old instances using e.g. allInstancesDo:.  This was because the becomeForward:
+ 		 updated references from the old objects to new objects but didn't destroy the old objects.
+ 		 But as of late 2013/early 2014 becomeForward: has been modified to free all the old objects."]
+ 			valueUnpreemptively!

Item was changed:
+ ----- Method: SpurBootstrap class>>SmalltalkImagePROTOTYPEsetGCParameters (in category 'method prototypes squeak') -----
- ----- Method: SpurBootstrap class>>SmalltalkImagePROTOTYPEsetGCParameters (in category 'method prototypes') -----
  SmalltalkImagePROTOTYPEsetGCParameters
  	"Adjust the VM's default GC parameters to avoid too much tenuring.
  	 Maybe this should be left to the VM?"
  
  	| proportion edenSize survivorSize averageObjectSize numObjects |
  	proportion := 0.9. "tenure when 90% of pastSpace is full"
  	edenSize := SmalltalkImage current vmParameterAt: 44.
  	survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
  	averageObjectSize := 8 * self wordSize. "a good approximation"
  	numObjects := (proportion * survivorSize / averageObjectSize) rounded.
  	SmalltalkImage current vmParameterAt: 6 put: numObjects  "tenure when more than this many objects survive the GC"!

Item was changed:
+ ----- Method: SpurBootstrap class>>SystemDictionaryPROTOTYPEsetGCParameters (in category 'method prototypes squeak') -----
- ----- Method: SpurBootstrap class>>SystemDictionaryPROTOTYPEsetGCParameters (in category 'method prototypes') -----
  SystemDictionaryPROTOTYPEsetGCParameters
  	"Adjust the VM's default GC parameters to avoid too much tenuring.
  	 Maybe this should be left to the VM?"
  
  	| proportion edenSize survivorSize averageObjectSize numObjects |
  	proportion := 0.9. "tenure when 90% of pastSpace is full"
  	edenSize := SmalltalkImage current vmParameterAt: 44.
  	survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
  	averageObjectSize := 8 * self wordSize. "a good approximation"
  	numObjects := (proportion * survivorSize / averageObjectSize) rounded.
  	SmalltalkImage current vmParameterAt: 6 put: numObjects  "tenure when more than this many objects survive the GC"!

Item was added:
+ ----- Method: SpurBootstrap class>>TraitBehaviorPROTOTYPEallInstances (in category 'method prototypes pharo') -----
+ TraitBehaviorPROTOTYPEallInstances
+ 	"Answer all instances of the receiver."
+ 	self error: 'Traits does not have instances.'!

Item was added:
+ ----- Method: SpurBootstrap class>>TraitBehaviorPROTOTYPEallInstancesDo: (in category 'method prototypes pharo') -----
+ TraitBehaviorPROTOTYPEallInstancesDo: aBlock
+ 	"Evaluate aBlock with each of the current instances of the receiver."
+ 	self error: 'Traits does not have instances.'!

Item was added:
+ ----- Method: SpurBootstrap class>>TraitBehaviorPROTOTYPEinstSpec (in category 'method prototypes pharo') -----
+ TraitBehaviorPROTOTYPEinstSpec
+ 	"Answer the instance specification part of the format that defines what kind of object
+ 	 an instance of the receiver is.  The formats are
+ 			0	= 0 sized objects (UndefinedObject True False et al)
+ 			1	= non-indexable objects with inst vars (Point et al)
+ 			2	= indexable objects with no inst vars (Array et al)
+ 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 			4	= weak indexable objects with inst vars (WeakArray et al)
+ 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 			6	= unused
+ 			7	= immediates (SmallInteger, Character)
+ 			8	= unused
+ 			9	= 64-bit indexable
+ 		10-11	= 32-bit indexable (Bitmap)
+ 		12-15	= 16-bit indexable
+ 		16-23	= 8-bit indexable
+ 		24-31	= compiled methods (CompiledMethod)"
+ 	^(format bitShift: -16) bitAnd: 16r1F!

Item was added:
+ ----- Method: SpurBootstrap class>>TraitBehaviorPROTOTYPEisBits (in category 'method prototypes pharo') -----
+ TraitBehaviorPROTOTYPEisBits
+ 	"Answer whether the receiver contains just bits (not pointers).
+ 	 Above Cog Spur the class format is
+ 		<5 bits inst spec><16 bits inst size>
+ 	 where the 5-bit inst spec is
+ 			0	= 0 sized objects (UndefinedObject True False et al)
+ 			1	= non-indexable objects with inst vars (Point et al)
+ 			2	= indexable objects with no inst vars (Array et al)
+ 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 			4	= weak indexable objects with inst vars (WeakArray et al)
+ 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 			6	= unused
+ 			7	= immediates (SmallInteger, Character)
+ 			8	= unused
+ 			9	= 64-bit indexable
+ 		10-11	= 32-bit indexable (Bitmap)
+ 		12-15	= 16-bit indexable
+ 		16-23	= 8-bit indexable
+ 		24-31	= compiled methods (CompiledMethod)"
+ 	^self instSpec >= 7!

Item was added:
+ ----- Method: SpurBootstrap class>>TraitBehaviorPROTOTYPEisBytes (in category 'method prototypes pharo') -----
+ TraitBehaviorPROTOTYPEisBytes
+ 	"Answer whether the receiver has 8-bit instance variables.
+ 	 Above Cog Spur the class format is
+ 		<5 bits inst spec><16 bits inst size>
+ 	 where the 5-bit inst spec is
+ 			0	= 0 sized objects (UndefinedObject True False et al)
+ 			1	= non-indexable objects with inst vars (Point et al)
+ 			2	= indexable objects with no inst vars (Array et al)
+ 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 			4	= weak indexable objects with inst vars (WeakArray et al)
+ 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 			6	= unused
+ 			7	= immediates (SmallInteger, Character)
+ 			8	= unused
+ 			9	= 64-bit indexable
+ 		10-11	= 32-bit indexable (Bitmap)
+ 		12-15	= 16-bit indexable
+ 		16-23	= 8-bit indexable
+ 		24-31	= compiled methods (CompiledMethod)"
+ 	^self instSpec >= 16!

Item was added:
+ ----- Method: SpurBootstrap class>>TraitBehaviorPROTOTYPEisEphemeronClass (in category 'method prototypes pharo') -----
+ TraitBehaviorPROTOTYPEisEphemeronClass
+ 	"Answer whether the receiver has ephemeral instance variables.  The garbage collector will
+ 	 fire (queue for finalization) any ephemeron whose first instance variable is not referenced
+ 	 other than from the transitive closure of references from ephemerons. Hence referring to
+ 	 an object from the first inst var of an ephemeron will cause the ephemeron to fire when
+ 	 the rest of the system does not refer to the object and that object is ready to be collected.
+ 	 Since references from the remaining inst vars of an ephemeron will not prevent the ephemeron
+ 	 from firing, ephemerons may act as the associations in weak dictionaries such that the value
+ 	 (e.g. properties attached to the key) will not prevent firing when the key is no longer referenced
+ 	 other than from ephemerons.  Ephemerons can therefore be used to implement instance-based
+ 	 pre-mortem finalization."
+ 	^self instSpec = 5!

Item was added:
+ ----- Method: SpurBootstrap class>>TraitBehaviorPROTOTYPEisImmediateClass (in category 'method prototypes pharo') -----
+ TraitBehaviorPROTOTYPEisImmediateClass
+ 	"Answer whether the receiver has immediate instances.  Immediate instances
+ 	 store their value in their object pointer, not in an object body.  Hence immediates
+ 	 take no space and are immutable.  The immediates are distinguished by tag bits
+ 	 in the pointer. They include SmallIntegers and Characters.  Hence in the 32-bit
+ 	 system SmallIntegers are 31-bit signed integers and Characters are 30-bit
+ 	 unsigned character codes."
+ 	^self instSpec = 7!

Item was added:
+ ----- Method: SpurBootstrap class>>TraitBehaviorPROTOTYPEisVariable (in category 'method prototypes pharo') -----
+ TraitBehaviorPROTOTYPEisVariable
+ 	"Answer whether the receiver has indexable variables.
+ 	 Above Cog Spur the class format is
+ 		<5 bits inst spec><16 bits inst size>
+ 	 where the 5-bit inst spec is
+ 			0	= 0 sized objects (UndefinedObject True False et al)
+ 			1	= non-indexable objects with inst vars (Point et al)
+ 			2	= indexable objects with no inst vars (Array et al)
+ 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 			4	= weak indexable objects with inst vars (WeakArray et al)
+ 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 			6	= unused
+ 			7	= immediates (SmallInteger, Character)
+ 			8	= unused
+ 			9	= 64-bit indexable
+ 		10-11	= 32-bit indexable (Bitmap)
+ 		12-15	= 16-bit indexable
+ 		16-23	= 8-bit indexable
+ 		24-31	= compiled methods (CompiledMethod)"
+ 	| instSpec |
+ 	instSpec := self instSpec.
+ 	^instSpec >= 2 and: [instSpec <= 4 or: [instSpec >= 9]]!

Item was added:
+ ----- Method: SpurBootstrap class>>TraitBehaviorPROTOTYPEkindOfSubclass (in category 'method prototypes pharo') -----
+ TraitBehaviorPROTOTYPEkindOfSubclass
+ 	"Answer a String that is the keyword that describes the receiver's kind of subclass,
+ 	 either a regular subclass, a variableSubclass, a variableByteSubclass,
+ 	 a variableWordSubclass, a weakSubclass, an ephemeronSubclass or an immediateSubclass.
+ 	 c.f. typeOfClass"
+ 	^self isVariable
+ 		ifTrue:
+ 			[self isBits
+ 				ifTrue:
+ 					[self isBytes
+ 						ifTrue: [' variableByteSubclass: ']
+ 						ifFalse: [' variableWordSubclass: ']]
+ 				ifFalse:
+ 					[self isWeak
+ 						ifTrue: [' weakSubclass: ']
+ 						ifFalse: [' variableSubclass: ']]]
+ 		ifFalse:
+ 			[self isImmediateClass
+ 				ifTrue: [' immediateSubclass: ']
+ 				ifFalse:
+ 					[self isEphemeronClass
+ 						ifTrue: [' ephemeronSubclass: ']
+ 						ifFalse: [' subclass: ']]]!

Item was added:
+ ----- Method: SpurBootstrap class>>VirtualMachinePROTOTYPEsetGCParameters (in category 'method prototypes pharo') -----
+ VirtualMachinePROTOTYPEsetGCParameters
+ 	"Adjust the VM's default GC parameters to avoid too much tenuring.
+ 	 Maybe this should be left to the VM?"
+ 
+ 	| proportion edenSize survivorSize averageObjectSize numObjects |
+ 	proportion := 0.9. "tenure when 90% of pastSpace is full"
+ 	edenSize := self parameterAt: 44.
+ 	survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
+ 	averageObjectSize := 8 * self wordSize. "a good approximation"
+ 	numObjects := (proportion * survivorSize / averageObjectSize) rounded.
+ 	self tenuringThreshold: numObjects  "tenure when more than this many objects survive the GC"!

Item was changed:
  ----- Method: SpurBootstrap class>>bootstrapImage: (in category 'utilities') -----
  bootstrapImage: imageFileBaseName
+ 	self bootstrapSqueakImage: imageFileBaseName!
- 	"SpurBootstrap bootstrapImage: '/Users/eliot/Squeak/Squeak4.5/Squeak4.5-13680'"
- 	| imageFormat |
- 	imageFormat := ImageFormat fromFile: imageFileBaseName, '.image'.
- 	imageFormat requiresClosureSupport ifFalse:
- 		[self error: 'Can''t bootstrap this image since Spur assumes closure support.'].
- 	imageFormat requiresSpurSupport ifTrue:
- 		[self error: 'This image is already in Spur format.'].
- 	imageFormat is32Bit ifTrue:
- 		[^SpurBootstrap32 new bootstrapImage: imageFileBaseName].
- 	self error: '64-bit support and 64-bit generation as-yet-unimplemented'!

Item was added:
+ ----- Method: SpurBootstrap class>>bootstrapImage:type: (in category 'utilities') -----
+ bootstrapImage: imageFileBaseName type: typeName
+ 	"SpurBootstrap bootstrapImage: '/Users/eliot/Squeak/Squeak4.5/Squeak4.5-13680'"
+ 	| imageFormat |
+ 	imageFormat := ImageFormat fromFile: imageFileBaseName, '.image'.
+ 	imageFormat requiresClosureSupport ifFalse:
+ 		[self error: 'Can''t bootstrap this image since Spur assumes closure support.'].
+ 	imageFormat requiresSpurSupport ifTrue:
+ 		[self error: 'This image is already in Spur format.'].
+ 	imageFormat is32Bit ifTrue:
+ 		[^ SpurBootstrap32 new bootstrapImage: imageFileBaseName type: typeName ].
+ 	self error: '64-bit support and 64-bit generation as-yet-unimplemented'!

Item was added:
+ ----- Method: SpurBootstrap class>>bootstrapPharoImage: (in category 'utilities') -----
+ bootstrapPharoImage: imageFileBaseName
+ 	self bootstrapImage: imageFileBaseName type: 'pharo'!

Item was added:
+ ----- Method: SpurBootstrap class>>bootstrapSqueakImage: (in category 'utilities') -----
+ bootstrapSqueakImage: imageFileBaseName
+ 	self bootstrapImage: imageFileBaseName type: 'squeak'!

Item was changed:
  ----- Method: SpurBootstrap>>addNewMethods (in category 'bootstrap methods') -----
  addNewMethods
  	"Get the simulator to add any and all missing methods immediately."
  	| cmaiaSym basSym |
  	cmaiaSym := self findSymbol: #compiledMethodAt:ifAbsent:.
  	basSym := self findSymbol: #basicAddSelector:withMethod:.
  	basSym ifNil:
  		[basSym := self findSymbol: #addSelectorSilently:withMethod:].
  	self allPrototypeClassNamesDo:
  		[:sym :symIsMeta| | class |
  		class := self findClassNamed: (literalMap at: sym).
  		symIsMeta ifTrue: [class := oldHeap fetchClassOfNonImm: class].
  		self prototypeClassNameMetaSelectorMethodDo:
  			[:className :isMeta :selector :method| | methodOrNil |
  			(className = sym
  			 and: [symIsMeta = isMeta]) ifTrue:
  				["probe method dictionary of the class for each method, installing a dummy if not found."
  				 "Transcript cr; nextPutAll: 'checking for '; nextPutAll: selector; flush."
  				 methodOrNil := self interpreter: oldInterpreter
  									object: class
  									perform: cmaiaSym
  									withArguments: {literalMap at: selector. oldHeap nilObject}.
  				 methodOrNil = oldHeap nilObject
  					ifTrue: "no method.  install the real thing now"
  						[Transcript
  							cr;
  							nextPutAll: 'installing ';
  							nextPutAll: className;
  							nextPutAll: (isMeta ifTrue: [' class>>'] ifFalse: ['>>']);
+ 							nextPutAll: selector printString;
- 							store: selector;
  							flush.
  						 self interpreter: oldInterpreter
  							object: class
  							perform: basSym
  							withArguments: { literalMap at: selector.
  											   self installableMethodFor: method
  												selector: selector
  												className: className
  												isMeta: isMeta}.
  						installedPrototypes add: method selector]
  					ifFalse: "existing method; collect the methodClassAssociation; its needed later"
  						[methodClasses add: (oldInterpreter methodClassAssociationOf: methodOrNil)]]]]!

Item was added:
+ ----- Method: SpurBootstrap>>allPrototypeMethods (in category 'method prototypes') -----
+ allPrototypeMethods
+ 	^ (SpurBootstrap class organization listAtCategoryNamed: #'method prototypes'),
+ 	(SpurBootstrap class organization listAtCategoryNamed: #'method prototypes ', imageType)!

Item was changed:
  ----- Method: SpurBootstrap>>bootstrapImage: (in category 'public access') -----
  bootstrapImage: imageName
  	| dirName baseName dir |
+ 	dirName := imageName asFileReference parent fullName.
- 	dirName := FileDirectory dirPathFor: imageName.
  	baseName := (imageName endsWith: '.image')
+ 		ifTrue: [ imageName asFileReference base ]
+ 		ifFalse: [ (imageName, '.image') asFileReference base ].
+ 	dir := dirName asFileReference.
+ 	self on: (dir / (baseName, '.image')) fullName.
- 					ifTrue: [FileDirectory baseNameFor: imageName]
- 					ifFalse: [FileDirectory localNameFor: imageName].
- 	dir := FileDirectory on: dirName.
- 	self on: (dir fullNameFor: baseName, '.image').
  	[self transform]
  		on: Halt
  		do: [:ex|
  			"suppress halts from the usual suspects (development time halts)"
  			(#(fullGC compactImage) includes: ex signalerContext sender selector)
  				ifTrue: [ex resume]
  				ifFalse: [ex pass]].
+ 	self writeSnapshot: (dir / (baseName, '-spur.image')) fullName
- 	self writeSnapshot: (dir fullNameFor: baseName, '-spur.image')
  		ofTransformedImage: newHeap
  		headerFlags: oldInterpreter getImageHeaderFlags
  		screenSize: oldInterpreter savedWindowSize.
+ 	(dir / (baseName, '.changes')) copyTo: (dir / (baseName, '-spur.changes'))!
- 	dir copyFileNamed: (dir fullNameFor: baseName, '.changes')
- 		toFileNamed: (dir fullNameFor: baseName, '-spur.changes')!

Item was added:
+ ----- Method: SpurBootstrap>>bootstrapImage:type: (in category 'public access') -----
+ bootstrapImage: imageName type: typeName
+ 	"type can be: 
+ 		- 'squeak' 
+ 		- 'pharo'
+ 		- it might be 'newspeak', if needed (but is not implemented)"
+ 	imageType := typeName.
+ 	self bootstrapImage: imageName
+ 	!

Item was changed:
  ----- Method: SpurBootstrap>>findRequiredGlobals (in category 'bootstrap image') -----
  findRequiredGlobals
  	"Look for the necessary gobal bindings in the prototype methods in the old image.
  	 This has to be done early by sending bindingOf: to Smalltalk.  Also find out
  	 Metaclass, needed for identofying classes."
  	| globals bindingOf |
  	globals := Set new.
  	self prototypeClassNameMetaSelectorMethodDo:
  		[:c :m :s :method|
  		globals addAll: (method literals select: [:l|
  										l isVariableBinding
  										and: [l key isSymbol
  										and: [(Smalltalk bindingOf: l key) == l]]])].
  	bindingOf := self findSymbol: #bindingOf:.
  	self withExecutableInterpreter: oldInterpreter
+ 		do:	[globals asArray withIndexDo: 
+ 				[:global :index|
- 		do:	[globals do:
- 				[:global|
  				literalMap
  					at: global
  					put: (self interpreter: oldInterpreter
  							object: (oldHeap splObj: 8) "Smalltalk"
  							perform: bindingOf
  							withArguments: {self findSymbol: global key})]].
  
  	classMetaclass := oldHeap fetchClassOfNonImm: (oldHeap fetchClassOfNonImm: oldHeap classArray)!

Item was added:
+ ----- Method: SpurBootstrap>>initialize (in category 'initialize-release') -----
+ initialize
+ 	super initialize.
+ 	imageType := 'squeak'. "By default, image is Squeak (so Eliot does not kick me :P)"!

Item was changed:
  ----- Method: SpurBootstrap>>interpreter:object:perform:withArguments: (in category 'bootstrap methods') -----
  interpreter: sim object: receiver perform: selector withArguments: arguments
  	"Interpret an expression in oldHeap using oldInterpreter.
  	 Answer the result."
  	| fp savedpc savedsp result startByteCount |
  	savedpc := sim localIP.
  	savedsp := sim localSP.
  	sim internalPush: receiver.
  	arguments do: [:arg| sim internalPush: arg].
  	sim
  		argumentCount: arguments size;
  		messageSelector: selector.
  	fp := sim localFP.
  	startByteCount := sim byteCount.
  	"sim byteCount = 66849 ifTrue: [self halt]."
  	sim normalSend.
  	sim incrementByteCount. "otherwise, send is not counted"
  	["sim byteCount = 66849 ifTrue: [self halt]."
  	 "(sim byteCount > 7508930 and: [sim localFP = -16r27894]) ifTrue:
  		[self halt]."
  	 fp = sim localFP] whileFalse:
  		[sim singleStep].
  	result := sim internalPopStack.
  	self assert: savedsp = sim localSP.
  	self assert: sim localIP - 1 = savedpc.
  	sim localIP: savedpc.
  	^result!

Item was changed:
  ----- Method: SpurBootstrap>>prototypeClassNameMetaSelectorMethodDo: (in category 'method prototypes') -----
  prototypeClassNameMetaSelectorMethodDo: quaternaryBlock
  	"Evaluate aBlock with class name, class is meta, method and selector.
  	 For now find methods in class-side category #'method prototypes'.
  	 Scheme could be extended to have different protocols for different
  	 Squeak/Pharo versions."
+ 	self allPrototypeMethods do:
- 	(SpurBootstrap class organization listAtCategoryNamed: #'method prototypes') do:
  		[:protoSelector| | method className isMeta |
  		method := SpurBootstrap class >> protoSelector.
  		className := self classNameForPrototypeMethod: method.
  		(isMeta := className endsWith: 'class') ifTrue:
  			[className := (className allButLast: 5) asSymbol].
  		quaternaryBlock
  			value: className
  			value: isMeta
  			value: (self selectorForPrototypeMethod: method)
  			value: method]!

Item was changed:
  ----- Method: SpurBootstrap>>rehashImage (in category 'bootstrap image') -----
  rehashImage
  	"Rehash all collections in newHeap.
  	 Find out which classes implement rehash, entering a 1 against their classIndex in rehashFlags.
  	 Enumerate all objects, rehashing those whose class has a bit set in rehashFlags."
  	| n sim rehashFlags |
  	sim := StackInterpreterSimulator onObjectMemory: newHeap.
+ 	sim imageName: 'spur image'.
  	newHeap coInterpreter: sim.
  	sim bootstrapping: true.
  	sim initializeInterpreter: 0.
  	sim instVarNamed: 'methodDictLinearSearchLimit' put: SmallInteger maxVal.
  
  	newHeap
  		setHashBitsOf: newHeap nilObject to: 1;
  		setHashBitsOf: newHeap falseObject to: 2;
  		setHashBitsOf: newHeap trueObject to: 3.
  
  	rehashFlags := ByteArray new: newHeap numClassTablePages * newHeap classTablePageSize.
  	n := 0.
  	newHeap classTableObjectsDo:
  		[:class| | classIndex |
  		sim messageSelector: (map at: rehashSym).
  		"Lookup rehash but don't be fooled by ProtoObject>>rehash, which is just ^self."
  		((sim lookupMethodNoMNUEtcInClass: class) = 0
  		 and: [(sim isQuickPrimitiveIndex: (sim primitiveIndexOf: (sim instVarNamed: 'newMethod'))) not]) ifTrue:
  			[n := n + 1.
  			 classIndex := newHeap rawHashBitsOf: class.
  			 rehashFlags
  				at: classIndex >> 3 + 1
  				put: ((rehashFlags at: classIndex >> 3 + 1)
  						bitOr: (1 << (classIndex bitAnd: 7)))]].
  	Transcript cr; print: n; nextPutAll: ' classes understand rehash. rehashing instances...'; flush.
  	n := 0.
  	self withExecutableInterpreter: sim
  		do: [sim setBreakSelector: 'error:'.
  			 "don't rehash twice (actually without limit), so don't rehash any new objects created."
  			 newHeap allExistingOldSpaceObjectsDo:
  				[:o| | classIndex |
  				classIndex := newHeap classIndexOf: o.
  				((rehashFlags at: classIndex >> 3 + 1) anyMask: 1 << (classIndex bitAnd: 7)) ifTrue:
  					[(n := n + 1) \\ 8 = 0 ifTrue:
  					 	[Transcript nextPut: $.; flush].
  					 "2845 = n ifTrue: [self halt]."
  					 "Rehash an object if its size is > 0.
  					  Symbol implements rehash, but let's not waste time rehashing it; in Squeak
  					  up to 2013 symbols are kept in a set which will get reashed anyway..
  					  Don't rehash empty collections; they may be large for a reason and rehashing will shrink them."
  					 ((sim addressCouldBeClassObj: o)
  					   or: [(self interpreter: sim
  							object: o
  							perform: (map at: sizeSym)
  							withArguments: #()) = (newHeap integerObjectOf: 0)]) ifFalse:
  						[self interpreter: sim
  							object: o
  							perform: (map at: rehashSym)
  							withArguments: #()]]]]!

Item was changed:
  ----- Method: SpurBootstrap>>replaceMethods (in category 'bootstrap methods') -----
  replaceMethods
  	"Replace all the modified method prototypes."
  	self allPrototypeClassNamesDo:
  		[:sym :symIsMeta| | class |
  		class := self findClassNamed: (literalMap at: sym).
  		symIsMeta ifTrue: [class := oldHeap fetchClassOfNonImm: class].
  		self prototypeClassNameMetaSelectorMethodDo:
  			[:className :isMeta :selector :method| | replacement methodDict index |
  			(className = sym
  			 and: [symIsMeta = isMeta]) ifTrue:
  				[(installedPrototypes includes: method selector) ifFalse:
  					["probe method dictionary of the class for each method, installing a dummy if not found."
  					Transcript
  						cr;
  						nextPutAll: 'replacing ';
  						nextPutAll: className;
  						nextPutAll: (isMeta ifTrue: [' class>>'] ifFalse: ['>>']);
+ 						nextPutAll: selector printString;
- 						store: selector;
  						flush.
  					replacement := self installableMethodFor: method
  										selector: selector
  										className: className
  										isMeta: isMeta.
  					methodDict := oldHeap fetchPointer: MethodDictionaryIndex ofObject: class.
  					index := self indexOfSelector: (literalMap at: selector) in: methodDict.
  					oldHeap
  						storePointer: index - SelectorStart
  						ofObject: (oldHeap fetchPointer: MethodArrayIndex ofObject: methodDict)
  						withValue: replacement.
  					installedPrototypes add: method selector]]]]!

Item was changed:
  ----- Method: SpurBootstrap>>validate (in category 'bootstrap image') -----
  validate
  	| p n duplicates maxClassIndex savedEndOfMemory |
  	self assert: (reverseMap at: newHeap specialObjectsOop) = oldHeap specialObjectsOop.
  	self assert: (map at: oldHeap specialObjectsOop) = newHeap specialObjectsOop.
  	self assert: (reverseMap at: newHeap classTableRootObj ifAbsent: []) isNil.
  
  	duplicates := { 3. newHeap arrayClassIndexPun. newHeap weakArrayClassIndexPun }.
  	maxClassIndex := classToIndex inject: 0 into: [:a :b| a max: b].
  	self assert: ((newHeap arrayClassIndexPun to: maxClassIndex) select:
  					[:idx| | classObj |
  					(classObj := newHeap classOrNilAtIndex: idx) ~= newHeap nilObject
  					and: [(newHeap classIndexOf: classObj) = (newHeap rawHashBitsOf: classObj)]]) isEmpty.
  	0 to: maxClassIndex do:
  		[:index| | classObj |
  		(index <= newHeap tagMask
  		 and: [index > newHeap isForwardedObjectClassIndexPun]) ifTrue:
  			[(classObj := newHeap classOrNilAtIndex: index) = newHeap nilObject
  				ifTrue:
  					[self assert: (classToIndex keyAtValue: index ifAbsent: []) isNil]
  				ifFalse:
  					[self assert: (newHeap classIndexOf: classObj) ~= (newHeap rawHashBitsOf: classObj).
  					(duplicates includes: index) ifFalse:
  						[self assert: (newHeap rawHashBitsOf: classObj) = index]]]].
  	classToIndex keysAndValuesDo:
  		[:oldClass :idx|
  		self assert: (newHeap rawHashBitsOf: (map at: oldClass)) = idx. 
  		self assert: oldClass = (reverseMap at: (newHeap classAtIndex: idx))].
  	n := 0.
  	savedEndOfMemory := newHeap endOfMemory.
  	newHeap setEndOfMemory: newHeap freeOldSpaceStart.
  	newHeap allObjectsDo:
  		[:o|
  		(o <= newHeap trueObject
  		 or: [o > lastClassTablePage]) ifTrue:
  			[self assert: (reverseMap includesKey: o).
  			 self assert: (newHeap fetchClassOfNonImm: o) = (map at: (oldHeap fetchClassOfNonImm: (reverseMap at: o)))].
  		n := n + 1.
  		p := o].
  	newHeap setEndOfMemory: savedEndOfMemory.
  	self touch: p.
+ 	self assert: (n between: map size and: map size + 8). "+ 6 is room for freelists & classTable"
- 	self assert: (n between: map size and: map size + 6). "+ 6 is room for freelists & classTable"
  
  	"check some class properties to ensure the format changes are correct"
  	self assert: (newHeap fixedFieldsOfClassFormat: (newHeap formatOfClass: newHeap classArray)) = 0.
  	self assert: (newHeap instSpecOfClassFormat: (newHeap formatOfClass: newHeap classArray)) = newHeap arrayFormat!

Item was changed:
  ----- Method: SpurBootstrap>>withExecutableInterpreter:do: (in category 'bootstrap methods') -----
  withExecutableInterpreter: sim do: aBlock
  	"With the oldInterpreter ready to execute code, evaluate aBlock,
  	 then return the interpreter (and the heap) to the ``just snapshotted'' state."
  	| savedpc initialContext finalContext |
  	sim
  		initStackPages;
  		loadInitialContext;
  		internalizeIPandSP.
  	initialContext := sim frameContext: sim localFP.
  	savedpc := sim localIP.
  	"sim printHeadFrame."
  	aBlock value.
  	"sim printHeadFrame."
  	sim
  		internalPush: sim localIP;
  		externalizeIPandSP.
  	"now undo the execution state"
  	finalContext := sim voidVMStateForSnapshotFlushingExternalPrimitivesIf: false.
  	self assert: initialContext = finalContext.
  	self assert: sim localIP = savedpc.
  	sim objectMemory
  		storePointer: SuspendedContextIndex
  		ofObject: sim activeProcess
  		withValue: finalContext!



More information about the Vm-dev mailing list