[Vm-dev] VM Maker: VMMaker.oscog-eem.391.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Sep 19 01:20:34 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.391.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.391
Author: eem
Time: 18 September 2013, 6:17:51.359 pm
UUID: 99df045e-7d77-463e-821c-084a05ac2491
Ancestors: VMMaker.oscog-eem.390
Make followForwarded: follow chains, after Igor's example on my
blog.
Make initialInstanceOf: answer nil on failure, to match instanceAfter:
Give the generation scavenger a larger remembered set. Should be
moved to old space to live on the heap.
Implement SpurMemMgr>>flushNewSpace.
Fix bug in scavengeReferentsOf: to answer if referrer has new
reference after copying referents.
Switch order of space enumerations in allObjectsDo:. Dubiousl Will
revisit. e.g. allInstances and allObjects primitives are safer.
Fix SpurMemMgr>>clone: for immediates and byte objects.
=============== Diff against VMMaker.oscog-eem.390 ===============
Item was changed:
----- Method: Interpreter>>primitiveSomeInstance (in category 'object access primitives') -----
primitiveSomeInstance
| class instance |
class := self stackTop.
instance := self initialInstanceOf: class.
+ instance
+ ifNil: [self primitiveFail]
+ ifNotNil: [self pop: argumentCount+1 thenPush: instance]!
- instance = nilObj
- ifTrue: [self primitiveFail]
- ifFalse: [self pop: argumentCount+1 thenPush: instance]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSomeInstance (in category 'object access primitives') -----
primitiveSomeInstance
| class instance |
class := self stackTop.
instance := objectMemory initialInstanceOf: class.
+ instance
+ ifNil: [self primitiveFail]
+ ifNotNil: [self pop: argumentCount+1 thenPush: instance]!
- instance = objectMemory nilObject
- ifTrue: [self primitiveFail]
- ifFalse: [self pop: argumentCount+1 thenPush: instance]!
Item was changed:
----- Method: NewspeakInterpreter>>primitiveSomeInstance (in category 'object access primitives') -----
primitiveSomeInstance
| class instance |
class := self stackTop.
instance := self initialInstanceOf: class.
+ instance
+ ifNil: [self primitiveFail]
+ ifNotNil: [self pop: argumentCount+1 thenPush: instance]!
- instance = nilObj
- ifTrue: [self primitiveFail]
- ifFalse: [self pop: argumentCount+1 thenPush: instance]!
Item was changed:
----- Method: ObjectMemory>>initialInstanceOf: (in category 'object enumeration') -----
initialInstanceOf: classPointer
"Support for instance enumeration. Return the first instance
of the given class, or nilObj if it has no instances."
| thisObj thisClass |
thisObj := self firstAccessibleObject.
[thisObj = nil]
whileFalse: [thisClass := self fetchClassOf: thisObj.
thisClass = classPointer ifTrue: [^ thisObj].
thisObj := self accessibleObjectAfter: thisObj].
+ ^nil!
- ^ nilObj!
Item was changed:
----- Method: SpurGenerationScavenger class>>initialize (in category 'class initialization') -----
initialize
"SpurGenerationScavenger initialize"
+ RememberedSetLimit := 16384.
+ RememberedSetRedZone := RememberedSetLimit - (RememberedSetLimit // 2)!
- RememberedSetLimit := 4096.
- RememberedSetRedZone := 1024 * 3!
Item was added:
+ ----- Method: SpurGenerationScavenger>>getRawTenuringThreshold (in category 'accessing') -----
+ getRawTenuringThreshold
+ ^tenuringThreshold!
Item was changed:
----- Method: SpurGenerationScavenger>>scavengeReferentsOf: (in category 'scavenger') -----
scavengeReferentsOf: referrer
"scavengeReferentsOf: referrer inspects all the pointers in referrer.
If any are new objects, it has them moved to FutureSurvivorSpace,
and answers truth. If there are no new referents, it answers falsity."
| foundNewReferent |
"forwarding objects should be followed by callers,
unless the forwarder is a root in the remembered table."
self assert: ((manager isForwarded: referrer) not
or: [manager isRemembered: referrer]).
foundNewReferent := false.
0 to: (manager numPointerSlotsOf: referrer) - 1 do:
[:i| | referent newLocation |
referent := manager fetchPointer: i ofMaybeForwardedObject: referrer.
(manager isNonImmediate: referent) ifTrue:
["a forwarding pointer could be because of become: or scavenging."
referent := (manager isForwarded: referent)
ifTrue: [manager followForwarded: referent]
ifFalse: [referent].
(manager isYoung: referent)
ifTrue:
+ ["if target is already in future space forwarding pointer was due to a become:."
- [foundNewReferent := true.
- "if target is already in future space forwarding pointer was due to a become:."
(manager isInFutureSpace: referent)
ifTrue: [newLocation := referent]
ifFalse:
[(manager isForwarded: referent)
ifTrue: [self halt. "can this even happen?"
newLocation := manager followForwarded: referent]
ifFalse: [newLocation := self copyAndForward: referent]].
+ (manager isYoung: newLocation) ifTrue:
+ [foundNewReferent := true].
manager storePointerUnchecked: i ofMaybeForwardedObject: referrer withValue: newLocation]
ifFalse:
[manager storePointerUnchecked: i ofMaybeForwardedObject: referrer withValue: referent]]].
^foundNewReferent!
Item was added:
+ ----- Method: SpurGenerationScavenger>>setRawTenuringThreshold: (in category 'accessing') -----
+ setRawTenuringThreshold: threshold
+ tenuringThreshold := threshold!
Item was changed:
----- Method: SpurMemoryManager>>addToFreeList: (in category 'free space') -----
addToFreeList: freeChunk
| chunkBytes childBytes parent child index |
+ "coInterpreter transcript ensureCr. coInterpreter print: 'freeing '. self printFreeChunk: freeChunk."
- coInterpreter transcript ensureCr. coInterpreter print: 'freeing '. self printFreeChunk: freeChunk.
chunkBytes := self bytesInObject: freeChunk.
index := chunkBytes / self allocationUnit.
index < NumFreeLists ifTrue:
[self storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: (freeLists at: index).
freeLists at: index put: freeChunk.
freeListsMask := freeListsMask bitOr: 1 << index.
^self].
freeListsMask := freeListsMask bitOr: 1.
self
storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: 0;
storePointer: self freeChunkParentIndex ofFreeChunk: freeChunk withValue: 0;
storePointer: self freeChunkSmallerIndex ofFreeChunk: freeChunk withValue: 0;
storePointer: self freeChunkLargerIndex ofFreeChunk: freeChunk withValue: 0.
"Large chunk list organized as a tree, each node of which is a list of chunks of the same size.
Beneath the node are smaller and larger blocks."
parent := 0.
child := freeLists at: 0.
[child ~= 0] whileTrue:
[childBytes := self bytesInObject: child.
childBytes = chunkBytes ifTrue: "size match; add to list at node."
[self storePointer: self freeChunkNextIndex
ofFreeChunk: freeChunk
withValue: (self fetchPointer: self freeChunkNextIndex ofObject: child);
storePointer: self freeChunkNextIndex
ofFreeChunk: child
withValue: freeChunk.
^self].
"walk down the tree"
parent := child.
child := self fetchPointer: (childBytes > chunkBytes
ifTrue: [self freeChunkSmallerIndex]
ifFalse: [self freeChunkLargerIndex])
ofObject: child].
parent = 0 ifTrue:
[self assert: (freeLists at: 0) = 0.
freeLists at: 0 put: freeChunk.
^self].
"insert in tree"
self storePointer: self freeChunkParentIndex
ofFreeChunk: freeChunk
withValue: parent.
self storePointer: (childBytes > chunkBytes
ifTrue: [self freeChunkSmallerIndex]
ifFalse: [self freeChunkLargerIndex])
ofFreeChunk: parent
withValue: freeChunk!
Item was changed:
----- Method: SpurMemoryManager>>allExistingObjectsDo: (in category 'object enumeration') -----
allExistingObjectsDo: aBlock
"Enumerate all objects, excluding any objects created
during the execution of allExistingObjectsDo:."
<inline: true>
+ self allExistingNewSpaceObjectsDo: aBlock.
+ self allExistingOldSpaceObjectsDo: aBlock!
- self allExistingOldSpaceObjectsDo: aBlock.
- self allExistingNewSpaceObjectsDo: aBlock!
Item was changed:
----- Method: SpurMemoryManager>>allObjectsDo: (in category 'object enumeration') -----
allObjectsDo: aBlock
<inline: true>
+ self allNewSpaceObjectsDo: aBlock.
+ self allOldSpaceObjectsDo: aBlock!
- self allOldSpaceObjectsDo: aBlock.
- self allNewSpaceObjectsDo: aBlock!
Item was changed:
----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfBytes: (in category 'free space') -----
allocateOldSpaceChunkOfBytes: chunkBytes
"Answer a chunk of oldSpace from the free lists, if available,
otherwise answer nil. N.B. the chunk is simply a pointer, it has
no valid header. The caller *must* fill in the header correctly."
| index chunk nextIndex nodeBytes parent child smaller larger |
index := chunkBytes / self allocationUnit.
(index < NumFreeLists and: [1 << index >= freeListsMask]) ifTrue:
[(chunk := freeLists at: index) ~= 0 ifTrue:
[^self unlinkFreeChunk: chunk atIndex: index].
"first search for free chunks of a multiple of chunkBytes in size"
nextIndex := index.
[1 << index >= freeListsMask
and: [(nextIndex := nextIndex + index) < NumFreeLists]] whileTrue:
[((freeListsMask anyMask: 1 << index)
and: [(chunk := freeLists at: index) ~= 0]) ifTrue:
[self unlinkFreeChunk: chunk atIndex: index.
self assert: (self bytesInObject: chunk) = index * self allocationUnit.
self freeChunkWithBytes: index * self allocationUnit - chunkBytes
at: (self startOfFreeChunk: chunk) + chunkBytes.
^chunk]].
"now get desperate and use the first that'll fit"
nextIndex := index.
[1 << index >= freeListsMask
and: [(nextIndex := nextIndex + 1) < NumFreeLists]] whileTrue:
[(freeListsMask anyMask: 1 << index) ifTrue:
[(chunk := freeLists at: index) ~= 0 ifTrue:
[self unlinkFreeChunk: chunk atIndex: index.
self assert: (self bytesInObject: chunk) = index * self allocationUnit.
self freeChunkWithBytes: index * self allocationUnit - chunkBytes
at: (self startOfFreeChunk: chunk) + chunkBytes.
^chunk].
freeListsMask := freeListsMask - (1 << index)]]].
"Large chunk, or no space on small free lists. Search the large chunk list.
Large chunk list organized as a tree, each node of which is a list of chunks
of the same size. Beneath the node are smaller and larger blocks."
parent := 0.
child := freeLists at: 0.
[child ~= 0] whileTrue:
[nodeBytes := self bytesInObject: child.
parent := child.
nodeBytes = chunkBytes
ifTrue: "size match; try to remove from list at node."
[chunk := self fetchPointer: self freeChunkNextIndex
ofFreeChunk: child.
chunk ~= 0 ifTrue:
[self storePointer: self freeChunkNextIndex
ofFreeChunk: child
withValue: (self fetchPointer: self freeChunkNextIndex
ofFreeChunk: chunk).
^chunk].
child := 0] "break out of loop to remove interior node"
ifFalse:"walk down the tree"
[child := self fetchPointer: (nodeBytes > chunkBytes
ifTrue: [self freeChunkSmallerIndex]
ifFalse: [self freeChunkLargerIndex])
ofFreeChunk: child]].
parent = 0 ifTrue:
[self halt].
"self printFreeChunk: parent"
self assert: (self bytesInObject: parent) = nodeBytes.
"attempt to remove from list"
chunk := self fetchPointer: self freeChunkNextIndex
ofFreeChunk: parent.
chunk ~= 0 ifTrue:
[self storePointer: self freeChunkNextIndex
ofFreeChunk: parent
withValue: (self fetchPointer: self freeChunkNextIndex
ofFreeChunk: chunk).
chunkBytes ~= nodeBytes ifTrue:
[self freeChunkWithBytes: nodeBytes - chunkBytes
at: (self startOfFreeChunk: chunk) + chunkBytes].
^chunk].
"no list; remove an interior node"
chunk := parent.
parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: chunk.
"no parent; stitch the subnodes back into the root"
parent = 0 ifTrue:
[smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: chunk.
larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: chunk.
smaller = 0
ifTrue: [freeLists at: 0 put: larger]
ifFalse:
[freeLists at: 0 put: smaller.
larger ~= 0 ifTrue:
[self addFreeSubTree: larger]].
+ "coInterpreter transcript ensureCr.
- coInterpreter transcript ensureCr.
coInterpreter print: 'new free tree root '.
(freeLists at: 0) = 0 ifTrue: [coInterpreter print: '0'] ifFalse: [self printFreeChunk: (freeLists at: 0)].
+ coInterpreter cr."
- coInterpreter cr.
chunkBytes ~= nodeBytes ifTrue:
[self freeChunkWithBytes: nodeBytes - chunkBytes
at: (self startOfFreeChunk: chunk) + chunkBytes].
^chunk].
"remove node from tree; reorder tree simply. two cases (which have mirrors, for four total):
case 1. interior node has one child, P = parent, N = node, S = subtree (mirrored for large vs small)
___ ___
| P | | P |
_/_ _/_
| N | => | S |
_/_
| S |"
self halt.
"case 2: interior node has two children, , P = parent, N = node, L = smaller, left subtree, R = larger, right subtree.
add the left subtree to the bottom left of the right subtree (mirrored for large vs small)
___ ___
| P | | P |
_/_ _/_
| N | => | R |
_/_ _\_ _/_
| L | | R | | L |"
self halt!
Item was added:
+ ----- Method: SpurMemoryManager>>booleanObjectOf: (in category 'primitive support') -----
+ booleanObjectOf: bool
+ <inline: true>
+ ^bool ifTrue: [trueObj] ifFalse: [falseObj]!
Item was changed:
----- Method: SpurMemoryManager>>clone: (in category 'allocation') -----
clone: objOop
| numSlots newObj |
numSlots := self numSlotsOf: objOop.
newObj := self allocateSlots: (self numSlotsOf: objOop)
format: (self formatOf: objOop)
classIndex: (self classIndexOf: objOop).
+ (self isPointersNonImm: objOop)
+ ifTrue:
+ [0 to: numSlots - 1 do:
+ [:i| | oop |
+ oop := self fetchPointer: i ofObject: objOop.
+ ((self isNonImmediate: oop)
+ and: [self isForwarded: oop]) ifTrue:
+ [oop := self followForwarded: oop].
+ self storePointerUnchecked: i
+ ofObject: newObj
+ withValue: oop].
+ ((self isRemembered: objOop)
+ and: [self isYoung: newObj]) ifTrue:
+ [scavenger remember: objOop.
+ self setIsRememberedOf: objOop to: true]]
+ ifFalse:
+ [0 to: numSlots - 1 do:
+ [:i|
+ self storePointerUnchecked: i
+ ofObject: newObj
+ withValue: (self fetchPointer: i ofObject: objOop)]].
- 0 to: numSlots - 1 do:
- [:i| | oop |
- oop := self fetchPointer: i ofObject: objOop.
- ((self isNonImmediate: oop)
- and: [self isForwarded: oop]) ifTrue:
- [oop := self followForwarded: oop].
- self storePointerUnchecked: i
- ofObject: newObj
- withValue: (self fetchPointer: i ofObject: objOop)].
- (self isRemembered: objOop) ifTrue:
- [scavenger remember: objOop.
- self setIsRememberedOf: objOop to: true].
^newObj!
Item was added:
+ ----- Method: SpurMemoryManager>>coInterpreter (in category 'simulation') -----
+ coInterpreter
+ <doNotGenerate>
+ ^coInterpreter!
Item was added:
+ ----- Method: SpurMemoryManager>>flushNewSpace (in category 'generation scavenging') -----
+ flushNewSpace
+ | savedTenuringThreshold |
+ savedTenuringThreshold := scavenger getRawTenuringThreshold.
+ scavenger setRawTenuringThreshold: newSpaceLimit.
+ self sufficientSpaceAfterGC: 0.
+ scavenger setRawTenuringThreshold: savedTenuringThreshold.
+ self assert: scavenger rememberedSetSize = 0.
+ self assert: pastSpaceStart = scavenger pastSpace start.
+ self assert: freeStart = scavenger eden start!
Item was changed:
----- Method: SpurMemoryManager>>followForwarded: (in category 'become api') -----
followForwarded: objOop
+ "Follow a forwarding pointer. Alas we cannot prevent forwarders to forwarders
+ being created by lazy become. Consider the following example by Igor Stasenk:
+ array := { a. b. c }.
+ - array at: 1 points to &a. array at: 2 points to &b. array at: 3 points to &c Ó
+ a becomeForward: b
+ - array at: 1 still points to &a. array at: 2 still points to &b. array at: 3 still points to &c
+ b becomeForward: c.
+ - array at: 1 still points to &a. array at: 2 still points to &b. array at: 3 still points to &c
+ - when accessing array first one has to follow a forwarding chain:
+ &a -> &b -> c"
| referent |
self assert: (self isForwarded: objOop).
referent := self fetchPointer: 0 ofMaybeForwardedObject: objOop.
+ [(self isForwarded: referent)] whileTrue:
+ [referent := self fetchPointer: 0 ofMaybeForwardedObject: referent].
- self assert: (self isForwarded: referent) not.
^referent!
Item was added:
+ ----- Method: SpurMemoryManager>>initialInstanceOf: (in category 'object enumeration') -----
+ initialInstanceOf: classObj
+ <inline: false>
+ | classIndex |
+ classIndex := self rawHashBitsOf: classObj.
+ classIndex = 0 ifTrue:
+ [^nil].
+ self allObjectsDo:
+ [:objOop|
+ classIndex = (self classIndexOf: objOop) ifTrue:
+ [^objOop]].
+ ^nil!
Item was added:
+ ----- Method: SpurMemoryManager>>instanceAfter: (in category 'object enumeration') -----
+ instanceAfter: objOop
+ | actualObj classIndex |
+ actualObj := objOop.
+ classIndex := self classIndexOf: objOop.
+ (self isInEden: objOop) ifTrue:
+ [actualObj := self objectAfter: actualObj limit: freeStart.
+ [objOop < freeStart] whileTrue:
+ [classIndex = (self classIndexOf: actualObj) ifTrue:
+ [^actualObj].
+ actualObj := self objectAfter: objOop limit: freeStart].
+ actualObj := pastSpaceStart > scavenger pastSpace start
+ ifTrue: [self objectStartingAt: scavenger pastSpace start]
+ ifFalse: [nilObj]].
+ (self isInSurvivorSpace: actualObj) ifTrue:
+ [actualObj := self objectAfter: actualObj limit: pastSpaceStart.
+ [objOop < pastSpaceStart] whileTrue:
+ [classIndex = (self classIndexOf: actualObj) ifTrue:
+ [^actualObj].
+ actualObj := self objectAfter: objOop limit: pastSpaceStart].
+ actualObj := nilObj].
+ actualObj := self objectAfter: actualObj limit: freeOldSpaceStart.
+ [objOop < freeOldSpaceStart] whileTrue:
+ [classIndex = (self classIndexOf: actualObj) ifTrue:
+ [^actualObj].
+ actualObj := self objectAfter: objOop limit: freeOldSpaceStart].
+ ^nil!
Item was changed:
----- Method: SpurMemoryManager>>isIntegerObject: (in category 'object testing') -----
isIntegerObject: oop
"This list records the valid senders of isIntegerObject: as we replace uses of
isIntegerObject: by isImmediate: where appropriate."
(#( DoIt
DoItIn:
makeBaseFrameFor:
quickFetchInteger:ofObject:
frameOfMarriedContext:
objCouldBeClassObj:
isMarriedOrWidowedContext:
shortPrint:
bytecodePrimAt
bytecodePrimAtPut
commonAt:
commonAtPut:
loadFloatOrIntFrom:
positive32BitValueOf:
primitiveExternalCall
checkedIntegerValueOf:
bytecodePrimAtPut
commonAtPut:
primitiveVMParameter
checkIsStillMarriedContext:currentFP:
displayBitsOf:Left:Top:Right:Bottom:
fetchStackPointerOf:
primitiveContextAt
primitiveContextAtPut
subscript:with:storing:format:
+ printContext:
+ compare31or32Bits:equal:
+ signed64BitValueOf:) includes: thisContext sender method selector) ifFalse:
- printContext:) includes: thisContext sender method selector) ifFalse:
[self halt].
^(oop bitAnd: 1) ~= 0!
Item was changed:
----- Method: SpurMemoryManager>>sufficientSpaceAfterGC: (in category 'generation scavenging') -----
sufficientSpaceAfterGC: numBytes
"This is ObjectMemory's funky entry-point into its incremental GC,
which is a stop-the-world a young generation reclaimer. In Spur
we run the scavenger."
- self halt.
self assert: numBytes = 0.
+ "coInterpreter printCallStackFP: coInterpreter framePointer"
self runLeakCheckerForFullGC: false.
coInterpreter preGCAction: GCModeIncr.
needGCFlag := false.
-
gcStartUsecs := coInterpreter ioUTCMicrosecondsNow.
scavengeInProgress := true.
pastSpaceStart := scavenger scavenge.
self assert: (self
oop: pastSpaceStart
isGreaterThanOrEqualTo: scavenger pastSpace start
andLessThanOrEqualTo: scavenger pastSpace limit).
freeStart := scavenger eden start.
self initSpaceForAllocationCheck: scavenger eden.
scavengeInProgress := false.
statScavenges := statScavenges + 1.
statGCEndUsecs := coInterpreter ioUTCMicrosecondsNow.
statSGCDeltaUsecs := statGCEndUsecs - gcStartUsecs.
statScavengeGCUsecs := statScavengeGCUsecs + statSGCDeltaUsecs.
coInterpreter postGCAction.
self runLeakCheckerForFullGC: false.
^true!
Item was changed:
----- Method: StackInterpreter>>divorceAllFrames (in category 'frame access') -----
divorceAllFrames
| activeContext |
<inline: false>
<var: #aPage type: #'StackPage *'>
+ stackPage ~= 0 ifTrue:
+ [self externalWriteBackHeadFramePointers].
- self externalWriteBackHeadFramePointers.
activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer.
0 to: numStackPages - 1 do:
[:i| | aPage |
aPage := stackPages stackPageAt: i.
(stackPages isFree: aPage) ifFalse:
[self divorceFramesIn: aPage]].
self zeroStackPage.
^activeContext!
Item was changed:
----- Method: StackInterpreter>>zeroStackPage (in category 'stack pages') -----
zeroStackPage
+ "In its own method as a debugging hook.
+ Frame pointers should have been written back already."
- "In its own method as a debugging hook."
<inline: true>
+ self assert: (stackPage = 0
+ or: [stackPage headFP = framePointer
+ and: [stackPage headSP = stackPointer]]).
stackPage := 0!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveClone (in category 'object access primitives') -----
primitiveClone
"Return a shallow copy of the receiver.
Special-case non-single contexts (because of context-to-stack mapping).
Can't fail for contexts cuz of image context instantiation code (sigh)."
| rcvr newCopy |
rcvr := self stackTop.
+ (objectMemory isImmediate: rcvr)
- (objectMemory isIntegerObject: rcvr)
ifTrue:
[newCopy := rcvr]
ifFalse:
[(objectMemory isContextNonImm: rcvr)
ifTrue:
[newCopy := self cloneContext: rcvr]
ifFalse:
[newCopy := objectMemory clone: rcvr].
newCopy = 0 ifTrue:
[^self primitiveFailFor: PrimErrNoMemory]].
self pop: 1 thenPush: newCopy!
More information about the Vm-dev
mailing list