[Vm-dev] VM Maker: VMMaker.oscog-eem.441.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Oct 8 22:05:17 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.441.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.441
Author: eem
Time: 8 October 2013, 3:01:35.105 pm
UUID: 3ace9016-94ec-4db2-85a0-ef1e4589f5d2
Ancestors: VMMaker.oscog-eem.440
Initialize a SpurMemoryManager's SpurSegmentManager.
Initialize the end-of-segment zero-sized bridge.
Provide covenient initializers for segment bridge headers.
Add wordSizeClassPun & wordIndexableFormat abstractions for
free lists & bridges that vary from 32- to 64-bit.
Fix bug in, and simplify allocateOldSpaceChunkOfExactlyBytes:.
get the terminology right; sionara isSegmentSpanningFakeObjectPun ;-)
Rename convertFloatsToPlatformOrderFrom:to: to
convertFloatsToPlatformOrder (args unused).
Recategorize the puns.
=============== Diff against VMMaker.oscog-eem.440 ===============
Item was added:
+ ----- Method: Spur32BitMMLESimulator>>freeLists (in category 'spur bootstrap') -----
+ freeLists
+ ^freeLists!
Item was added:
+ ----- Method: Spur32BitMemoryManager>>initSegmentBridgeWithBytes:at: (in category 'segments') -----
+ initSegmentBridgeWithBytes: numBytes at: address
+ <var: #numBytes type: #usqLong>
+ | numSlots |
+ "must have room for a double header"
+ self assert: (numBytes \\ self allocationUnit = 0
+ and: [numBytes >= (self baseHeaderSize + self baseHeaderSize)]).
+ self flag: #endianness.
+ numSlots := numBytes - self baseHeaderSize - self baseHeaderSize >> self shiftForWord.
+ self longAt: address put: numSlots;
+ longAt: address + 4 put: self numSlotsMask << self numSlotsHalfShift;
+ longAt: address + 8 put: (1 << self pinnedBitShift)
+ + (self wordIndexableFormat << self formatShift)
+ + self segmentBridgePun;
+ longAt: address + 12 put: self numSlotsMask << self numSlotsHalfShift!
Item was added:
+ ----- Method: Spur32BitMemoryManager>>wordIndexableFormat (in category 'header formats') -----
+ wordIndexableFormat
+ ^self firstLongFormat!
Item was added:
+ ----- Method: Spur32BitMemoryManager>>wordSizeClassIndexPun (in category 'class table') -----
+ wordSizeClassIndexPun
+ ^self thirtyTwoBitLongsClassIndexPun!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>initSegmentBridgeWithBytes:at: (in category 'segments') -----
+ initSegmentBridgeWithBytes: numBytes at: address
+ | numSlots |
+ <var: #numBytes type: #usqLong>
+ self assert: (numBytes >= (self baseHeaderSize + self baseHeaderSize)
+ and: [numBytes \\ self allocationUnit = 0]).
+ numSlots := numBytes - self baseHeaderSize - self baseHeaderSize >> self shiftForWord.
+ self longAt: address
+ put: self numSlotsMask << self numSlotsFullShift + numSlots;
+ longAt: address + self baseHeaderSize
+ put: (self numSlotsMask << self numSlotsFullShift)
+ + (1 << self pinnedBitShift)
+ + (self wordIndexableFormat << self formatShift)
+ + self segmentBridgePun!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>wordIndexableFormat (in category 'header formats') -----
+ wordIndexableFormat
+ ^self sixtyFourBitIndexableFormat!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>wordSizeClassIndexPun (in category 'class table') -----
+ wordSizeClassIndexPun
+ ^self sixtyFourBitLongsClassIndexPun!
Item was changed:
CogClass subclass: #SpurMemoryManager
(excessive size, no diff calculated)
Item was changed:
----- Method: SpurMemoryManager>>allocateMemoryOfSize:newSpaceSize:stackSize:codeSize: (in category 'simulation') -----
allocateMemoryOfSize: memoryBytes newSpaceSize: newSpaceBytes stackSize: stackBytes codeSize: codeBytes
"Intialize the receiver for bootsraping an image.
Set up a large oldSpace and an empty newSpace and set-up freeStart and scavengeThreshold
to allocate in oldSpace. Later on (in initializePostBootstrap) freeStart and scavengeThreshold
will be set to sane values."
<doNotGenerate>
+ | endBridgeBytes |
self assert: (memoryBytes \\ self allocationUnit = 0
and: [newSpaceBytes \\ self allocationUnit = 0
and: [codeBytes \\ self allocationUnit = 0]]).
+ endBridgeBytes := 2 * self baseHeaderSize.
memory := (self endianness == #little
ifTrue: [LittleEndianBitmap]
+ ifFalse: [Bitmap]) new: (memoryBytes + newSpaceBytes + codeBytes + stackBytes + endBridgeBytes) // 4.
- ifFalse: [Bitmap]) new: (memoryBytes + newSpaceBytes + codeBytes + stackBytes) // 4.
startOfMemory := codeBytes + stackBytes.
endOfMemory := freeOldSpaceStart := memoryBytes + newSpaceBytes + codeBytes + stackBytes.
"leave newSpace empty for the bootstrap"
freeStart := newSpaceBytes + startOfMemory.
newSpaceLimit := newSpaceBytes + startOfMemory.
scavengeThreshold := memory size * 4. "Bitmap is a 4-byte per word array"
scavenger := SpurGenerationScavengerSimulator new
manager: self
newSpaceStart: startOfMemory
newSpaceBytes: newSpaceBytes
edenBytes: newSpaceBytes * 5 // 7 "David's paper uses 140Kb eden + 2 x 28kb survivor spaces :-)"!
Item was changed:
----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfExactlyBytes: (in category 'free space') -----
allocateOldSpaceChunkOfExactlyBytes: chunkBytes
"Answer a chunk of oldSpace from the free lists, if one of this size
is available, otherwise answer nil. N.B. the chunk is simply a pointer,
it has no valid header. The caller *must* fill in the header correctly."
+ | initialIndex node nodeBytes parent child smaller larger |
- | initialIndex chunk nodeBytes parent child smaller larger |
"for debugging:" "totalFreeOldSpace := self totalFreeListBytes"
initialIndex := chunkBytes / self allocationUnit.
initialIndex < self numFreeLists ifTrue:
[(1 << initialIndex <= freeListsMask
+ and: [(node := freeLists at: initialIndex) ~= 0]) ifTrue:
+ [self assert: node = (self startOfObject: node).
+ self assert: (self isValidFreeObject: node).
- and: [(chunk := freeLists at: initialIndex) ~= 0]) ifTrue:
- [self assert: chunk = (self startOfObject: chunk).
- self assert: (self isValidFreeObject: chunk).
totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
+ ^self unlinkFreeChunk: node atIndex: initialIndex].
- ^self unlinkFreeChunk: chunk atIndex: initialIndex].
^nil].
"Large chunk. 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 first chunk of
the same size as chunkBytes, or 0 if none."
+ node := 0.
- parent := chunk := 0.
child := freeLists at: 0.
[child ~= 0] whileTrue:
[| childBytes |
self assert: (self isValidFreeObject: child).
childBytes := self bytesInObject: child.
childBytes = chunkBytes
ifTrue: "size match; try to remove from list at node."
+ [node := self fetchPointer: self freeChunkNextIndex
- [chunk := self fetchPointer: self freeChunkNextIndex
ofFreeChunk: child.
+ node ~= 0 ifTrue:
+ [self assert: (self isValidFreeObject: node).
- chunk ~= 0 ifTrue:
- [self assert: (self isValidFreeObject: chunk).
self storePointer: self freeChunkNextIndex
ofFreeChunk: child
withValue: (self fetchPointer: self freeChunkNextIndex
+ ofFreeChunk: node).
- ofFreeChunk: chunk).
totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
+ ^self startOfObject: node].
+ node := child.
+ nodeBytes := childBytes.
- ^self startOfObject: chunk].
child := 0] "break out of loop to remove interior node"
ifFalse:
[childBytes < chunkBytes
ifTrue: "walk down the tree"
[child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child]
ifFalse:
+ [nodeBytes := childBytes.
- [parent := child.
- nodeBytes := childBytes.
child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]]].
"if no chunk, there was no exact fit"
+ node = 0 ifTrue:
- chunk = 0 ifTrue:
[^nil].
"self printFreeChunk: parent"
self assert: nodeBytes = chunkBytes.
+ self assert: (self bytesInObject: node) = chunkBytes.
- self assert: (self bytesInObject: parent) = chunkBytes.
"can't be a list; would have removed and returned it above."
+ self assert: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node) = 0.
- self assert: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: parent) = 0.
"no list; remove an interior node; reorder tree simply. two cases (which have mirrors, for four total):
case 1. interior node has one child, P = parent, N = node, S = subtree (mirrored for large vs small)
___ ___
| P | | P |
_/_ _/_
| N | => | S |
_/_
| S |
case 2: interior node has two children, , P = parent, N = node, L = smaller, left subtree, R = larger, right subtree.
add the left subtree to the bottom left of the right subtree (mirrored for large vs small)
___ ___
| P | | P |
_/_ _/_
| N | => | R |
_/_ _\_ _/_
| L | | R | | L |"
+ smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: node.
+ larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: node.
+ parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: node.
- chunk := parent.
- smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: chunk.
- larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: chunk.
- parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: chunk.
parent = 0
ifTrue: "no parent; stitch the subnodes back into the root"
[smaller = 0
ifTrue:
[self storePointer: self freeChunkParentIndex ofFreeChunk: larger withValue: 0.
freeLists at: 0 put: larger]
ifFalse:
[self storePointer: self freeChunkParentIndex ofFreeChunk: smaller withValue: 0.
freeLists at: 0 put: smaller.
larger ~= 0 ifTrue:
[self addFreeSubTree: larger]]]
ifFalse: "parent; stitch back into appropriate side of parent."
[smaller = 0
+ ifTrue: [self storePointer: (node = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent)
- ifTrue: [self storePointer: (chunk = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent)
ifTrue: [self freeChunkSmallerIndex]
ifFalse: [self freeChunkLargerIndex])
ofFreeChunk: parent
withValue: larger.
self storePointer: self freeChunkParentIndex
ofObject: larger
withValue: parent]
ifFalse:
+ [self storePointer: (node = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent)
- [self storePointer: (chunk = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent)
ifTrue: [self freeChunkSmallerIndex]
ifFalse: [self freeChunkLargerIndex])
ofFreeChunk: parent
withValue: smaller.
self storePointer: self freeChunkParentIndex
ofObject: smaller
withValue: parent.
larger ~= 0 ifTrue:
[self addFreeSubTree: larger]]].
+ ^self startOfObject: node!
- ^self startOfObject: chunk!
Item was changed:
+ ----- Method: SpurMemoryManager>>arrayClassIndexPun (in category 'class table puns') -----
- ----- Method: SpurMemoryManager>>arrayClassIndexPun (in category 'class table') -----
arrayClassIndexPun
"Class puns are class indices not used by any class. There is an entry
for the pun that refers to the notional class of objects with this class
index. But because the index doesn't match the class it won't show up
in allInstances, hence hiding the object with a pun as its class index.
The puns occupy indices 16 through 31."
^16!
Item was changed:
+ ----- Method: SpurMemoryManager>>classIsItselfClassIndexPun (in category 'class table puns') -----
- ----- Method: SpurMemoryManager>>classIsItselfClassIndexPun (in category 'class table') -----
classIsItselfClassIndexPun
^4!
Item was added:
+ ----- Method: SpurMemoryManager>>initSegmentBridgeWithBytes:at: (in category 'segments') -----
+ initSegmentBridgeWithBytes: numBytes at: address
+ <var: #numBytes type: #usqLong>
+ ^self subclassResponsibility!
Item was changed:
----- Method: SpurMemoryManager>>initialize (in category 'initialization') -----
initialize
+ "We can put all initializations that set something to 0 or to false here.
- "We can put all initializatins that set something to 0 or to false here.
In C all global variables are initialized to 0, and 0 is false."
remapBuffer := Array new: RemapBufferSize.
remapBufferCount := 0.
freeListsMask := totalFreeOldSpace := lowSpaceThreshold := 0.
checkForLeaks := 0.
needGCFlag := signalLowSpace := scavengeInProgress := false.
becomeEffectsFlags := 0.
statScavenges := statIncrGCs := statFullGCs := 0.
statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := 0.
statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0.
+ "we can initialize things that are virtual in C."
+ segmentManager := SpurSegmentManager new manager: self; yourself.
+
"We can also initialize here anything that is only for simulation."
heapMap := self wordSize = 4 ifTrue: [CogCheck32BitHeapMap new]!
Item was changed:
----- Method: SpurMemoryManager>>initializeOldSpaceFirstFree: (in category 'free space') -----
initializeOldSpaceFirstFree: startOfFreeOldSpace
<var: 'startOfFreeOldSpace' type: #usqLong>
| freeOldStart freeChunk |
<var: 'freeOldStart' type: #usqLong>
+
+ self initSegmentBridgeWithBytes: 2 * self baseHeaderSize at: endOfMemory.
-
endOfMemory > startOfFreeOldSpace ifTrue:
[totalFreeOldSpace := totalFreeOldSpace + (endOfMemory - startOfFreeOldSpace).
freeOldStart := startOfFreeOldSpace.
[endOfMemory - freeOldStart >= (2 raisedTo: 32)] whileTrue:
[freeChunk := self freeChunkWithBytes: (2 raisedTo: 32) at: freeOldStart.
freeOldStart := freeOldStart + (2 raisedTo: 32).
self assert: freeOldStart = (self addressAfter: freeChunk)].
freeOldStart < endOfMemory ifTrue:
[freeChunk := self freeChunkWithBytes: endOfMemory - freeOldStart at: freeOldStart.
self assert: (self addressAfter: freeChunk) = endOfMemory]].
freeOldSpaceStart := endOfMemory.
self checkFreeSpace!
Item was changed:
+ ----- Method: SpurMemoryManager>>isFreeObjectClassIndexPun (in category 'class table puns') -----
- ----- Method: SpurMemoryManager>>isFreeObjectClassIndexPun (in category 'class table') -----
isFreeObjectClassIndexPun
^0!
Item was added:
+ ----- Method: SpurMemoryManager>>isSegmentBridge: (in category 'segments') -----
+ isSegmentBridge: objOop
+ "Maybe this should be in SpurSegmentManager only"
+ ^(self classIndexOf: objOop) = self segmentBridgePun!
Item was removed:
- ----- Method: SpurMemoryManager>>isSegmentSpanningFakeObjectPun (in category 'class table') -----
- isSegmentSpanningFakeObjectPun
- ^3!
Item was added:
+ ----- Method: SpurMemoryManager>>isValidSegmentBridge: (in category 'segments') -----
+ isValidSegmentBridge: objOop
+ "Maybe this should be in SpurSegmentManager only"
+ ^(self addressCouldBeObj: objOop)
+ and: [(self isSegmentBridge: objOop)
+ and: [self hasOverflowHeader: objOop]]!
Item was added:
+ ----- Method: SpurMemoryManager>>segmentBridgePun (in category 'class table puns') -----
+ segmentBridgePun
+ ^3!
Item was added:
+ ----- Method: SpurMemoryManager>>segmentManager (in category 'accessing') -----
+ segmentManager
+ ^segmentManager!
Item was changed:
+ ----- Method: SpurMemoryManager>>sixtyFourBitLongsClassIndexPun (in category 'class table puns') -----
- ----- Method: SpurMemoryManager>>sixtyFourBitLongsClassIndexPun (in category 'class table') -----
sixtyFourBitLongsClassIndexPun
"Class puns are class indices not used by any class. There may be
an entry for the pun that refers to the notional class of objects with
this class index. But because the index doesn't match the class it
won't show up in allInstances, hence hiding the object with a pun as
its class index. The puns occupy indices 16 through 31."
^19!
Item was changed:
+ ----- Method: SpurMemoryManager>>thirtyTwoBitLongsClassIndexPun (in category 'class table puns') -----
- ----- Method: SpurMemoryManager>>thirtyTwoBitLongsClassIndexPun (in category 'class table') -----
thirtyTwoBitLongsClassIndexPun
"Class puns are class indices not used by any class. There may be
an entry for the pun that refers to the notional class of objects with
this class index. But because the index doesn't match the class it
won't show up in allInstances, hence hiding the object with a pun as
its class index. The puns occupy indices 16 through 31."
^18!
Item was changed:
+ ----- Method: SpurMemoryManager>>weakArrayClassIndexPun (in category 'class table puns') -----
- ----- Method: SpurMemoryManager>>weakArrayClassIndexPun (in category 'class table') -----
weakArrayClassIndexPun
"Class puns are class indices not used by any class. There is an entry
for the pun that refers to the notional class of objects with this class
index. But because the index doesn't match the class it won't show up
in allInstances, hence hiding the object with a pun as its class index.
The puns occupy indices 16 through 31."
^17!
Item was added:
+ ----- Method: SpurMemoryManager>>wordIndexableFormat (in category 'header formats') -----
+ wordIndexableFormat
+ "Either firstLongFormat or sixtyFourBitIndexableFormat"
+ ^self subclassResponsibility!
Item was added:
+ ----- Method: SpurMemoryManager>>wordSizeClassIndexPun (in category 'class table puns') -----
+ wordSizeClassIndexPun
+ ^self subclassResponsibility!
Item was added:
+ ----- Method: SpurSegmentManager>>initializeFromFreeChunks: (in category 'simulation only') -----
+ initializeFromFreeChunks: freeChunks
+ "For testing, create a set of segments using the freeChunks as bridges."
+ numSegments := freeChunks size.
+ freeChunks do:
+ [:f|
+ manager initSegmentBridgeWithBytes: (manager bytesInObject: f) at: (manager startOfObject: f).
+ self assert: (manager isSegmentBridge: f)].
+ segments := (1 to: numSegments) collect:
+ [:i| | start |
+ start := i = 1
+ ifTrue: [manager newSpaceLimit]
+ ifFalse: [manager addressAfter: (freeChunks at: i - 1)].
+ SpurSegmentInfo new
+ start: start;
+ segSize: (freeChunks at: i) + manager baseHeaderSize - start;
+ yourself].
+ segments := CArrayAccessor on: segments.
+ freeChunks do:
+ [:bridge| self assert: (manager isValidSegmentBridge: bridge)]!
Item was added:
+ ----- Method: SpurSegmentManager>>manager: (in category 'initialization') -----
+ manager: aSpurMemoryManager
+ manager := aSpurMemoryManager.
+ numSegments ifNil:
+ [numSegments := 0]!
Item was added:
+ ----- Method: StackInterpreter>>convertFloatsToPlatformOrder (in category 'image save/restore') -----
+ convertFloatsToPlatformOrder
+ "Byte-swap the words of all bytes objects in a range of the
+ image, including Strings, ByteArrays, and CompiledMethods.
+ This returns these objects to their original byte ordering
+ after blindly byte-swapping the entire image. For compiled
+ methods, byte-swap only their bytecodes part.
+ Ensure floats are in platform-order."
+ objectMemory vmEndianness = imageFloatsBigEndian ifTrue:
+ [^nil].
+ self assert: ClassFloatCompactIndex ~= 0.
+ objectMemory allObjectsDo:
+ [:obj| | temp |
+ (objectMemory compactClassIndexOf: obj) = ClassFloatCompactIndex ifTrue:
+ [temp := self longAt: obj + BaseHeaderSize.
+ self longAt: obj + BaseHeaderSize put: (self longAt: obj + BaseHeaderSize + 4).
+ self longAt: obj + BaseHeaderSize + 4 put: temp]]!
Item was removed:
- ----- Method: StackInterpreter>>convertFloatsToPlatformOrderFrom:to: (in category 'image save/restore') -----
- convertFloatsToPlatformOrderFrom: startOop to: stopAddr
- "Byte-swap the words of all bytes objects in a range of the
- image, including Strings, ByteArrays, and CompiledMethods.
- This returns these objects to their original byte ordering
- after blindly byte-swapping the entire image. For compiled
- methods, byte-swap only their bytecodes part.
- Ensure floats are in platform-order."
- objectMemory vmEndianness = imageFloatsBigEndian ifTrue:
- [^nil].
- self assert: ClassFloatCompactIndex ~= 0.
- objectMemory allObjectsDo:
- [:obj| | temp |
- (objectMemory compactClassIndexOf: obj) = ClassFloatCompactIndex ifTrue:
- [temp := self longAt: obj + BaseHeaderSize.
- self longAt: obj + BaseHeaderSize put: (self longAt: obj + BaseHeaderSize + 4).
- self longAt: obj + BaseHeaderSize + 4 put: temp]]!
Item was changed:
----- Method: StackInterpreter>>ensureImageFormatIsUpToDate: (in category 'image save/restore') -----
ensureImageFormatIsUpToDate: swapBytes
"Ensure the image data has been updayed to suit the current VM."
<inline: false>
swapBytes
ifTrue: [self reverseBytesInImage]
+ ifFalse: [self convertFloatsToPlatformOrder]!
- ifFalse: [self convertFloatsToPlatformOrderFrom: objectMemory firstObject to: objectMemory freeStart]!
More information about the Vm-dev
mailing list