[Vm-dev] VM Maker: VMMaker.oscog-eem.527.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Dec 2 21:50:52 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.527.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.527
Author: eem
Time: 27 November 2013, 1:24:26.609 pm
UUID: 6effc8b0-7b1d-445b-b154-af4f89653734
Ancestors: VMMaker.oscog-eem.526
In Spur compaction, fix the edge case of firstFreeChunk being
allocated but the start of the object being different from the start
of firstFreeChunk.
Move finding the new firstFreeChunk into
fillHighestObjectsWithMovableObjectsFrom:upTo: and nuke
findFirstFreeChunkPostCompactionPass.
Fix the fence-post error in insertSegmentFor:.
Fix the asserts in addSegmentOfSize:.
=============== Diff against VMMaker.oscog-eem.526 ===============
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 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.
+ "here's a wrinkle; if the firstFreeChunk is allocated to a small object and the firstFreeChunk
+ is a large chunk then firstFreeChunk will no longer point to an object header. So check and
+ adjust firstFreeChunk if it is assigned to."
+ f = firstFreeChunk ifTrue:
+ [firstFreeChunk := self objectStartingAt: f]]]].
- 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>>fillHighestObjectsWithMovableObjectsFrom:upTo: (in category 'compaction') -----
fillHighestObjectsWithMovableObjectsFrom: startObj upTo: limitObj
"Refill highestObjects with movable objects up to, but not including limitObj.
c.f. the loop in freeUnmarkedObjectsNilUnmarkedWeaklingSlotsAndSortAndCoalesceFreeSpace."
+ | lastHighest highestObjectsWraps firstFree |
- | lastHighest highestObjectsWraps |
highestObjects resetAsEmpty.
lastHighest := highestObjects last.
+ highestObjectsWraps := firstFree := 0.
+ self allOldSpaceEntitiesFrom: startObj do:
- highestObjectsWraps := 0.
- self allOldSpaceObjectsFrom: startObj do:
[:o|
(self oop: o isGreaterThanOrEqualTo: limitObj) ifTrue:
[highestObjects last: lastHighest.
+ (firstFree ~= 0 and: [(self isFreeObject: firstFreeChunk) not]) ifTrue:
+ [firstFreeChunk := firstFree].
^self].
+ (self isFreeObject: o)
+ ifTrue: [firstFree = 0 ifTrue:
+ [firstFree := o]]
+ ifFalse:
+ [((self isForwarded: o) or: [self isPinned: o]) ifFalse:
+ [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].
+ self longAt: lastHighest put: o]]]].
+ highestObjects last: lastHighest.
+ (firstFree ~= 0 and: [(self isFreeObject: firstFreeChunk) not]) ifTrue:
+ [firstFreeChunk := firstFree]!
- ((self isForwarded: o) or: [self isPinned: o]) ifFalse:
- [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].
- self longAt: lastHighest put: o]]].
- highestObjects last: lastHighest!
Item was removed:
- ----- Method: SpurMemoryManager>>findFirstFreeChunkPostCompactionPass (in category 'compaction') -----
- findFirstFreeChunkPostCompactionPass
- (self isFreeObject: firstFreeChunk) ifFalse:
- [firstFreeChunk := self findFirstFreeChunkAfter: firstFreeChunk]!
Item was changed:
----- Method: SpurMemoryManager>>firstFitCompact (in category 'compaction') -----
firstFitCompact
"Compact all of memory above firstFreeChunk using first-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."
<inline: false>
| first nhits nmisses |
self checkFreeSpace.
totalFreeOldSpace = 0 ifTrue: [^self].
highestObjects isEmpty ifTrue:
[^self].
nhits := nmisses := 0.
[statCompactPassCount := statCompactPassCount + 1.
highestObjects reverseDo:
[:o| | b |
(self oop: o isLessThanOrEqualTo: firstFreeChunk) ifTrue:
[coInterpreter print: 'firstFitCompact fits: '; printNum: nhits; print: ' misfits: '; printNum: nmisses; cr.
^self].
((self isForwarded: o) or: [self isPinned: o]) ifFalse:
[b := self bytesInObject: o.
(self allocateOldSpaceChunkOfBytes: b suchThat: [:f| f < o])
ifNil:
[nmisses := nmisses + 1]
ifNotNil:
[:f|
nhits := nhits + 1.
self copyAndForward: o withBytes: b toFreeChunk: f.
+ "here's a wrinkle; if the firstFreeChunk is allocated to a small object and the firstFreeChunk
+ is a large chunk then firstFreeChunk will no longer point to an object header. So check and
+ adjust firstFreeChunk if it is assigned to."
+ f = firstFreeChunk ifTrue:
+ [firstFreeChunk := self objectStartingAt: f].
self assert: (lastSubdividedFreeChunk = 0
or: [(self addressAfter: (self objectStartingAt: f)) = lastSubdividedFreeChunk])]]].
self checkFreeSpace.
first := self longAt: highestObjects first.
self assert: (self oop: first isGreaterThan: firstFreeChunk).
- self findFirstFreeChunkPostCompactionPass.
self fillHighestObjectsWithMovableObjectsFrom: firstFreeChunk upTo: first.
highestObjects usedSize > 0] whileTrue.
coInterpreter print: 'firstFitCompact fits: '; printNum: nhits; print: ' misfits: '; printNum: nmisses; cr!
Item was changed:
----- Method: SpurSegmentManager>>addSegmentOfSize: (in category 'growing/shrinking memory') -----
addSegmentOfSize: ammount
<returnTypeC: #'SpurSegmentInfo *'>
<inline: false>
| allocatedSize |
<var: #newSeg type: #'SpurSegmentInfo *'>
<var: #segAddress type: #'void *'>
self cCode: [] inSmalltalk: [segments ifNil: [^nil]]. "bootstrap"
(manager "sent to the manager so that the simulator can increase memory to simulate a new segment"
sqAllocateMemorySegmentOfSize: ammount
Above: (segments at: 0) segLimit asVoidPointer
AllocatedSizeInto: (self cCode: [self addressOf: allocatedSize]
inSmalltalk: [[:sz| allocatedSize := sz]])) ifNotNil:
[:segAddress| | newSegIndex newSeg |
newSegIndex := self insertSegmentFor: segAddress asUnsignedLong.
newSeg := self addressOf: (segments at: newSegIndex).
newSeg
segStart: segAddress asUnsignedLong;
segSize: allocatedSize.
self bridgeFrom: (self addressOf: (segments at: newSegIndex - 1)) to: newSeg.
self bridgeFrom: newSeg to: (newSegIndex = (numSegments - 1) ifFalse:
[self addressOf: (segments at: newSegIndex + 1)]).
"and add the new free chunk to the free list; done here
instead of in assimilateNewSegment: for the assert"
manager addFreeChunkWithBytes: allocatedSize - manager bridgeSize at: newSeg segStart.
self assert: (manager addressAfter: (manager objectStartingAt: newSeg segStart))
= (newSeg segLimit - manager bridgeSize).
"test isInMemory:"
0 to: numSegments - 1 do:
[:i|
+ self assert: (self isInSegments: (segments at: i) segStart).
+ self assert: (self isInSegments: (segments at: i) segLimit - manager wordSize).
+ self assert: ((self isInSegments: (segments at: i) segLimit) not
+ or: [i < (numSegments - 1)
+ and: [(segments at: i) segLimit = (segments at: i + 1) segStart]]).
+ self assert: ((self isInSegments: (segments at: i) segStart - manager wordSize) not
+ or: [i > 0
+ and: [(segments at: i - 1) segLimit = (segments at: i) segStart]])].
- self assert: (manager isInMemory: (segments at: i) segStart).
- self assert: (manager isInMemory: (segments at: i) segLimit - manager wordSize).
- self assert: (manager isInMemory: (segments at: i) segLimit) not.
- (i between: 1 and: numSegments - 2) ifTrue:
- [self assert: (manager isInMemory: (segments at: i) segStart - manager wordSize) not]].
^newSeg].
^nil!
Item was changed:
----- Method: SpurSegmentManager>>insertSegmentFor: (in category 'growing/shrinking memory') -----
insertSegmentFor: segAddress
"Reserve a new segInfo for segAddress. If segAddress
is in the middle of the existing segments, shuffle them
up to make room. Answer the new segment's index."
| segIndex lastSegIndex |
self assert: segAddress > (segments at: 0) segLimit.
numSegments = numSegInfos ifTrue:
[self allocateOrExtendSegmentInfos].
self assert: numSegments < numSegInfos.
segIndex := lastSegIndex := numSegments - 1.
numSegments := numSegments + 1.
+ [segAddress >= (segments at: segIndex) segLimit ifTrue:
- [segAddress > (segments at: segIndex) segLimit ifTrue:
[segIndex := segIndex + 1.
lastSegIndex to: segIndex by: -1 do:
[:idx| segments at: idx + 1 put: (segments at: idx)].
^segIndex].
segIndex := segIndex - 1]
repeat!
More information about the Vm-dev
mailing list