[Vm-dev] VM Maker: Cog.pharo-EstebanLorenzano.175.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Jul 29 10:13:01 UTC 2014
Esteban Lorenzano uploaded a new version of Cog to project VM Maker:
http://source.squeak.org/VMMaker/Cog.pharo-EstebanLorenzano.175.mcz
==================== Summary ====================
Name: Cog.pharo-EstebanLorenzano.175
Author: EstebanLorenzano
Time: 29 July 2014, 12:12:39.440319 pm
UUID: fe465b03-0277-4bc6-9b98-3af92cf63eb5
Ancestors: Cog-EstebanLorenzano.174
new merge with Eliot's
=============== Diff against Cog-eem.173 ===============
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'!
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') -----
- ----- Method: SpurBootstrap class>>ClassBuilderPROTOTYPEcomputeFormat:instSize:forSuper:ccIndex: (in category 'method prototypes squeak') -----
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') -----
- ----- Method: SpurBootstrap class>>ClassBuilderPROTOTYPEformat:variable:words:pointers:weak: (in category 'method prototypes squeak') -----
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') -----
- ----- Method: SpurBootstrap class>>ClassBuilderPROTOTYPEsuperclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes squeak') -----
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') -----
- ----- Method: SpurBootstrap class>>ClassBuilderPROTOTYPEupdate:to: (in category 'method prototypes squeak') -----
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>>IntegerclassPROTOTYPEinitialize (in category 'method prototypes squeak') -----
- ----- Method: SpurBootstrap class>>IntegerclassPROTOTYPEinitialize (in category 'method prototypes') -----
IntegerclassPROTOTYPEinitialize
"Integer initialize"
self initializeLowBitPerByteTable!
Item was changed:
----- Method: SpurBootstrap class>>SmalltalkImagePROTOTYPErecreateSpecialObjectsArray (in category 'method prototypes') -----
SmalltalkImagePROTOTYPErecreateSpecialObjectsArray
"Smalltalk recreateSpecialObjectsArray"
"To external package developers:
**** DO NOT OVERRIDE THIS METHOD. *****
If you are writing a plugin and need additional special object(s) for your own use,
use addGCRoot() function and use own, separate special objects registry "
"The Special Objects Array is an array of objects used by the Squeak virtual machine.
Its contents are critical and accesses to it by the VM are unchecked, so don't even
think of playing here unless you know what you are doing."
| newArray |
newArray := Array new: 60.
"Nil false and true get used throughout the interpreter"
newArray at: 1 put: nil.
newArray at: 2 put: false.
newArray at: 3 put: true.
"This association holds the active process (a ProcessScheduler)"
newArray at: 4 put: (self specialObjectsArray at: 4) "(self bindingOf: #Processor) but it answers an Alias".
"Numerous classes below used for type checking and instantiation"
newArray at: 5 put: Bitmap.
newArray at: 6 put: SmallInteger.
newArray at: 7 put: ByteString.
newArray at: 8 put: Array.
newArray at: 9 put: Smalltalk.
newArray at: 10 put: Float.
+ newArray at: 11 put: (self globals at: #Context).
+ newArray at: 12 put: nil. "was BlockContext."
- newArray at: 11 put: MethodContext.
- newArray at: 12 put: BlockContext.
newArray at: 13 put: Point.
newArray at: 14 put: LargePositiveInteger.
newArray at: 15 put: Display.
newArray at: 16 put: Message.
newArray at: 17 put: CompiledMethod.
+ newArray at: 18 put: (self specialObjectsArray
+ ifNotNil: [ self specialObjectsArray at: 18 ]
+ ifNil: [ Semaphore new ]). "(low space Semaphore)"
- newArray at: 18 put: (self specialObjectsArray at: 18). "(low space Semaphore)"
newArray at: 19 put: Semaphore.
newArray at: 20 put: Character.
newArray at: 21 put: #doesNotUnderstand:.
newArray at: 22 put: #cannotReturn:.
newArray at: 23 put: nil. "This is the process signalling low space."
"An array of the 32 selectors that are compiled as special bytecodes,
paired alternately with the number of arguments each takes."
newArray at: 24 put: #( #+ 1 #- 1 #< 1 #> 1 #<= 1 #>= 1 #= 1 #~= 1
#* 1 #/ 1 #\\ 1 #@ 1 #bitShift: 1 #// 1 #bitAnd: 1 #bitOr: 1
#at: 1 #at:put: 2 #size 0 #next 0 #nextPut: 1 #atEnd 0 #== 1 #class 0
#blockCopy: 1 #value 0 #value: 1 #do: 1 #new 0 #new: 1 #x 0 #y 0 ).
"An array of the 255 Characters in ascii order.
Cog inlines table into machine code at: prim so do not regenerate it.
This is nil in Spur, which has immediate Characters."
newArray at: 25 put: (self specialObjectsArray at: 25).
newArray at: 26 put: #mustBeBoolean.
newArray at: 27 put: ByteArray.
newArray at: 28 put: Process.
"An array of up to 31 classes whose instances will have compact headers; an empty array in Spur"
newArray at: 29 put: self compactClassesArray.
+ newArray at: 30 put: (self specialObjectsArray
+ ifNotNil: [ self specialObjectsArray at: 30 ]
+ ifNil: [ Semaphore new ]). "(delay Semaphore)"
+ newArray at: 31 put: (self specialObjectsArray
+ ifNotNil: [ self specialObjectsArray at: 31 ]
+ ifNil: [ Semaphore new ]). "(user interrupt Semaphore)"
- newArray at: 30 put: (self specialObjectsArray at: 30). "(delay Semaphore)"
- newArray at: 31 put: (self specialObjectsArray at: 31). "(user interrupt Semaphore)"
"Entries 32 - 34 unreferenced. Previously these contained prototype instances to be copied for fast initialization"
newArray at: 32 put: nil. "was the prototype Float"
newArray at: 33 put: nil. "was the prototype 4-byte LargePositiveInteger"
newArray at: 34 put: nil. "was the prototype Point"
newArray at: 35 put: #cannotInterpret:.
newArray at: 36 put: nil. "was the prototype MethodContext"
newArray at: 37 put: BlockClosure.
newArray at: 38 put: nil. "was the prototype BlockContext"
"array of objects referred to by external code"
newArray at: 39 put: (self specialObjectsArray at: 39). "external semaphores"
newArray at: 40 put: nil. "Reserved for Mutex in Cog VMs"
newArray at: 41 put: ((self specialObjectsArray at: 39) ifNil: [LinkedList new]). "Reserved for a LinkedList instance for overlapped calls in CogMT"
+ newArray at: 42 put: (self specialObjectsArray
+ ifNotNil: [ (self specialObjectsArray at: 42) ifNil: [ Semaphore new ] ]
+ ifNil: [ Semaphore new ]).
- newArray at: 42 put: ((self specialObjectsArray at: 42) ifNil: [Semaphore new]). "finalization Semaphore"
newArray at: 43 put: LargeNegativeInteger.
"External objects for callout.
Note: Written so that one can actually completely remove the FFI."
newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []).
newArray at: 45 put: (self at: #ExternalStructure ifAbsent: []).
newArray at: 46 put: (self at: #ExternalData ifAbsent: []).
newArray at: 47 put: (self at: #ExternalFunction ifAbsent: []).
newArray at: 48 put: (self at: #ExternalLibrary ifAbsent: []).
newArray at: 49 put: #aboutToReturn:through:.
newArray at: 50 put: #run:with:in:.
"51 reserved for immutability message"
newArray at: 51 put: #attemptToAssign:withIndex:.
newArray at: 52 put: #(nil "nil => generic error" #'bad receiver'
#'bad argument' #'bad index'
#'bad number of arguments'
#'inappropriate operation' #'unsupported operation'
#'no modification' #'insufficient object memory'
#'insufficient C memory' #'not found' #'bad method'
#'internal error in named primitive machinery'
#'object may move' #'resource limit exceeded'
#'object is pinned' #'primitive write beyond end of object').
"53 to 55 are for Alien"
newArray at: 53 put: (self at: #Alien ifAbsent: []).
newArray at: 54 put: #invokeCallbackContext::. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks."
newArray at: 55 put: (self at: #UnsafeAlien ifAbsent: []).
"Used to be WeakFinalizationList for WeakFinalizationList hasNewFinalization, obsoleted by ephemeron support."
newArray at: 56 put: nil.
"reserved for foreign callback process"
newArray at: 57 put: (self specialObjectsArray at: 57 ifAbsent: []).
newArray at: 58 put: #unusedBytecode.
"59 reserved for Sista counter tripped message"
newArray at: 59 put: #conditionalBranchCounterTrippedOn:.
"60 reserved for Sista class trap message"
newArray at: 60 put: #classTrapFor:.
"Now replace the interpreter's reference in one atomic operation"
self specialObjectsArray becomeForward: newArray!
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 changed:
----- 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 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 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
+ setImageHeaderFlagsFrom: oldInterpreter getImageHeaderFlags;
+ imageName: 'spur image'.
- 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>>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