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!
vm-dev@lists.squeakfoundation.org