[Vm-dev] VM Maker: VMMaker.oscog-eem.772.mcz
commits at source.squeak.org
commits at source.squeak.org
Sat Jun 14 02:38:29 UTC 2014
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.772.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.772
Author: eem
Time: 13 June 2014, 7:26:03.053 pm
UUID: c15ccff3-56a1-484d-af3b-0ee906a7a24b
Ancestors: VMMaker.oscog-eem.771
Spur:
Fix fillObj: signedness for objects straddling the mid-
point of the address space (quickly affects linux).
Similarly for routines in pigCompact, to get asserts correct.
Fix printOopsFrom:to:. for objects up to endOfMemory.
Nuke unused SpurMemMgr inst var var.
Declare lastFreeChunk and firstFreeChunk correctly.
Fix numberOfForwarders: and printForwarders: for
isForwarded:'s blindness towards freeChunks.
Comment isForwarded: to be clear on the issue.
Have the segment manager pass to sqAllocateMemory-
SegmentOfSize: the address of the first large enough
gap in the address space, instead of the address of the
end of the first segment. This allows e.g. linux to use
MAP_FIXED and hence get past a 128Mb limit on mmapping.
Cog:
Fix an abort (relocating call to invalid address) ue to an
over-zealous check in relocateCallBeforeReturnPC:by:.
Since we relocate e.g. calls to primitives there can be no
effective range check there-in.
=============== Diff against VMMaker.oscog-eem.771 ===============
Item was changed:
----- Method: CogIA32Compiler>>relocateCallBeforeReturnPC:by: (in category 'inline cacheing') -----
relocateCallBeforeReturnPC: retpc by: delta
| distance |
delta ~= 0 ifTrue:
[distance := ((objectMemory byteAt: retpc - 1) << 24)
+ ((objectMemory byteAt: retpc - 2) << 16)
+ ((objectMemory byteAt: retpc - 3) << 8)
+ (objectMemory byteAt: retpc - 4).
distance := distance + delta.
objectMemory
byteAt: retpc - 1 put: (distance >> 24 bitAnd: 16rFF);
byteAt: retpc - 2 put: (distance >> 16 bitAnd: 16rFF);
byteAt: retpc - 3 put: (distance >> 8 bitAnd: 16rFF);
+ byteAt: retpc - 4 put: (distance bitAnd: 16rFF)]!
- byteAt: retpc - 4 put: (distance bitAnd: 16rFF).
- (self asserta: (self callTargetFromReturnAddress: retpc) >= cogit minCallAddress) ifFalse:
- [self error: 'relocating call to invalid address']]!
Item was changed:
----- Method: Spur32BitMemoryManager>>fillObj:numSlots:with: (in category 'instantiation') -----
fillObj: objOop numSlots: numSlots with: fillValue
<inline: true>
+ <var: #p type: #usqInt>
self assert: (self oop: objOop + self baseHeaderSize + (numSlots * self bytesPerSlot) - 1
isLessThan: (self addressAfter: objOop)).
+ (objOop + self baseHeaderSize) asUnsignedInteger
+ to: (objOop + self baseHeaderSize + (numSlots * self bytesPerSlot) - 1) asUnsignedInteger
- objOop + self baseHeaderSize
- to: objOop + self baseHeaderSize + (numSlots * self bytesPerSlot) - 1
by: self allocationUnit
do: [:p|
self longAt: p put: fillValue;
longAt: p + 4 put: fillValue]!
Item was changed:
----- Method: Spur64BitMemoryManager>>fillObj:numSlots:with: (in category 'instantiation') -----
fillObj: objOop numSlots: numSlots with: fillValue
<inline: true>
+ <var: #p type: #usqInt>
self assert: (self oop: objOop + self baseHeaderSize + (numSlots * self bytesPerSlot) - 1
isLessThan: (self addressAfter: objOop)).
+ (objOop + self baseHeaderSize) asUnsignedInteger
+ to: (objOop + self baseHeaderSize + (numSlots * self bytesPerSlot) - 1) asUnsignedInteger
- objOop + self baseHeaderSize
- to: objOop + self baseHeaderSize + (numSlots * self bytesPerSlot) - 1
by: self allocationUnit
do: [:p| self longAt: p put: fillValue]!
Item was changed:
CogClass subclass: #SpurMemoryManager
(excessive size, no diff calculated)
Item was changed:
----- Method: SpurMemoryManager class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
self declareCAsOop: #( memory freeStart scavengeThreshold newSpaceStart newSpaceLimit pastSpaceStart
+ lowSpaceThreshold freeOldSpaceStart oldSpaceStart endOfMemory firstFreeChunk lastFreeChunk)
- lowSpaceThreshold freeOldSpaceStart oldSpaceStart endOfMemory sortedFreeChunks)
in: aCCodeGenerator.
self declareCAsUSqLong: (self allInstVarNames select: [:ivn| ivn endsWith: 'Usecs'])
in: aCCodeGenerator.
aCCodeGenerator
var: #freeListsMask type: #usqInt;
var: #freeLists type: #'sqInt *';
var: #classTableBitmap type: #'unsigned char *';
var: #objStackInvalidBecause type: #'char *';
var: #highestObjects type: #SpurCircularBuffer;
var: #unscannedEphemerons type: #SpurContiguousObjStack;
var: #heapGrowthToSizeGCRatio type: #float;
var: #heapSizeAtPreviousGC type: #usqInt.
aCCodeGenerator
var: #remapBuffer
declareC: 'sqInt remapBuffer[RemapBufferSize + 1 /* ', (RemapBufferSize + 1) printString, ' */]'.
aCCodeGenerator
var: #extraRoots
declareC: 'sqInt *extraRoots[ExtraRootsSize + 1 /* ', (ExtraRootsSize + 1) printString, ' */]'!
Item was changed:
----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfBytes:suchThat: (in category 'free space') -----
allocateOldSpaceChunkOfBytes: chunkBytes suchThat: acceptanceBlock
"Answer a chunk of oldSpace from the free lists that satisfies acceptanceBlock,
if available, otherwise answer nil. Break up a larger chunk if one of the exact
size cannot be found. N.B. the chunk is simply a pointer, it has no valid header.
The caller *must* fill in the header correctly."
| initialIndex node next prev index child childBytes acceptedChunk acceptedNode |
<inline: true> "must inline for acceptanceBlock"
- self assert: (lastSubdividedFreeChunk := 0) = 0.
"for debugging:" "totalFreeOldSpace := self totalFreeListBytes"
totalFreeOldSpace := totalFreeOldSpace - chunkBytes. "be optimistic (& don't wait for the write)"
initialIndex := chunkBytes / self allocationUnit.
(initialIndex < self numFreeLists and: [1 << initialIndex <= freeListsMask]) ifTrue:
[(freeListsMask anyMask: 1 << initialIndex) ifTrue:
[(node := freeLists at: initialIndex) = 0
ifTrue: [freeListsMask := freeListsMask - (1 << initialIndex)]
ifFalse:
[prev := 0.
[node ~= 0] whileTrue:
[self assert: node = (self startOfObject: node).
self assert: (self isValidFreeObject: node).
next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
(acceptanceBlock value: node) ifTrue:
[prev = 0
ifTrue: [freeLists at: initialIndex put: next]
ifFalse: [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next].
^node].
prev := node.
node := next]]].
"first search for free chunks of a multiple of chunkBytes in size"
index := initialIndex.
[(index := index + initialIndex) < self numFreeLists
and: [1 << index <= freeListsMask]] whileTrue:
[(freeListsMask anyMask: 1 << index) ifTrue:
[(node := freeLists at: index) = 0
ifTrue: [freeListsMask := freeListsMask - (1 << index)]
ifFalse:
[prev := 0.
[node ~= 0] whileTrue:
[self assert: node = (self startOfObject: node).
self assert: (self isValidFreeObject: node).
next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
(acceptanceBlock value: node) ifTrue:
[prev = 0
ifTrue: [freeLists at: index put: next]
ifFalse: [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next].
self freeChunkWithBytes: index * self allocationUnit - chunkBytes
at: (self startOfObject: node) + chunkBytes.
^node].
prev := node.
node := next]]]].
"now get desperate and use the first that'll fit.
Note that because the minimum free size is 16 bytes (2 * allocationUnit), to
leave room for the forwarding pointer/next free link, we can only break chunks
that are at least 16 bytes larger, hence start at initialIndex + 2."
index := initialIndex + 1.
[(index := index + 1) < self numFreeLists
and: [1 << index <= freeListsMask]] whileTrue:
[(freeListsMask anyMask: 1 << index) ifTrue:
[(node := freeLists at: index) = 0
ifTrue: [freeListsMask := freeListsMask - (1 << index)]
ifFalse:
[prev := 0.
[node ~= 0] whileTrue:
[self assert: node = (self startOfObject: node).
self assert: (self isValidFreeObject: node).
next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
(acceptanceBlock value: node) ifTrue:
[prev = 0
ifTrue: [freeLists at: index put: next]
ifFalse: [self storePointer: self freeChunkNextIndex ofFreeChunk: prev withValue: next].
self freeChunkWithBytes: index * self allocationUnit - chunkBytes
at: (self startOfObject: node) + chunkBytes.
^node].
prev := node.
node := next]]]]].
"Large chunk, or no space on small free lists. Search the large chunk list.
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.
When the search ends parent should hold the smallest chunk at least as
large as chunkBytes, or 0 if none. acceptedChunk and acceptedNode save
us from having to back-up when the acceptanceBlock filters-out all nodes
of the right size, but there are nodes of the wrong size it does accept."
child := freeLists at: 0.
node := acceptedChunk := acceptedNode := 0.
[child ~= 0] whileTrue:
[self assert: (self isValidFreeObject: child).
childBytes := self bytesInObject: child.
childBytes = chunkBytes ifTrue: "size match; try to remove from list at node."
[node := child.
[prev := node.
node := self fetchPointer: self freeChunkNextIndex ofFreeChunk: node.
node ~= 0] whileTrue:
[(acceptanceBlock value: node) ifTrue:
[self assert: (self isValidFreeObject: node).
self storePointer: self freeChunkNextIndex
ofFreeChunk: prev
withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node).
^self startOfObject: node]].
(acceptanceBlock value: child) ifTrue:
[next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: child.
next = 0
ifTrue: "no list; remove the interior node"
[self unlinkSolitaryFreeTreeNode: child]
ifFalse: "list; replace node with it"
[self inFreeTreeReplace: child with: next].
^self startOfObject: child]].
child ~= 0 ifTrue:
["Note that because the minimum free size is 16 bytes (2 * allocationUnit), to
leave room for the forwarding pointer/next free link, we can only break chunks
that are at least 16 bytes larger, hence reject chunks < 2 * allocationUnit larger."
childBytes <= (chunkBytes + self allocationUnit)
ifTrue: "node too small; walk down the larger size of the tree"
[child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child]
ifFalse:
[self flag: 'we can do better here; preferentially choosing the lowest node. That would be a form of best-fit since we are trying to compact down'.
node := child.
child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: node.
acceptedNode = 0 ifTrue:
[acceptedChunk := node.
"first search the list."
[acceptedChunk := self fetchPointer: self freeChunkNextIndex
ofFreeChunk: acceptedChunk.
(acceptedChunk ~= 0 and: [acceptanceBlock value: acceptedChunk]) ifTrue:
[acceptedNode := node].
acceptedChunk ~= 0 and: [acceptedNode = 0]] whileTrue.
"nothing on the list; will the node do? This prefers
acceptable nodes higher up the tree over acceptable
list elements further down, but we haven't got all day..."
(acceptedNode = 0
and: [acceptanceBlock value: node]) ifTrue:
[acceptedNode := node.
child := 0 "break out of loop now we have an acceptedNode"]]]]].
acceptedNode ~= 0 ifTrue:
[acceptedChunk ~= 0 ifTrue:
[self assert: (self bytesInObject: acceptedChunk) >= (chunkBytes + self allocationUnit).
[next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedNode.
next ~= acceptedChunk] whileTrue:
[acceptedNode := next].
self storePointer: self freeChunkNextIndex
ofFreeChunk: acceptedNode
withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedChunk).
self freeChunkWithBytes: (self bytesInObject: acceptedChunk) - chunkBytes
at: (self startOfObject: acceptedChunk) + chunkBytes.
^self startOfObject: acceptedChunk].
next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: acceptedNode.
next = 0
ifTrue: "no list; remove the interior node"
[self unlinkSolitaryFreeTreeNode: acceptedNode]
ifFalse: "list; replace node with it"
[self inFreeTreeReplace: acceptedNode with: next].
self assert: (self bytesInObject: acceptedNode) >= (chunkBytes + self allocationUnit).
self freeChunkWithBytes: (self bytesInObject: acceptedNode) - chunkBytes
at: (self startOfObject: acceptedNode) + chunkBytes.
^self startOfObject: acceptedNode].
totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded"
^nil!
Item was changed:
----- Method: SpurMemoryManager>>eliminateAndFreeForwardersForPigCompact (in category 'gc - global') -----
eliminateAndFreeForwardersForPigCompact
"As the final phase of global garbage collect, sweep the heap to follow
forwarders, then free forwarders, coalescing with free space as we go."
<inline: false>
| lowestForwarder |
+ <var: #lowestForwarder type: #usqInt>
self assert: (self isForwarded: nilObj) not.
self assert: (self isForwarded: falseObj) not.
self assert: (self isForwarded: trueObj) not.
self assert: (self isForwarded: self freeListsObj) not.
self assert: (self isForwarded: hiddenRootsObj) not.
self assert: (self isForwarded: classTableFirstPage) not.
self followSpecialObjectsOop.
self followForwardedObjStacks.
coInterpreter mapInterpreterOops.
scavenger followRememberedForwardersAndForgetFreeObjectsForPigCompact.
self unmarkSurvivingObjectsForPigCompact.
lowestForwarder := self sweepToFollowForwardersForPigCompact.
self sweepToCoallesceFreeSpaceForPigCompactFrom: lowestForwarder.
self assert: self numberOfForwarders = 0!
Item was changed:
----- Method: SpurMemoryManager>>isForwarded: (in category 'object testing') -----
isForwarded: objOop
"Answer if objOop is that if a forwarder. Take advantage of isForwardedObjectClassIndexPun
being a power of two to generate a more efficient test than the straight-forward
(self classIndexOf: objOop) = self isForwardedObjectClassIndexPun
+ at the cost of this being ambiguous with free chunks. So either never apply this to free chunks
+ or guard with (self isFreeObject: foo) not. So far the idiom has been to guard with isFreeObject:"
- "
<api>
^(self longAt: objOop) noMask: self classIndexMask - self isForwardedObjectClassIndexPun!
Item was changed:
----- Method: SpurMemoryManager>>numberOfForwarders (in category 'debug support') -----
numberOfForwarders
| n |
n := 0.
self allHeapEntitiesDo:
[:o|
+ ((self isForwarded: o) and: [(self isFreeObject: o) not]) ifTrue:
- (self isForwarded: o) ifTrue:
[n := n + 1]].
^n!
Item was changed:
----- Method: SpurMemoryManager>>printForwarders (in category 'debug printing') -----
printForwarders
<api>
self allHeapEntitiesDo:
[:objOop|
+ ((self isForwarded: objOop) and: [(self isFreeObject: objOop) not]) ifTrue:
- (self isForwarded: objOop) ifTrue:
[coInterpreter printHex: objOop; cr]]!
Item was changed:
----- Method: SpurMemoryManager>>printOopsFrom:to: (in category 'debug printing') -----
printOopsFrom: startAddress to: endAddress
<api>
+ | oop limit |
- | oop |
oop := self objectBefore: startAddress.
+ limit := endAddress asUnsignedLong min: endOfMemory.
oop := oop
ifNil: [startAddress]
ifNotNil: [(self objectAfter: oop) = startAddress
ifTrue: [startAddress]
ifFalse: [oop]].
+ [self oop: oop isLessThan: limit] whileTrue:
- [self oop: oop isLessThan: endAddress] whileTrue:
[coInterpreter
printHex: oop; print: '/'; printNum: oop; space;
print: ((self isFreeObject: oop) ifTrue: ['free'] ifFalse:
[(self isSegmentBridge: oop) ifTrue: ['bridge'] ifFalse:
[(self isForwarded: oop) ifTrue: ['forwarder'] ifFalse:
['object']]]);
cr.
oop := self objectAfter: oop]!
Item was changed:
----- Method: SpurMemoryManager>>sortedFreeListDo: (in category 'compaction') -----
sortedFreeListDo: aBlock
"Evaluate aBlock with ascending entries in the free list"
| free nextFree prevFree prevPrevFree |
+ <var: #free type: #usqInt>
+ <var: #nextFree type: #usqInt>
+ <var: #prevFree type: #usqInt>
+ <var: #prevPrevFree type: #usqInt>
<inline: true>
free := firstFreeChunk.
prevPrevFree := prevFree := 0.
[free ~= 0] whileTrue:
[nextFree := self nextInSortedFreeListLink: free given: prevFree.
self assert: (self isFreeObject: free).
self assert: (nextFree = 0 or: [nextFree > free and: [self isFreeObject: nextFree]]).
self assert: (prevFree = 0 or: [prevFree < free]).
aBlock value: free.
prevPrevFree := prevFree.
prevFree := free.
free := nextFree]!
Item was changed:
----- Method: SpurMemoryManager>>sortedFreeListPairwiseReverseDo: (in category 'compaction') -----
sortedFreeListPairwiseReverseDo: aBinaryBlock
"Evaluate aBinaryBlock with adjacent entries in the free list, from
high address to low address. The second argument is in fact the
start of the next free chunk, not the free chunk itself. Use
endOfMemory - bridgeSize as the second argument in the first evaluation."
| free prevFree prevPrevFree |
+ <var: #free type: #usqInt>
+ <var: #prevFree type: #usqInt>
+ <var: #prevPrevFree type: #usqInt>
<inline: true>
free := lastFreeChunk.
prevPrevFree := prevFree := 0.
[free ~= 0] whileTrue:
[aBinaryBlock value: free value: (prevFree = 0
ifTrue: [endOfMemory - self bridgeSize]
ifFalse: [self startOfObject: prevFree]).
"post evaluation of aBinaryBlock the value of free may be invalid
because moveARunOfObjectsStartingAt:upTo: may have filled it.
So reconstruct the position in the enumeration."
prevFree = 0
ifTrue:
[self assert: free = lastFreeChunk.
prevFree := lastFreeChunk.
free := self nextInSortedFreeListLink: lastFreeChunk given: 0]
ifFalse:
[self assert: (self isFreeObject: prevFree).
prevPrevFree = 0
ifTrue:
[prevPrevFree := lastFreeChunk.
prevFree := self nextInSortedFreeListLink: lastFreeChunk given: 0]
ifFalse:
[self assert: (self isFreeObject: prevPrevFree).
free := self nextInSortedFreeListLink: prevFree given: prevPrevFree.
prevPrevFree := prevFree.
prevFree := free].
free := self nextInSortedFreeListLink: prevFree given: prevPrevFree]]!
Item was changed:
----- Method: SpurMemoryManager>>sweepToCoallesceFreeSpaceForPigCompactFrom: (in category 'compaction') -----
sweepToCoallesceFreeSpaceForPigCompactFrom: lowestForwarder
"Coallesce free chunks and forwarders, maintaining the doubly-linked free list."
| lowest firstOfFreeRun startOfFreeRun endOfFreeRun prevPrevFree prevFree |
+ <var: #lowestForwarder type: #usqInt>
lowest := (lowestForwarder = 0 ifTrue: [endOfMemory] ifFalse: [lowestForwarder])
min: (firstFreeChunk = 0 ifTrue: [endOfMemory] ifFalse: [firstFreeChunk]).
firstOfFreeRun := prevPrevFree := prevFree := 0.
self allOldSpaceEntitiesFrom: lowest do:
[:o|
((self isFreeObject: o) or: [self isForwarded: o])
ifTrue:
[firstOfFreeRun = 0 ifTrue:
[self setObjectFree: o.
firstOfFreeRun := o.
startOfFreeRun := self startOfObject: o].
endOfFreeRun := o]
ifFalse:
[firstOfFreeRun ~= 0 ifTrue:
[| bytes |
bytes := (self addressAfter: endOfFreeRun) - startOfFreeRun.
firstOfFreeRun := self initFreeChunkWithBytes: bytes at: startOfFreeRun.
self inSortedFreeListLink: prevFree to: firstOfFreeRun given: prevPrevFree.
prevPrevFree := prevFree.
prevFree := firstOfFreeRun.
firstOfFreeRun := 0]]].
firstOfFreeRun ~= 0 ifTrue:
[| bytes |
bytes := (self addressAfter: endOfFreeRun) - startOfFreeRun.
firstOfFreeRun := self initFreeChunkWithBytes: bytes at: startOfFreeRun.
self inSortedFreeListLink: prevFree to: firstOfFreeRun given: prevPrevFree.
prevPrevFree := prevFree.
prevFree := firstOfFreeRun.
firstOfFreeRun := 0].
prevFree ~= firstFreeChunk ifTrue:
[self storePointer: self freeChunkNextIndex
ofFreeChunk: prevFree
withValue: prevPrevFree].
lastFreeChunk := prevFree.
self inSortedFreeListLink: lastFreeChunk to: 0 given: prevPrevFree.
self assert: self checkTraversableSortedFreeList!
Item was changed:
----- Method: SpurMemoryManager>>sweepToFollowForwardersForPigCompact (in category 'compaction') -----
sweepToFollowForwardersForPigCompact
"Sweep, following forwarders in all live objects.
Answer the lowest forwarder in oldSpace."
| lowestForwarder |
+ <var: #lowestForwarder type: #usqInt>
self assert: (freeStart = scavenger eden start
and: [scavenger futureSurvivorStart = scavenger futureSpace start]).
self allPastSpaceObjectsDo:
[:o|
(self isForwarded: o) ifFalse:
[0 to: (self numPointerSlotsOf: o) - 1 do:
[:i| | f |
f := self fetchPointer: i ofObject: o.
(self isOopForwarded: f) ifTrue:
[f := self followForwarded: f.
self storePointerUnchecked: i ofObject: o withValue: f]]]].
lowestForwarder := 0.
self allOldSpaceObjectsDo:
[:o|
(self isForwarded: o)
ifTrue:
[lowestForwarder = 0 ifTrue:
[lowestForwarder := 0]]
ifFalse:
[0 to: (self numPointerSlotsOf: o) - 1 do:
[:i| | f |
f := self fetchPointer: i ofObject: o.
(self isOopForwarded: f) ifTrue:
[f := self followForwarded: f.
self storePointer: i ofObject: o withValue: f]]]].
^lowestForwarder!
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: (self firstGapOfSizeAtLeast: 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)]).
"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]])].
^newSeg].
^nil!
Item was added:
+ ----- Method: SpurSegmentManager>>firstGapOfSizeAtLeast: (in category 'growing/shrinking memory') -----
+ firstGapOfSizeAtLeast: size
+ "Answer the segment limit of the first segment followed by a gap of at least size bytes."
+ 0 to: numSegments - 2 do:
+ [:i| | bridge |
+ bridge := self bridgeAt: i.
+ (manager bytesInObject: bridge) - manager bridgeSize >= size ifTrue:
+ [^(segments at: i) segLimit asVoidPointer]].
+ ^(segments at: numSegments - 1) segLimit asVoidPointer!
More information about the Vm-dev
mailing list