Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.463.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.463 Author: eem Time: 16 October 2013, 4:30:50.194 pm UUID: d0c77ca3-8fb8-41d8-886b-f40fa4555b88 Ancestors: VMMaker.oscog-eem.462
Don't assume new segment is above all other segments. Fix arg count bug in primitiveGrowMemoryByAtLeast. Add assimilateNewSegment: to avoid overriding so much in Spur32BitCoMemoryManager & hence nuke its growOldSpaceByAtLeast:. Add a fudge factor (2 * baseHeaderSize + bridgeSize) to growOldSpaceByAtLeast: and round p the request to a power-of-two.
=============== Diff against VMMaker.oscog-eem.462 ===============
Item was changed: ----- Method: InterpreterPrimitives>>primitiveGrowMemoryByAtLeast (in category 'memory space primitives') ----- primitiveGrowMemoryByAtLeast <option: #SpurObjectMemory> | ammount | ammount := self stackTop. (objectMemory isIntegerObject: ammount) ifFalse: [^self primitiveFailFor: PrimErrBadArgument]. - self halt. (objectMemory growOldSpaceByAtLeast: (objectMemory integerValueOf: ammount)) ifNil: [self primitiveFailFor: PrimErrNoMemory] + ifNotNil: [:segSize| self pop: 2 thenPushInteger: segSize]! - ifNotNil: [:segSize| self pop: 1 thenPushInteger: segSize]!
Item was added: + ----- Method: Spur32BitCoMemoryManager>>assimilateNewSegment: (in category 'growing/shrinking memory') ----- + assimilateNewSegment: segInfo + "Update after adding a segment. + Here we make sure the new segment is not executable." + <var: #segInfo type: #'SpurSegmentInfo *'> + coInterpreter + sqMakeMemoryNotExecutableFrom: segInfo segStart + To: segInfo segStart + segInfo segSize!
Item was removed: - ----- Method: Spur32BitCoMemoryManager>>growOldSpaceByAtLeast: (in category 'growing/shrinking memory') ----- - growOldSpaceByAtLeast: minAmmount - "Attempt to grow memory by at least minAmmount. - Answer the size of the new segment, or nil if the attempt failed. - Override to remove execute permission from the new segment." - | ammount | - <var: #segInfo type: #'SpurSegmentInfo *'> - statGrowMemory := statGrowMemory + 1. - ammount := minAmmount max: growHeadroom. - ^(segmentManager addSegmentOfSize: ammount) ifNotNil: - [:segInfo| - freeOldSpaceStart := - endOfMemory := segInfo segStart + segInfo segSize - self bridgeSize. - coInterpreter sqMakeMemoryNotExecutableFrom: segInfo segStart To: segInfo segStart + segInfo segSize. - segInfo segSize]!
Item was added: + ----- Method: SpurMemoryManager>>assimilateNewSegment: (in category 'growing/shrinking memory') ----- + assimilateNewSegment: segInfo + "Update after adding a segment. + Here we set freeOldSpaceStart & endOfMemory if required." + <var: #segInfo type: #'SpurSegmentInfo *'> + segInfo segStart >= endOfMemory ifTrue: + [freeOldSpaceStart := + endOfMemory := segInfo segStart + segInfo segSize - self bridgeSize]!
Item was changed: ----- Method: SpurMemoryManager>>growOldSpaceByAtLeast: (in category 'growing/shrinking memory') ----- growOldSpaceByAtLeast: minAmmount "Attempt to grow memory by at least minAmmount. Answer the size of the new segment, or nil if the attempt failed." | ammount | <var: #segInfo type: #'SpurSegmentInfo *'> + "statGrowMemory counts attempts, not successes." statGrowMemory := statGrowMemory + 1. + "we need to include overhead for a new object header plus the segment bridge." + ammount := minAmmount + (self baseHeaderSize * 2 + self bridgeSize). + "round up to the nearest power of two." + ammount := 1 << (ammount - 1) highBit. + "and grow by at least growHeadroom." + ammount := ammount max: growHeadroom. - ammount := minAmmount max: growHeadroom. ^(segmentManager addSegmentOfSize: ammount) ifNotNil: [:segInfo| + self assimilateNewSegment: segInfo. + segInfo segSize]! - freeOldSpaceStart := - endOfMemory := segInfo segStart + segInfo segSize - self bridgeSize]!
Item was changed: ----- Method: SpurSegmentManager>>addSegmentOfSize: (in category 'growing/shrinking memory') ----- addSegmentOfSize: ammount <returnTypeC: #'SpurSegmentInfo *'> | allocatedSize | - <var: #oldSeg type: #'SpurSegmentInfo *'> <var: #newSeg type: #'SpurSegmentInfo *'> - numSegments = numSegInfos ifTrue: - [self allocateOrExtendSegmentInfos]. - self assert: numSegments < numSegInfos. (manager "sent to the manager so that the simulator can increase memory to simulate a new segment" sqAllocateMemorySegmentOfSize: ammount Above: manager newSpaceLimit AllocatedSizeInto: (self cCode: [self addressOf: allocatedSize] inSmalltalk: [[:sz| allocatedSize := sz]])) ifNotNil: + [:segAddress| | newSegIndex newSeg | + newSegIndex := self insertSegmentFor: segAddress. + newSeg := self addressOf: (segments at: newSegIndex). - [:segAddress| | newSeg oldSeg segEnd bridgeSpan clifton | - oldSeg := self addressOf: (segments at: numSegments - 1). - newSeg := self addressOf: (segments at: numSegments). - numSegments := numSegments + 1. newSeg segStart: segAddress; 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" - segEnd := oldSeg segStart + oldSeg segSize. - bridgeSpan := segAddress - segEnd + manager bridgeSize. - clifton := segEnd - manager bridgeSize. "clifton is where the Avon bridge begins..." - "the old bridge should be the terminator." - self assert: (manager numSlotsOfAny: (manager objectStartingAt: clifton)) = 0. - manager initSegmentBridgeWithBytes: bridgeSpan at: clifton. - "the bridge should get us to the next segment" - self assert: (manager addressAfter: (manager objectStartingAt: clifton)) = newSeg segStart. - "and add the new free chunk to the free list" manager addFreeChunkWithBytes: allocatedSize - manager bridgeSize at: newSeg segStart. + self assert: (manager addressAfter: (manager objectStartingAt: newSeg segStart)) + = (newSeg segStart + newSeg segSize - manager bridgeSize). - self assert: (manager addressAfter: (manager objectStartingAt: newSeg segStart)) = (newSeg segStart + newSeg segSize - manager bridgeSize). ^newSeg]. ^nil!
Item was changed: ----- Method: SpurSegmentManager>>allocateOrExtendSegmentInfos (in category 'private') ----- allocateOrExtendSegmentInfos "Increase the number of allocated segInfos by 16." + <returnTypeC: #void> | newNumSegs | numSegInfos = 0 ifTrue: [numSegInfos := 16. segments := self cCode: [self c: numSegInfos alloc: (self sizeof: SpurSegmentInfo)] inSmalltalk: [CArrayAccessor on: ((1 to: numSegInfos) collect: [:i| SpurSegmentInfo new])]. ^self]. newNumSegs := numSegInfos + 16. segments := self cCode: [self re: newNumSegs * (self sizeof: SpurSegmentInfo) alloc: segments] inSmalltalk: [CArrayAccessor on: segments object, ((numSegInfos to: newNumSegs) collect: [:i| SpurSegmentInfo new])]. self cCode: [segments = 0 ifTrue: [self error: 'out of memory; cannot allocate more segments']. self me: segments + numSegInfos ms: 0 et: newNumSegs - numSegInfos * (self sizeof: SpurSegmentInfo)]. numSegInfos := newNumSegs!
Item was added: + ----- Method: SpurSegmentManager>>bridgeFrom:to: (in category 'growing/shrinking memory') ----- + bridgeFrom: aSegment to: nextSegmentOrNil + "Create a bridge from aSegment to the next segment, + or create a terminating bridge if there is no next segment." + <var: #aSegment type: #'SpurSegmentInfo *'> + <var: #nextSegmentOrNil type: #'SpurSegmentInfo *'> + | segEnd clifton bridgeSpan | + segEnd := aSegment segStart + aSegment segSize. + clifton := segEnd - manager bridgeSize. "clifton is where the Avon bridge begins..." + bridgeSpan := nextSegmentOrNil + ifNil: [manager bridgeSize] + ifNotNil: [nextSegmentOrNil segStart - segEnd + manager bridgeSize]. + manager initSegmentBridgeWithBytes: bridgeSpan at: clifton. + "the revised bridge should get us to the new segment" + self assert: (nextSegmentOrNil isNil + or: [(manager addressAfter: (manager objectStartingAt: clifton)) = nextSegmentOrNil segStart]) + !
Item was added: + ----- 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) segStart + (segments at: 0) segSize). + numSegments = numSegInfos ifTrue: + [self allocateOrExtendSegmentInfos]. + self assert: numSegments < numSegInfos. + segIndex := lastSegIndex := numSegments - 1. + numSegments := numSegments + 1. + [segAddress > ((segments at: segIndex) segStart + + (segments at: segIndex) segSize) 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