[Vm-dev] VM Maker: Cog-eem.166.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Jul 8 22:54:47 UTC 2014
Eliot Miranda uploaded a new version of Cog to project VM Maker:
http://source.squeak.org/VMMaker/Cog-eem.166.mcz
==================== Summary ====================
Name: Cog-eem.166
Author: eem
Time: 8 July 2014, 3:54:28.217 pm
UUID: 774fc1cc-c3ca-484e-ae0d-e316da85742a
Ancestors: Cog-eem.163
Merge with Cog.pharo-EstebanLorenzano.165. Thanks
to Esteban for the Pharo code!!
Split Pharo-specific and Squeak-specific prototypes out into
their own categories. Provide an outer bootstrap method
for both FileReference and FileDirectory.
Nuke the class side bootstrapImage: convenience
in favour of dialect-specific conveniences.
=============== Diff against Cog-eem.163 ===============
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 added:
+ ----- Method: SpurBootstrap class>>BehaviorPROTOTYPElargeIdentityHash (in category 'method prototypes pharo') -----
+ BehaviorPROTOTYPElargeIdentityHash
+ "Answer a SmallInteger whose value is related to the receiver's identity.
+ Behavior implements identityHash to allow the VM to use an object representation which
+ does not include a direct reference to an object's class in an object. If the VM is using
+ this implementation then classes are held in a class table and instances contain the index
+ of their class in the table. A class's class table index is its identityHash so that an instance
+ can be created without searching the table for a class's index. The VM uses this primitive
+ to enter the class into the class table, assigning its identityHash with an as yet unused
+ class table index. If this primitive fails it means that the class table is full. In Spur as of
+ 2014 there are 22 bits of classTable index and 22 bits of identityHash per object."
+
+ <primitive: 175>
+ self primitiveFailed!
Item was added:
+ ----- Method: SpurBootstrap class>>CharacterPROTOTYPEcodePoint (in category 'method prototypes pharo') -----
+ CharacterPROTOTYPEcodePoint
+ "Just for ANSI Compliance"
+ ^self!
Item was added:
+ ----- Method: SpurBootstrap class>>CharacterclassPROTOTYPEinitialize (in category 'method prototypes') -----
+ CharacterclassPROTOTYPEinitialize
+ "Create the DigitsValues table."
+ "Character initialize"
+ self initializeDigitValues!
Item was changed:
+ ----- Method: SpurBootstrap class>>ClassBuilderPROTOTYPEcomputeFormat:instSize:forSuper:ccIndex: (in category 'method prototypes squeak') -----
- ----- 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 squeak') -----
- ----- 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 squeak') -----
- ----- 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 squeak') -----
- ----- 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 changed:
+ ----- Method: SpurBootstrap class>>ClassDescriptionPROTOTYPEupdateMethodBindingsTo: (in category 'method prototypes squeak') -----
- ----- Method: SpurBootstrap class>>ClassDescriptionPROTOTYPEupdateMethodBindingsTo: (in category 'method prototypes') -----
ClassDescriptionPROTOTYPEupdateMethodBindingsTo: aBinding
"ClassBuilder support for maintaining valid method bindings."
methodDict do: [:method| method methodClassAssociation: aBinding]!
Item was changed:
+ ----- Method: SpurBootstrap class>>ClassPROTOTYPEimmediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes squeak') -----
- ----- Method: SpurBootstrap class>>ClassPROTOTYPEimmediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes') -----
ClassPROTOTYPEimmediateSubclass: 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 (the receiver)."
^ClassBuilder new
superclass: self
immediateSubclass: t
instanceVariableNames: f
classVariableNames: d
poolDictionaries: s
category: cat!
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 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 'method prototypes pharo') -----
+ 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 'method prototypes pharo') -----
+ 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 'method prototypes pharo') -----
+ 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 'method prototypes pharo') -----
+ 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 removed:
- ----- Method: SpurBootstrap class>>bootstrapImage: (in category 'utilities') -----
- bootstrapImage: 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 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
+ (Smalltalk classNamed: #FileReference) ifNotNil:
+ [^self bootstrapImageUsingFileReference: imageName].
+ (Smalltalk classNamed: #FileDirectory) ifNotNil:
+ [^self bootstrapImageUsingFileDirectory: imageName].
+ self error: 'at a loss as to what file system support to use'!
- | dirName baseName dir |
- dirName := FileDirectory dirPathFor: imageName.
- baseName := (imageName endsWith: '.image')
- 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 fullNameFor: baseName, '-spur.image')
- ofTransformedImage: newHeap
- headerFlags: oldInterpreter getImageHeaderFlags
- screenSize: oldInterpreter savedWindowSize.
- 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 added:
+ ----- Method: SpurBootstrap>>bootstrapImageUsingFileDirectory: (in category 'public access') -----
+ bootstrapImageUsingFileDirectory: imageName
+ | dirName baseName dir |
+ dirName := FileDirectory dirPathFor: imageName.
+ baseName := (imageName endsWith: '.image')
+ 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 fullNameFor: baseName, '-spur.image')
+ ofTransformedImage: newHeap
+ headerFlags: oldInterpreter getImageHeaderFlags
+ screenSize: oldInterpreter savedWindowSize.
+ dir copyFileNamed: (dir fullNameFor: baseName, '.changes')
+ toFileNamed: (dir fullNameFor: baseName, '-spur.changes')!
Item was added:
+ ----- Method: SpurBootstrap>>bootstrapImageUsingFileReference: (in category 'public access') -----
+ bootstrapImageUsingFileReference: imageName
+ | dirName baseName dir |
+ dirName := imageName asFileReference parent fullName.
+ baseName := (imageName endsWith: '.image')
+ ifTrue: [ imageName asFileReference base ]
+ ifFalse: [ (imageName, '.image') asFileReference base ].
+ dir := dirName asFileReference.
+ self on: (dir / (baseName, '.image')) fullName.
+ [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
+ ofTransformedImage: newHeap
+ headerFlags: oldInterpreter getImageHeaderFlags
+ screenSize: oldInterpreter savedWindowSize.
+ (dir / (baseName, '.changes')) copyTo: (dir / (baseName, '-spur.changes'))!
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>>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>>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 + (imageType = 'squeak'
+ ifTrue: [6]
+ ifFalse: [8])). "+ 6 or 8 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!
More information about the Vm-dev
mailing list