[Vm-dev] VM Maker: VMMaker.oscog-eem.523.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Nov 26 17:53:16 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.523.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.523
Author: eem
Time: 26 November 2013, 9:50:25.332 am
UUID: 1e6e967d-05a9-413a-9b22-5d5907ecfb5a
Ancestors: VMMaker.oscog-eem.522
Fix bug in fUOASACFS that was causing it to not collect large free
chunks for sorting, and hence resulting in compact moving almost
no objects.
Fix assert in SpurCircularBuffer>>reverseDo:, found now that there
is compaction occurring.
Resurrect exactFitCompact and fix its exit condition.
Add some isFreeObject: asserts.
Add clone VM to the CogVMSimulator utilitiesMenu:.
=============== Diff against VMMaker.oscog-eem.522 ===============
Item was added:
+ ----- Method: CogVMSimulator>>cloneSimulation (in category 'debug support') -----
+ cloneSimulation
+ | savedDisplayView savedDisplayForm savedQuitBlock savedTranscript |
+ savedDisplayView := displayView. displayView := nil.
+ savedDisplayForm := displayForm. displayForm = nil.
+ savedQuitBlock := quitBlock. quitBlock := nil.
+ savedTranscript := transcript. transcript := nil.
+
+ [| clone window |
+ clone := self veryDeepCopy.
+ window := clone openAsMorph.
+ window setLabel: 'Clone of ', (savedDisplayView containingWindow label allButFirst: 'Simulation of ' size)]
+ ensure:
+ [displayView := savedDisplayView.
+ displayForm = savedDisplayForm.
+ quitBlock := savedQuitBlock.
+ transcript := savedTranscript]!
Item was changed:
----- Method: CogVMSimulator>>utilitiesMenu: (in category 'UI') -----
utilitiesMenu: aMenuMorph
aMenuMorph
add: 'toggle transcript' action: #toggleTranscript;
+ add: 'clone VM' action: #cloneSimulation;
addLine;
add: 'print ext head frame' action: #printExternalHeadFrame;
add: 'print int head frame' action: #printHeadFrame;
add: 'print mc/cog frame' action: [self printFrame: cogit processor fp WithSP: cogit processor sp];
add: 'short print ext frame & callers' action: [self shortPrintFrameAndCallers: framePointer];
add: 'short print int frame & callers' action: [self shortPrintFrameAndCallers: localFP];
add: 'short print mc/cog frame & callers' action: [self shortPrintFrameAndCallers: cogit processor fp];
add: 'long print ext frame & callers' action: [self printFrameAndCallers: framePointer SP: stackPointer];
add: 'long print int frame & callers' action: [self printFrameAndCallers: localFP SP: localSP];
add: 'long print mc/cog frame & callers' action: [self printFrameAndCallers: cogit processor fp SP: cogit processor sp];
add: 'print frame...' action: [(self promptHex: 'print frame') ifNotNil: [:fp| self printFrame: fp]];
add: 'print call stack' action: #printCallStack;
add: 'print stack call stack' action: #printStackCallStack;
add: 'print call stack of...' action: [(self promptHex: 'context or process oop') ifNotNil: [:obj| self printCallStackOf: obj]];
add: 'print all stacks' action: #printAllStacks;
add: 'write back local ptrs' action: [stackPointer := localSP. framePointer := localFP. instructionPointer := localIP.
self writeBackHeadFramePointers];
add: 'write back mc ptrs' action: [stackPointer := cogit processor sp. framePointer := cogit processor fp. instructionPointer := cogit processor eip.
self writeBackHeadFramePointers];
addLine;
add: 'print registers' action: [cogit processor printRegistersOn: transcript];
add: 'disassemble method/trampoline...' action: [(self promptHex: 'pc') ifNotNil: [:pc| cogit disassembleCodeAt: pc]];
add: 'disassemble method/trampoline at pc' action: [cogit disassembleCodeAt: cogit processor pc];
add: 'disassemble ext head frame method' action: [cogit disassembleMethod: (self frameMethod: framePointer)];
add: 'print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self printOop: oop]];
add: 'long print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self longPrintOop: oop]];
addLine;
add: 'inspect object memory' target: objectMemory action: #inspect;
add: 'inspect cointerpreter' action: #inspect;
add: 'inspect cogit' target: cogit action: #inspect;
add: 'inspect method zone' target: cogit methodZone action: #inspect.
self isThreadedVM ifTrue:
[aMenuMorph add: 'inspect thread manager' target: self threadManager action: #inspect].
aMenuMorph
addLine;
add: 'print cog methods' target: cogMethodZone action: #printCogMethods;
add: 'print trampoline table' target: cogit action: #printTrampolineTable;
add: 'print prim trace log' action: #dumpPrimTraceLog;
add: 'report recent instructions' target: cogit action: #reportLastNInstructions;
add: 'set break pc...' action: [(self promptHex: 'break pc') ifNotNil: [:bpc| cogit breakPC: bpc]];
add: (cogit singleStep
ifTrue: ['no single step']
ifFalse: ['single step'])
action: [cogit singleStep: cogit singleStep not];
add: (cogit printRegisters
ifTrue: ['no print registers each instruction']
ifFalse: ['print registers each instruction'])
action: [cogit printRegisters: cogit printRegisters not];
add: (cogit printInstructions
ifTrue: ['no print instructions each instruction']
ifFalse: ['print instructions each instruction'])
action: [cogit printInstructions: cogit printInstructions not];
addLine;
add: 'set break count...' action: [|s| s := UIManager default request: 'break count (dec)'.
s notEmpty ifTrue: [breakCount := Integer readFrom: s readStream]];
add: 'set break selector...' action: [|s| s := UIManager default request: 'break selector'.
s notEmpty ifTrue: [self setBreakSelector: s]];
add: 'set break block...' action: [|s| s := UIManager default request: 'break selector'.
s notEmpty ifTrue: [self setBreakBlockFromString: s]];
add: (printBytecodeAtEachStep
ifTrue: ['no print bytecode each bytecode']
ifFalse: ['print bytecode each bytecode'])
action: [self ensureDebugAtEachStepBlock.
printBytecodeAtEachStep := printBytecodeAtEachStep not];
add: (printFrameAtEachStep
ifTrue: ['no print frame each bytecode']
ifFalse: ['print frame each bytecode'])
action: [self ensureDebugAtEachStepBlock.
printFrameAtEachStep := printFrameAtEachStep not].
^aMenuMorph!
Item was changed:
----- Method: Spur32BitMMLECoSimulator>>longAt:put: (in category 'memory access') -----
longAt: byteAddress put: a32BitValue
"Note: Adjusted for Smalltalk's 1-based array indexing."
+ "(byteAddress = 16r32F644 and: [a32BitValue = 16r78FFB0]) ifTrue:
- "(byteAddress = 16r15FF7A8 and: [a32BitValue = 16r19D09D0]) ifTrue:
[self halt]."
byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError].
^memory at: byteAddress // 4 + 1 put: a32BitValue!
Item was changed:
----- Method: SpurCircularBuffer>>reverseDo: (in category 'enumerating') -----
reverseDo: aBlock
| ptr |
last >= start ifTrue:
[ptr := last.
[self assert: (first <= last
ifTrue: [first <= ptr and: [ptr <= last]]
+ ifFalse: [(start <= ptr and: [ptr <= last]) or: [first <= ptr and: [ptr <= limit]]]).
- ifFalse: [(start <= ptr and: [ptr <= last]) or: [first <= ptr and: [ptr < limit]]]).
aBlock value: (manager longAt: ptr).
ptr = first ifTrue: [^nil].
(ptr := ptr - manager wordSize) < start ifTrue:
[ptr := limit]] repeat].
^nil!
Item was changed:
----- Method: SpurMemoryManager>>addFreeSubTree: (in category 'free space') -----
addFreeSubTree: freeTree
"Add a freeChunk sub tree back into the large free chunk tree.
This is for allocateOldSpaceChunkOf[Exactly]Bytes:[suchThat:]."
| bytesInArg treeNode bytesInNode subNode |
"N.B. *can't* use numSlotsOfAny: because of rounding up of odd slots
and/or step in size at 1032 bytes in 32-bits or 2048 bytes in 64-bits."
+ self assert: (self isFreeObject: freeTree).
bytesInArg := self bytesInObject: freeTree.
self assert: bytesInArg / (self allocationUnit / self wordSize) >= self numFreeLists.
treeNode := freeLists at: 0.
self assert: treeNode ~= 0.
[bytesInNode := self bytesInObject: treeNode.
self assert: bytesInArg ~= bytesInNode.
bytesInNode > bytesInArg
ifTrue:
[subNode := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: treeNode.
subNode = 0 ifTrue:
[self storePointer: self freeChunkSmallerIndex ofFreeChunk: treeNode withValue: freeTree.
self storePointer: self freeChunkParentIndex ofFreeChunk: freeTree withValue: treeNode.
^self]]
ifFalse:
[subNode := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: treeNode.
subNode = 0 ifTrue:
[self storePointer: self freeChunkLargerIndex ofFreeChunk: treeNode withValue: freeTree.
self storePointer: self freeChunkParentIndex ofFreeChunk: freeTree withValue: treeNode.
^self]].
treeNode := subNode] repeat!
Item was changed:
----- Method: SpurMemoryManager>>addToFreeTree:bytes: (in category 'free space') -----
addToFreeTree: freeChunk bytes: chunkBytes
"Add freeChunk to the large free chunk tree.
For the benefit of sortedFreeObject:, answer the treeNode it is added
to, if it is added to the next list of a freeTreeNode, otherwise answer 0."
| childBytes parent child |
+ self assert: (self isFreeObject: freeChunk).
self assert: chunkBytes = (self bytesInObject: freeChunk).
self assert: chunkBytes / self allocationUnit >= self numFreeLists.
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.
^child].
"walk down the tree"
parent := child.
child := self fetchPointer: (childBytes > chunkBytes
ifTrue: [self freeChunkSmallerIndex]
ifFalse: [self freeChunkLargerIndex])
ofFreeChunk: child].
parent = 0 ifTrue:
[self assert: (freeLists at: 0) = 0.
freeLists at: 0 put: freeChunk.
freeListsMask := freeListsMask bitOr: 1.
^0].
self assert: (freeListsMask anyMask: 1).
"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.
^0!
Item was changed:
----- Method: SpurMemoryManager>>compact (in category 'compaction') -----
compact
+ "We'd like to use exact fit followed by best fit, but best-fit is complex to implement
+ and potentially expensive. So just use exactFit followed, if necessary, by first-fit."
+ self exactFitCompact.
+ highestObjects usedSize > 0 ifTrue:
+ [self firstFitCompact]!
- "We'd like to use exact fit followed by best fit. But in practice exact fit doesn't move
- many objects (it does in artificial contexts such as the image bootstrap, but not in
- use of a real system). bestFit is potentially worth-while but takes effort to code.
- For now we just use fist-fit."
- ^self firstFitCompact!
Item was changed:
----- Method: SpurMemoryManager>>exactFitCompact (in category 'compaction') -----
exactFitCompact
"Compact all of memory above firstFreeChunk using exact-fit, assuming free
space is sorted and that as many of the the highest objects as will fit are
recorded in highestObjects. Don't move pinned objects.
Note that we don't actually move; we merely copy and forward. Eliminating
forwarders will be done in a final pass. Leave the objects that don't fit
exactly (the misfits), and hence aren't moved, in highestObjects."
<inline: false>
| misfits first nfits nmiss nHighest nMisses savedLimit |
<var: #misfits type: #usqInt>
self checkFreeSpace.
totalFreeOldSpace = 0 ifTrue: [^self].
highestObjects isEmpty ifTrue:
[^self].
nfits := nmiss := 0.
misfits := highestObjects last + self wordSize.
[statCompactPassCount := statCompactPassCount + 1.
highestObjects from: misfits - self wordSize reverseDo:
[:o| | b |
+ (self oop: o isGreaterThan: firstFreeChunk) ifFalse:
+ [highestObjects first: misfits.
+ coInterpreter print: 'exactFitCompact fits: '; printNum: nfits; print: ' misfits: '; printNum: nmiss; cr.
+ ^self].
- self assert: (self oop: o isGreaterThan: firstFreeChunk).
((self isForwarded: o) or: [self isPinned: o]) ifFalse:
[b := self bytesInObject: o.
(self allocateOldSpaceChunkOfExactlyBytes: b suchThat: [:f| f < o])
ifNil:
[nmiss := nmiss + 1.
misfits := misfits - self wordSize.
misfits < highestObjects start ifTrue:
[misfits := highestObjects limit - self wordSize].
self longAt: misfits put: o]
ifNotNil:
[:f|
nfits := nfits + 1.
self copyAndForward: o withBytes: b toFreeChunk: f]]].
self checkFreeSpace.
"now highestObjects contains only misfits, if any, from misfits to last.
set first to first failure and refill buffer. next cycle will add more misfits.
give up on exact-fit when half of the highest objects fail to fit."
first := self longAt: highestObjects first.
self assert: (self oop: first isGreaterThan: firstFreeChunk).
nHighest := highestObjects usedSize.
highestObjects first: misfits.
nMisses := highestObjects usedSize.
nMisses > (nHighest // 2) ifTrue:
[coInterpreter print: 'exactFitCompact fits: '; printNum: nfits; print: ' misfits: '; printNum: nmiss; cr.
^self].
self findFirstFreeChunkPostCompactionPass.
savedLimit := self moveMisfitsToTopOfHighestObjects: misfits.
self fillHighestObjectsWithMovableObjectsFrom: firstFreeChunk upTo: first.
misfits := self moveMisfitsInHighestObjectsBack: savedLimit.
highestObjects usedSize > 0] whileTrue!
Item was changed:
----- Method: SpurMemoryManager>>freeUnmarkedObjectsAndSortAndCoalesceFreeSpace (in category 'gc - global') -----
freeUnmarkedObjectsAndSortAndCoalesceFreeSpace
"Sweep all of old space, freeing unmarked objects, coalescing free chunks, and sorting free space.
Small free chunks are sorted in address order on each small list head. Large free chunks
are sorted on the sortedFreeChunks list. Record as many of the highest objects as there
is room for in highestObjects, a circular buffer, for the use of exactFitCompact. Use
unused eden space for highestObjects. If highestObjects does not wrap, store 0
at highestObjects last. Record the lowest free object in firstFreeChunk. Let the
segmentManager mark which segments contain pinned objects via notePinned:."
| lastLargeFree lastHighest highestObjectsWraps sortedFreeChunks |
<var: #lastHighest type: #usqInt>
self checkFreeSpace.
scavenger forgetUnmarkedRememberedObjects.
segmentManager prepareForGlobalSweep."for notePinned:"
"for sorting free space throw away the list heads, rebuilding them for small free chunks below."
self resetFreeListHeads.
highestObjects initializeStart: freeStart limit: scavenger eden limit.
+ lastHighest := highestObjects start - self wordSize. "a.k.a. freeStart - wordSize"
- lastHighest := highestObjects last "a.k.a. freeStart - wordSize".
highestObjectsWraps := 0.
self assert: highestObjects limit - highestObjects start // self wordSize >= 1024.
firstFreeChunk := sortedFreeChunks := lastLargeFree := 0.
"Note that if we were truly striving for performance we could split the scan into
two phases, one up to the first free object and one after, which would remove
the need to test firstFreeChunk when filling highestObjects."
self allOldSpaceEntitiesForCoalescingDo:
[:o|
(self isMarked: o)
ifTrue: "forwarders should have been followed in markAndTrace:"
[self assert: (self isForwarded: o) not.
self setIsMarkedOf: o to: false. "this will unmark bridges. undo the damage in notePinned:"
(self isPinned: o) ifTrue:
[segmentManager notePinned: o].
firstFreeChunk ~= 0 ifTrue:
[false "conceptually...: "
ifTrue: [highestObjects addLast: o]
ifFalse: "but we inline so we can use the local lastHighest"
[(lastHighest := lastHighest + self wordSize) >= highestObjects limit ifTrue:
+ [highestObjectsWraps := highestObjectsWraps + 1.
+ lastHighest := highestObjects start].
- [highestObjectsWraps := highestObjectsWraps + 1].
self longAt: lastHighest put: o]]]
ifFalse: "unmarked; two cases, an unreachable object or a free chunk."
[| here limit next |
self assert: (self isRemembered: o) not. "scavenger should have cleared this above"
here := o.
limit := endOfMemory - self bridgeSize.
next := self objectAfter: here limit: limit.
[next = limit or: [self isMarked: next]] whileFalse: "coalescing; rare case"
[self assert: (self isRemembered: o) not.
statCoalesces := statCoalesces + 1.
here := self coalesce: here and: next.
next := self objectAfter: here limit: limit].
- self setFree: here.
firstFreeChunk = 0 ifTrue:
[firstFreeChunk := here].
(self isLargeFreeObject: here)
ifTrue:
+ [self setFree: here.
+ lastLargeFree = 0
+ ifTrue: [sortedFreeChunks := lastLargeFree := here]
- [lastLargeFree = 0
- ifTrue: [sortedFreeChunks := here]
ifFalse:
+ [self storePointer: self freeChunkNextAddressIndex
+ ofFreeChunk: lastLargeFree
+ withValue: here].
- [self setFree: here.
- self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: here].
lastLargeFree := here]
ifFalse:
[self freeSmallObject: here]]].
highestObjects last: lastHighest.
highestObjectsWraps ~= 0 ifTrue:
[highestObjects first: (lastHighest + self wordSize >= highestObjects limit
ifTrue: [highestObjects start]
ifFalse: [lastHighest + self wordSize])].
lastLargeFree ~= 0 ifTrue:
[self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: 0].
totalFreeOldSpace := self reverseSmallListHeads.
totalFreeOldSpace := totalFreeOldSpace + (self rebuildFreeTreeFrom: sortedFreeChunks).
self checkFreeSpace.
self touch: highestObjectsWraps!
More information about the Vm-dev
mailing list