[Vm-dev] VM Maker: VMMaker.oscog-eem.463.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Oct 16 23:33:30 UTC 2013
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!
More information about the Vm-dev
mailing list