[Vm-dev] VM Maker: VMMaker.oscog-eem.439.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Oct 8 16:06:28 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.439.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.439
Author: eem
Time: 8 October 2013, 9:03:05.59 am
UUID: 23869400-1665-400b-bb7c-27c07aa2fa21
Ancestors: VMMaker.oscog-eem.438
Work in progress towards Spur snapshot & load.
Add rawNumSlotsOf: to answer slots in first word. Use
in relevant places, in particular hasOverflowHeader: used
in compaction sketches.
Add a couple of compaction sketches (cuz they're far from
finished), bestFitCompact & exactFitCompact. Uses inst
var sortedFreeChunks & sortFreeSpace.
Add isPinned:/setIsPinnedOf:to: for segment bridges.
Refactor oldSpace enumeration into allOldSpaceObjectsFrom:do:.
Add allocateOldSpaceChunkOfExactlyBytes: &
consequently fix bugs in allocateOldSpaceChunkOfBytes:.
Update checkFreeSpace to check validity of freeListsMask.
Rename become arg checkers to containsOnlyValidBecomeObjects:[and:]
and have them check for pinned objects.
Add PrimErrObjectIsPinned.
Update comment in headerForSlots:format:classIndex:.
In particular descripe ref counting remembered table
pruning.
Add SpurSegmentManager, in particular its class comment,
and add SpurSegmentInfo.
=============== Diff against VMMaker.oscog-eem.438 ===============
Item was changed:
----- Method: CogObjectRepresentationFor32BitSpur>>getInlineCacheClassTagFrom:into: (in category 'compile abstract instructions') -----
getInlineCacheClassTagFrom: sourceReg into: destReg
"Extract the inline cache tag for the object in sourceReg into destReg. The inline
+ cache tag for a given object is the value loaded in inline caches to distinguish
+ objects of different classes. In Spur this is either the tags for immediates, (with
+ 1 & 3 collapsed to 1 for SmallIntegers, and 2 collapsed to 0 for Characters), or
+ the receiver's classIndex. Generate something like this:
- cache tag for a given object is the value loaded in inline caches to distinguish objects
- of different classes. In Spur this is either the tags for immediates, (with 1 & 3 collapsed
- to 1 for SmallIntegers), or the receiver's classIndex. Generate something like this:
Limm:
andl $0x1, rDest
j Lcmp
Lentry:
movl rSource, rDest
andl $0x3, rDest
jnz Limm
+ movl 0(%edx), rDest
- movl 0x4(%edx), rDest
andl $0x3fffff, rDest
Lcmp
"
| immLabel entryLabel jumpCompare |
<var: #immLabel type: #'AbstractInstruction *'>
<var: #entryLabel type: #'AbstractInstruction *'>
<var: #jumpCompare type: #'AbstractInstruction *'>
cogit AlignmentNops: BytesPerWord.
immLabel := cogit Label.
cogit AndCq: 1 R: destReg.
jumpCompare := cogit Jump: 0.
cogit AlignmentNops: BytesPerWord.
entryLabel := cogit Label.
cogit MoveR: sourceReg R: destReg.
cogit AndCq: objectMemory tagMask R: destReg.
cogit JumpNonZero: immLabel.
self flag: #endianness.
"Get least significant half of header word in destReg"
cogit MoveMw: 0 r: sourceReg R: destReg.
cogit AndCq: objectMemory classIndexMask R: destReg.
jumpCompare jmpTarget: cogit Label.
^entryLabel!
Item was changed:
----- Method: Spur32BitMemoryManager>>bytesInObject: (in category 'object enumeration') -----
bytesInObject: objOop
"Answer the total number of bytes in an object including header and possible overflow size header."
<returnTypeC: #usqLong>
+ | headerNumSlots numSlots |
+ headerNumSlots := self rawNumSlotsOf: objOop..
- | halfHeader headerNumSlots numSlots |
- self flag: #endianness.
- halfHeader := self longAt: objOop + 4.
- headerNumSlots := halfHeader >> self numSlotsHalfShift bitAnd: self numSlotsMask.
numSlots := headerNumSlots = self numSlotsMask
ifTrue: [self longAt: objOop - self baseHeaderSize]
ifFalse: [headerNumSlots = 0 ifTrue: [1] ifFalse: [headerNumSlots]].
^numSlots + (numSlots bitAnd: 1) << self shiftForWord
+ (headerNumSlots = self numSlotsMask
ifTrue: [self baseHeaderSize + self baseHeaderSize]
ifFalse: [self baseHeaderSize])!
Item was added:
+ ----- Method: Spur32BitMemoryManager>>numSlotsOf: (in category 'object access') -----
+ numSlotsOf: objOop
+ <returnTypeC: #usqInt>
+ | numSlots |
+ self flag: #endianness.
+ "numSlotsOf: should not be applied to free or forwarded objects."
+ self assert: (self classIndexOf: objOop) > self isForwardedObjectClassIndexPun.
+ numSlots := self rawNumSlotsOf: objOop..
+ ^numSlots = self numSlotsMask "overflow slots; (2^32)-1 slots are plenty"
+ ifTrue: [self longAt: objOop - self baseHeaderSize]
+ ifFalse: [numSlots]!
Item was added:
+ ----- Method: Spur32BitMemoryManager>>rawNumSlotsOf: (in category 'object access') -----
+ rawNumSlotsOf: objOop
+ <returnTypeC: #usqInt>
+ <inline: true>
+ self flag: #endianness.
+ ^(self longAt: objOop + 4) >> self numSlotsHalfShift bitAnd: self numSlotsMask!
Item was added:
+ ----- Method: Spur32BitMemoryManager>>setIsPinnedOf:to: (in category 'header access') -----
+ setIsPinnedOf: objOop to: aBoolean
+ self flag: #endianness.
+ self longAt: objOop
+ put: (aBoolean
+ ifTrue: [(self longAt: objOop) bitOr: 1 << self pinnedBitShift]
+ ifFalse: [(self longAt: objOop) bitAnd: (1 << self pinnedBitShift) bitInvert32])!
Item was changed:
----- Method: Spur64BitMemoryManager>>bytesInObject: (in category 'object enumeration') -----
bytesInObject: objOop
"Answer the total number of bytes in an object including header and possible overflow size header."
| header headerNumSlots numSlots |
+ <var: 'header' type: #usqLong>
self flag: #endianness.
header := self longAt: objOop.
+ headerNumSlots := header >> self numSlotsFullShift.
- headerNumSlots := header >> self numSlotsFullShift bitAnd: self numSlotsMask.
numSlots := headerNumSlots = self numSlotsMask
ifTrue: [header bitAnd: 16rFFFFFFFFFFFFFF]
ifFalse: [headerNumSlots = 0 ifTrue: [1] ifFalse: [headerNumSlots]].
^numSlots << self shiftForWord
+ (headerNumSlots = self numSlotsMask
ifTrue: [self baseHeaderSize + self baseHeaderSize]
ifFalse: [self baseHeaderSize])!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>numSlotsOf: (in category 'object access') -----
+ numSlotsOf: objOop
+ <returnTypeC: #usqLong>
+ | numSlots |
+ self flag: #endianness.
+ "numSlotsOf: should not be applied to free or forwarded objects."
+ self assert: (self classIndexOf: objOop) > self isForwardedObjectClassIndexPun.
+ numSlots := self rawNumSlotsOf: objOop..
+ ^numSlots = self numSlotsMask "overflow slots; (2^56)-1 slots are plenty"
+ ifTrue: [((self longAt: objOop - self baseHeaderSize) << 8) asUnsignedLong >> 8]
+ ifFalse: [numSlots]!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>rawNumSlotsOf: (in category 'object access') -----
+ rawNumSlotsOf: objOop
+ <returnTypeC: #usqLong>
+ ^(self longAt: objOop) asUnsignedLong >> self numSlotsFullShift!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>setIsPinnedOf:to: (in category 'header access') -----
+ setIsPinnedOf: objOop to: aBoolean
+ self longAt: objOop
+ put: (aBoolean
+ ifTrue: [(self longAt: objOop) bitOr: 1 << self pinnedBitShift]
+ ifFalse: [(self longAt: objOop) bitAnd: (1 << self pinnedBitShift) bitInvert64])!
Item was changed:
CogClass subclass: #SpurMemoryManager
(excessive size, no diff calculated)
Item was added:
+ ----- Method: SpurMemoryManager>>allFreeObjects (in category 'free space') -----
+ allFreeObjects
+ <doNotGenerate>
+ | freeObjects |
+ freeObjects := OrderedCollection new.
+ self allFreeObjectsDo:
+ [:f| freeObjects addLast: f].
+ ^freeObjects!
Item was changed:
----- Method: SpurMemoryManager>>allOldSpaceObjectsDo: (in category 'object enumeration') -----
allOldSpaceObjectsDo: aBlock
<inline: true>
+ self allOldSpaceObjectsFrom: self firstObject do: aBlock!
- | prevObj prevPrevObj objOop |
- prevPrevObj := prevObj := nil.
- objOop := self firstObject.
- [self assert: objOop \\ self allocationUnit = 0.
- objOop < freeOldSpaceStart] whileTrue:
- [(self isFreeObject: objOop) ifFalse:
- [aBlock value: objOop].
- prevPrevObj := prevObj.
- prevObj := objOop.
- objOop := self objectAfter: objOop limit: freeOldSpaceStart].
- prevPrevObj class.
- prevObj class!
Item was added:
+ ----- Method: SpurMemoryManager>>allOldSpaceObjectsFrom:do: (in category 'object enumeration') -----
+ allOldSpaceObjectsFrom: initialObject do: aBlock
+ <inline: true>
+ | prevObj prevPrevObj objOop |
+ prevPrevObj := prevObj := nil.
+ objOop := initialObject.
+ [self assert: objOop \\ self allocationUnit = 0.
+ objOop < freeOldSpaceStart] whileTrue:
+ [(self isFreeObject: objOop) ifFalse:
+ [aBlock value: objOop].
+ prevPrevObj := prevObj.
+ prevObj := objOop.
+ objOop := self objectAfter: objOop limit: freeOldSpaceStart].
+ prevPrevObj class.
+ prevObj class!
Item was changed:
----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfBytes: (in category 'free space') -----
allocateOldSpaceChunkOfBytes: chunkBytes
"Answer a chunk of oldSpace from the free lists, if available,
+ otherwise answer nil. Break up a larger chunk if one of the
+ exact size does not exist. N.B. the chunk is simply a pointer, it
+ has no valid header. The caller *must* fill in the header correctly."
- 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 chunk index nodeBytes parent child smaller larger |
"for debugging:" "totalFreeOldSpace := self totalFreeListBytes"
totalFreeOldSpace := totalFreeOldSpace - chunkBytes. "be optimistic (& don't wait for the write)"
initialIndex := chunkBytes / self allocationUnit.
(initialIndex < NumFreeLists and: [1 << initialIndex <= freeListsMask]) ifTrue:
+ [(freeListsMask anyMask: 1 << initialIndex) ifTrue:
+ [(chunk := freeLists at: initialIndex) ~= 0 ifTrue:
+ [self assert: chunk = (self startOfObject: chunk).
+ self assert: (self isValidFreeObject: chunk).
+ ^self unlinkFreeChunk: chunk atIndex: initialIndex].
+ freeListsMask := freeListsMask - (1 << initialIndex)].
- [(chunk := freeLists at: initialIndex) ~= 0 ifTrue:
- [self assert: chunk = (self startOfObject: chunk).
- self assert: (self isValidFreeObject: chunk).
- ^self unlinkFreeChunk: chunk atIndex: initialIndex].
- freeListsMask := freeListsMask - (1 << initialIndex).
"first search for free chunks of a multiple of chunkBytes in size"
index := initialIndex.
[(index := index + index) < NumFreeLists
and: [1 << index <= freeListsMask]] whileTrue:
[((freeListsMask anyMask: 1 << index)
and: [(chunk := freeLists at: index) ~= 0]) ifTrue:
[self assert: chunk = (self startOfObject: chunk).
self assert: (self isValidFreeObject: chunk).
self unlinkFreeChunk: chunk atIndex: index.
self assert: (self bytesInObject: chunk) = (index * self allocationUnit).
self freeChunkWithBytes: index * self allocationUnit - chunkBytes
at: (self startOfObject: chunk) + chunkBytes.
^chunk]].
"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) < NumFreeLists
and: [1 << index <= freeListsMask]] whileTrue:
[(freeListsMask anyMask: 1 << index) ifTrue:
[(chunk := freeLists at: index) ~= 0 ifTrue:
[self assert: chunk = (self startOfObject: chunk).
self assert: (self isValidFreeObject: chunk).
self unlinkFreeChunk: chunk atIndex: index.
self assert: (self bytesInObject: chunk) = (index * self allocationUnit).
self freeChunkWithBytes: index * self allocationUnit - chunkBytes
at: (self startOfObject: chunk) + chunkBytes.
^chunk].
freeListsMask := freeListsMask - (1 << index)]]].
"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."
parent := 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."
+ [chunk := self fetchPointer: self freeChunkNextIndex
+ ofFreeChunk: child.
+ chunk ~= 0 ifTrue:
+ [self assert: (self isValidFreeObject: chunk).
+ self storePointer: self freeChunkNextIndex
+ ofFreeChunk: child
+ withValue: (self fetchPointer: self freeChunkNextIndex
+ ofFreeChunk: chunk).
+ ^self startOfObject: chunk].
+ child := 0] "break out of loop to remove interior node"
- childBytes = chunkBytes ifTrue: "size match; try to remove from list at node."
- [chunk := self fetchPointer: self freeChunkNextIndex
- ofFreeChunk: child.
- chunk ~= 0 ifTrue:
- [self assert: (self isValidFreeObject: chunk).
- self storePointer: self freeChunkNextIndex
- ofFreeChunk: child
- withValue: (self fetchPointer: self freeChunkNextIndex
- ofFreeChunk: chunk).
- ^self startOfObject: chunk].
- child := 0]. "break out of loop to remove interior node"
- "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: "walk down the tree"
- [child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child]
ifFalse:
+ ["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:
+ [parent := child. "parent will be smallest node >= chunkBytes + allocationUnit"
+ nodeBytes := childBytes.
+ child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]]].
- [parent := child.
- nodeBytes := childBytes.
- child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]].
parent = 0 ifTrue:
[totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded"
self halt.
^nil].
"self printFreeChunk: parent"
self assert: (nodeBytes = chunkBytes or: [nodeBytes >= (chunkBytes + (2 * self allocationUnit))]).
self assert: (self bytesInObject: parent) = nodeBytes.
"attempt to remove from list"
chunk := self fetchPointer: self freeChunkNextIndex
ofFreeChunk: parent.
chunk ~= 0 ifTrue:
[self assert: (chunkBytes = nodeBytes or: [chunkBytes + self allocationUnit < nodeBytes]).
self storePointer: self freeChunkNextIndex
ofFreeChunk: parent
withValue: (self fetchPointer: self freeChunkNextIndex
ofFreeChunk: chunk).
chunkBytes ~= nodeBytes ifTrue:
[self freeChunkWithBytes: nodeBytes - chunkBytes
at: (self startOfObject: chunk) + chunkBytes].
^self startOfObject: chunk].
"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 |"
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: (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]
- withValue: larger]
ifFalse:
[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.
- ofFreeChunk: parent
- withValue: smaller.
larger ~= 0 ifTrue:
[self addFreeSubTree: larger]]].
"if there's space left over, add the fragment back."
chunkBytes ~= nodeBytes ifTrue:
[self freeChunkWithBytes: nodeBytes - chunkBytes
at: (self startOfObject: chunk) + chunkBytes].
^self startOfObject: chunk!
Item was added:
+ ----- 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 chunk nodeBytes parent child smaller larger |
+ "for debugging:" "totalFreeOldSpace := self totalFreeListBytes"
+
+ initialIndex := chunkBytes / self allocationUnit.
+ initialIndex < NumFreeLists ifTrue:
+ [(1 << initialIndex <= freeListsMask
+ and: [(chunk := freeLists at: initialIndex) ~= 0]) ifTrue:
+ [self assert: chunk = (self startOfObject: chunk).
+ self assert: (self isValidFreeObject: chunk).
+ totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
+ ^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."
+ 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."
+ [chunk := self fetchPointer: self freeChunkNextIndex
+ ofFreeChunk: child.
+ chunk ~= 0 ifTrue:
+ [self assert: (self isValidFreeObject: chunk).
+ self storePointer: self freeChunkNextIndex
+ ofFreeChunk: child
+ withValue: (self fetchPointer: self freeChunkNextIndex
+ ofFreeChunk: chunk).
+ totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
+ ^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:
+ [parent := child.
+ nodeBytes := childBytes.
+ child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]]].
+ "if no chunk, there was no exact fit"
+ chunk = 0 ifTrue:
+ [^nil].
+
+ "self printFreeChunk: parent"
+ self assert: nodeBytes = 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: 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 |"
+
+ 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: (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: (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: chunk!
Item was changed:
----- Method: SpurMemoryManager>>become:with:twoWay:copyHash: (in category 'become api') -----
become: array1 with: array2 twoWay: twoWayFlag copyHash: copyHashFlag
"All references to each object in array1 are swapped with all references to the
corresponding object in array2. That is, all pointers to one object are replaced
with with pointers to the other. The arguments must be arrays of the same length.
Answers PrimNoErr if the primitive succeeds, otherwise a relevant error code."
"Implementation: Uses lazy forwarding to defer updating references until message send."
+ | ec |
-
self assert: becomeEffectsFlags = 0.
self leakCheckBecome ifTrue:
[self runLeakCheckerForFullGC: true].
(self isArray: array1) ifFalse:
[^PrimErrBadReceiver].
((self isArray: array2)
and: [(self numSlotsOf: array1) = (self numSlotsOf: array2)]) ifFalse:
[^PrimErrBadArgument].
(twoWayFlag or: [copyHashFlag])
+ ifTrue:
+ [ec := self containsOnlyValidBecomeObjects: array1 and: array2]
- ifTrue: [(self containOnlyOops: array1 and: array2) ifFalse: [^PrimErrInappropriate]]
ifFalse:
+ [self followForwardedObjectFields: array2 toDepth: 0.
+ ec := self containsOnlyValidBecomeObjects: array1].
+ ec ~= 0 ifTrue: [^ec].
- [(self containOnlyOops: array1) ifFalse: [^PrimErrInappropriate].
- self followForwardedObjectFields: array2 toDepth: 0].
coInterpreter preBecomeAction.
twoWayFlag
ifTrue:
[self innerBecomeObjectsIn: array1 with: array2 copyHash: copyHashFlag]
ifFalse:
[self innerBecomeObjectsIn: array1 to: array2 copyHash: copyHashFlag].
self postBecomeScanClassTable.
coInterpreter postBecomeAction: becomeEffectsFlags.
becomeEffectsFlags := 0.
self leakCheckBecome ifTrue:
[self runLeakCheckerForFullGC: true].
^PrimNoErr "success"!
Item was added:
+ ----- Method: SpurMemoryManager>>bestFitCompact (in category 'compaction') -----
+ bestFitCompact
+ "Compact all of memory using best-fit.
+ Sort free space, find the first free chunk. Scan objects following
+ the first free chunk and for each, look for a free chunk of the exact
+ size, copy the object's contents into the free chunk, and forward
+ the object to its new, lower location. If any didn't fit exactly do a
+ second pass using best fit."
+
+ | firstFailedFit |
+ firstFailedFit := self exactFitCompact.
+ firstFailedFit = 0 ifTrue:
+ [^self]. "either no free space, no high objects, or no misfits."
+ self allOldSpaceObjectsFrom: firstFailedFit
+ do: [:o| | b |
+ ((self isForwarded: o)
+ or: [self isPinned: o]) ifFalse:
+ [b := self bytesInObject: o.
+ (self allocateOldSpaceChunkOfBytes: b) ifNotNil:
+ [:f|
+ self mem: f
+ cp: o
+ y: ((self hasOverflowHeader: o)
+ ifTrue: [b - self baseHeaderSize]
+ ifFalse: [b]).
+ (self isRemembered: o) ifTrue:
+ [scavenger remember: f].
+ self forward: o to: f].
+ self checkFreeSpace]].
+ self checkFreeSpace!
Item was added:
+ ----- Method: SpurMemoryManager>>bitsSetInFreeSpaceMaskForAllFreeLists (in category 'debug support') -----
+ bitsSetInFreeSpaceMaskForAllFreeLists
+ 0 to: NumFreeLists - 1 do:
+ [:i|
+ ((freeLists at: i) ~= 0
+ and: [1 << i noMask: freeListsMask]) ifTrue:
+ [^false]].
+ ^true!
Item was changed:
----- Method: SpurMemoryManager>>checkFreeSpace (in category 'debug support') -----
checkFreeSpace
+ self assert: self bitsSetInFreeSpaceMaskForAllFreeLists.
self assert: totalFreeOldSpace = self totalFreeListBytes!
Item was removed:
- ----- Method: SpurMemoryManager>>containOnlyOops: (in category 'become implementation') -----
- containOnlyOops: array
- "Answer if the array contains only non-immediates. You can't become: immediates!!"
- | fieldOffset effectsFlags oop |
- fieldOffset := self lastPointerOf: array.
- effectsFlags := 0.
- "same size as array2"
- [fieldOffset >= self baseHeaderSize] whileTrue:
- [oop := self longAt: array + fieldOffset.
- (self isImmediate: oop) ifTrue: [^false].
- (self isForwarded: oop) ifTrue:
- [oop := self followForwarded: oop.
- self longAt: array + fieldOffset put: oop].
- effectsFlags := effectsFlags bitOr: (self becomeEffectFlagsFor: oop).
- fieldOffset := fieldOffset - BytesPerOop].
- "only set flags after checking all args."
- becomeEffectsFlags := effectsFlags.
- ^true!
Item was removed:
- ----- Method: SpurMemoryManager>>containOnlyOops:and: (in category 'become implementation') -----
- containOnlyOops: array1 and: array2
- "Answer if neither array contains only non-immediates. You can't become: immediates!!"
- | fieldOffset effectsFlags oop |
- fieldOffset := self lastPointerOf: array1.
- effectsFlags := 0.
- "same size as array2"
- [fieldOffset >= self baseHeaderSize] whileTrue:
- [oop := self longAt: array1 + fieldOffset.
- (self isImmediate: oop) ifTrue: [^false].
- (self isForwarded: oop) ifTrue:
- [oop := self followForwarded: oop.
- self longAt: array1 + fieldOffset put: oop].
- effectsFlags := effectsFlags bitOr: (self becomeEffectFlagsFor: oop).
- oop := self longAt: array2 + fieldOffset.
- (self isImmediate: oop) ifTrue: [^false].
- (self isForwarded: oop) ifTrue:
- [oop := self followForwarded: oop.
- self longAt: array2 + fieldOffset put: oop].
- effectsFlags := effectsFlags bitOr: (self becomeEffectFlagsFor: oop).
- fieldOffset := fieldOffset - BytesPerOop].
- "only set flags after checking all args."
- becomeEffectsFlags := effectsFlags.
- ^true!
Item was added:
+ ----- Method: SpurMemoryManager>>containsOnlyValidBecomeObjects: (in category 'become implementation') -----
+ containsOnlyValidBecomeObjects: array
+ "Answer 0 if the array contains only unpinned non-immediates.
+ Otherwise answer an informative error code.
+ Can't become: immediates!! Shouldn't become pinned objects."
+ | fieldOffset effectsFlags oop |
+ fieldOffset := self lastPointerOf: array.
+ effectsFlags := 0.
+ "same size as array2"
+ [fieldOffset >= self baseHeaderSize] whileTrue:
+ [oop := self longAt: array + fieldOffset.
+ (self isImmediate: oop) ifTrue: [^PrimErrInappropriate].
+ (self isForwarded: oop) ifTrue:
+ [oop := self followForwarded: oop.
+ self longAt: array + fieldOffset put: oop].
+ (self isPinned: oop) ifTrue: [^PrimErrObjectIsPinned].
+ effectsFlags := effectsFlags bitOr: (self becomeEffectFlagsFor: oop).
+ fieldOffset := fieldOffset - BytesPerOop].
+ "only set flags after checking all args."
+ becomeEffectsFlags := effectsFlags.
+ ^0!
Item was added:
+ ----- Method: SpurMemoryManager>>containsOnlyValidBecomeObjects:and: (in category 'become implementation') -----
+ containsOnlyValidBecomeObjects: array1 and: array2
+ "Answer 0 if neither array contains only unpinned non-immediates.
+ Otherwise answer an informative error code.
+ Can't become: immediates!! Shouldn't become pinned objects."
+ | fieldOffset effectsFlags oop |
+ fieldOffset := self lastPointerOf: array1.
+ effectsFlags := 0.
+ "same size as array2"
+ [fieldOffset >= self baseHeaderSize] whileTrue:
+ [oop := self longAt: array1 + fieldOffset.
+ (self isImmediate: oop) ifTrue: [^PrimErrInappropriate].
+ (self isForwarded: oop) ifTrue:
+ [oop := self followForwarded: oop.
+ self longAt: array1 + fieldOffset put: oop].
+ (self isPinned: oop) ifTrue: [^PrimErrObjectIsPinned].
+ effectsFlags := effectsFlags bitOr: (self becomeEffectFlagsFor: oop).
+ oop := self longAt: array2 + fieldOffset.
+ (self isImmediate: oop) ifTrue: [^PrimErrInappropriate].
+ (self isForwarded: oop) ifTrue:
+ [oop := self followForwarded: oop.
+ self longAt: array2 + fieldOffset put: oop].
+ (self isPinned: oop) ifTrue: [^PrimErrObjectIsPinned].
+ effectsFlags := effectsFlags bitOr: (self becomeEffectFlagsFor: oop).
+ fieldOffset := fieldOffset - BytesPerOop].
+ "only set flags after checking all args."
+ becomeEffectsFlags := effectsFlags.
+ ^0!
Item was added:
+ ----- Method: SpurMemoryManager>>exactFitCompact (in category 'compaction') -----
+ exactFitCompact
+ "Compact all of memory using exact-fit.
+ Sort free space, find the first free chunk. Scan objects following
+ the first free chunk and for each, look for a free chunk of the right
+ size, copy the object's contents into the free chunk, and forward
+ the object to its new, lower location. Answer the first object that
+ failed to fit (for bestFitCompacts convenience), if there's free space."
+
+ | firstFailedFit |
+ self sortFreeSpace.
+ firstFailedFit := 0.
+ totalFreeOldSpace = 0 ifTrue: [^0].
+ self allOldSpaceObjectsFrom: self lowestFreeChunkAssumingSortedFreeSpace
+ do: [:o| | b |
+ ((self isForwarded: o)
+ or: [self isPinned: o]) ifFalse:
+ [b := self bytesInObject: o.
+ (self allocateOldSpaceChunkOfExactlyBytes: b)
+ ifNil: [firstFailedFit = 0 ifTrue: [firstFailedFit := o]]
+ ifNotNil:
+ [:f|
+ self mem: f
+ cp: o
+ y: ((self hasOverflowHeader: o)
+ ifTrue: [b - self baseHeaderSize]
+ ifFalse: [b]).
+ (self isRemembered: o) ifTrue:
+ [scavenger remember: f].
+ self forward: o to: f]]].
+ self checkFreeSpace.
+ ^firstFailedFit!
Item was added:
+ ----- Method: SpurMemoryManager>>hasOverflowHeader: (in category 'header access') -----
+ hasOverflowHeader: objOop
+ ^(self rawNumSlotsOf: objOop) = self numSlotsMask!
Item was changed:
----- Method: SpurMemoryManager>>headerForSlots:format:classIndex: (in category 'header format') -----
+ headerForSlots: numSlots format: formatField classIndex: classIndex
- headerForSlots: numSlots format: formatField classIndex: classIndex
"The header format in LSB is
MSB: | 8: numSlots | (on a byte boundary)
| 2 bits |
| 22: identityHash | (on a word boundary)
+ | 3 bits | (msb <-> lsb = ?,isPinned,isRemembered
- | 3 bits | (msb <-> lsb = ?,?,isRemembered
| 5: format | (on a byte boundary)
| 2 bits |
| 22: classIndex | (on a word boundary) : LSB
The remaining bits (7) need to be used for
isGrey
isMarked
+ isRemembered (bit 29)
+ isPinned (bit 30)
- isRemembered (bit 29)
- isPinned
isImmutable
+ leaving 2 unused bits. The three bit field containing isPinned, isRemembered
+ is for bits that are never set in young objects. This allows the remembered
+ table to be pruned when full by using these bits as a reference count of
+ newSpace objects from the remembered table. Objects with a high count
+ should be tenured to prune the remembered table."
- leaving 2 unused bits."
<returnTypeC: #usqLong>
^ (numSlots << self numSlotsFullShift)
+ (formatField << self formatShift)
+ classIndex!
Item was added:
+ ----- Method: SpurMemoryManager>>isPinned: (in category 'header access') -----
+ isPinned: objOop
+ ^((self longAt: objOop) >> self pinnedBitShift bitAnd: 1) ~= 0!
Item was added:
+ ----- Method: SpurMemoryManager>>lowestFreeChunkAssumingSortedFreeSpace (in category 'free space') -----
+ lowestFreeChunkAssumingSortedFreeSpace
+ | lowest |
+ lowest := sortedFreeChunks = 0
+ ifTrue: [endOfMemory]
+ ifFalse: [sortedFreeChunks].
+ 1 to: NumFreeLists - 1 do:
+ [:i| | chunk |
+ chunk := freeLists at: i.
+ (chunk ~= 0 and: [chunk < lowest]) ifTrue:
+ [lowest := chunk]].
+ ^lowest!
Item was changed:
----- Method: SpurMemoryManager>>numSlotsOf: (in category 'object access') -----
numSlotsOf: objOop
<returnTypeC: #usqInt>
+ ^self subclassResponsibility!
- | halfHeader numSlots |
- self flag: #endianness.
- "numSlotsOf: should not be applied to free or forwarded objects."
- self assert: (self classIndexOf: objOop) > self isForwardedObjectClassIndexPun.
- halfHeader := self longAt: objOop + 4.
- numSlots := halfHeader >> self numSlotsHalfShift bitAnd: self numSlotsMask.
- ^numSlots = self numSlotsMask
- ifTrue: [self longAt: objOop - self baseHeaderSize] "overflow slots; (2^32)-1 slots are plenty"
- ifFalse: [numSlots]!
Item was changed:
----- Method: SpurMemoryManager>>numSlotsOfAny: (in category 'object access') -----
numSlotsOfAny: objOop
"A private internal version of numSlotsOf: that is happy to be applied to free or forwarded objects."
<returnTypeC: #usqInt>
+ | numSlots |
+ numSlots := self rawNumSlotsOf: objOop..
- | halfHeader numSlots |
- self flag: #endianness.
- halfHeader := self longAt: objOop + 4.
- numSlots := halfHeader >> self numSlotsHalfShift bitAnd: self numSlotsMask.
^numSlots = self numSlotsMask
ifTrue: [self longAt: objOop - self baseHeaderSize] "overflow slots; (2^32)-1 slots are plenty"
ifFalse: [numSlots]!
Item was changed:
----- Method: SpurMemoryManager>>objectStartingAt: (in category 'object enumeration') -----
objectStartingAt: address
"For enumerating objects find the header of the first object in a space.
If the object starts with an overflow size field it will start at the next allocationUnit.
c.f. numSlotsOf:"
+ | numSlots |
+ numSlots := self rawNumSlotsOf: address.
- | halfHeader numSlots |
- self flag: #endianness.
- halfHeader := self longAt: address + 4.
- numSlots := halfHeader >> self numSlotsHalfShift bitAnd: self numSlotsMask.
^numSlots = self numSlotsMask
ifTrue: [address + self baseHeaderSize]
ifFalse: [address]!
Item was added:
+ ----- Method: SpurMemoryManager>>pinnedBitShift (in category 'header format') -----
+ pinnedBitShift
+ "bit 1 of 3-bit field above format (little endian)"
+ ^30!
Item was added:
+ ----- Method: SpurMemoryManager>>rawNumSlotsOf: (in category 'object access') -----
+ rawNumSlotsOf: objOop
+ <returnTypeC: #usqInt>
+ ^self subclassResponsibility!
Item was changed:
----- Method: SpurMemoryManager>>rememberedBitShift (in category 'header format') -----
rememberedBitShift
+ "bit 0 of 3-bit field above format (little endian)"
- "lsb of 3-bit field above format (little endian)"
^29!
Item was added:
+ ----- Method: SpurMemoryManager>>setIsPinnedOf:to: (in category 'header access') -----
+ setIsPinnedOf: objOop to: aBoolean
+ self subclassResponsibility!
Item was added:
+ ----- Method: SpurMemoryManager>>sortFreeListAt: (in category 'free space') -----
+ sortFreeListAt: i
+ "Sort the individual free list i so that the lowest address is at the head of the list.
+ Use an insertion sort with a scan for initially sorted elements."
+
+ | list next head |
+ list := freeLists at: i. "list of objects to be inserted"
+ list = 0 ifTrue: "empty list; we're done"
+ [^self].
+ head := list.
+ "scan list to find find first out-of-order element"
+ [(next := self fetchPointer: self freeChunkNextIndex ofObject: list) > list]
+ whileTrue:
+ [list := next].
+ "no out-of-order elements; list was already sorted; we're done"
+ next = 0 ifTrue:
+ [^self].
+ "detatch already sorted list"
+ self storePointer: self freeChunkNextIndex ofObject: list withValue: 0.
+ list := next.
+ [list ~= 0] whileTrue:
+ [| node prev |
+ "grab next node to be inserted"
+ next := self fetchPointer: self freeChunkNextIndex ofObject: list.
+ "search sorted list for insertion point"
+ prev := 0. "prev node for insertion sort"
+ node := head. "current node for insertion sort"
+ [node ~= 0
+ and: [node < list]] whileTrue:
+ [prev := node.
+ node := self fetchPointer: self freeChunkNextIndex ofObject: node].
+ "insert the node into the sorted list"
+ self assert: (node = 0 or: [node > list]).
+ prev = 0
+ ifTrue:
+ [head := list]
+ ifFalse:
+ [self storePointer: self freeChunkNextIndex
+ ofFreeChunk: prev
+ withValue: list].
+ self storePointer: self freeChunkNextIndex
+ ofFreeChunk: list
+ withValue: node.
+ list := next].
+ "replace the list with the sorted list"
+ freeLists at: i put: head!
Item was added:
+ ----- Method: SpurMemoryManager>>sortFreeSpace (in category 'free space') -----
+ sortFreeSpace
+ "Sort free space for best-fit compaction. Sort the individual free lists so that
+ the lowest address is at the head of each list. Sort the large chunks through the
+ freeChunkNextAddressIndex from low to high, with the head in sortedFreeChunks."
+
+ self checkFreeSpace.
+ 1 to: NumFreeLists - 1 do:
+ [:i| self sortFreeListAt: i].
+ sortedFreeChunks := 0.
+ self allObjectsInFreeTree: (freeLists at: 0) do:
+ [:f| | node prev |
+ node := sortedFreeChunks.
+ prev := 0.
+ [node ~= 0
+ and: [node < f]] whileTrue:
+ [prev := node.
+ node := self fetchPointer: self freeChunkNextAddressIndex ofObject: node].
+ "insert the node into the sorted list"
+ self assert: (node = 0 or: [node > f]).
+ prev = 0
+ ifTrue:
+ [sortedFreeChunks := f]
+ ifFalse:
+ [self storePointer: self freeChunkNextAddressIndex
+ ofFreeChunk: prev
+ withValue: f].
+ self storePointer: self freeChunkNextAddressIndex
+ ofFreeChunk: f
+ withValue: node].
+ self assert: self sortedFreeChunksAreSorted.
+ self checkFreeSpace!
Item was added:
+ ----- Method: SpurMemoryManager>>sortedFreeChunksAreSorted (in category 'debug support') -----
+ sortedFreeChunksAreSorted
+ | chunk next |
+ chunk := sortedFreeChunks.
+ [chunk ~= 0] whileTrue:
+ [next := self fetchPointer: self freeChunkNextAddressIndex ofObject: chunk.
+ (next = 0 or: [next > chunk]) ifFalse:
+ [^false].
+ chunk := next].
+ ^true!
Item was added:
+ VMStructType subclass: #SpurSegmentInfo
+ instanceVariableNames: 'start segSize swizzle'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-SpurMemoryManager'!
Item was added:
+ ----- Method: SpurSegmentInfo class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
+ instVarNamesAndTypesForTranslationDo: aBinaryBlock
+ "Enumerate aBinaryBlock with the names and C type strings for the inst vars to include in the typedef for the reciever."
+ "self typedef"
+ self instVarNames do:
+ [:ivn|
+ aBinaryBlock
+ value: ivn
+ value: (ivn = 'swizzle'
+ ifTrue: [#sqInt]
+ ifFalse: [#usqInt])]!
Item was added:
+ ----- Method: SpurSegmentInfo>>segSize (in category 'accessing') -----
+ segSize
+ "Answer the value of segSize"
+
+ ^ segSize!
Item was added:
+ ----- Method: SpurSegmentInfo>>segSize: (in category 'accessing') -----
+ segSize: anObject
+ "Set the value of segSize"
+
+ ^segSize := anObject!
Item was added:
+ ----- Method: SpurSegmentInfo>>start (in category 'accessing') -----
+ start
+ "Answer the value of start"
+
+ ^ start!
Item was added:
+ ----- Method: SpurSegmentInfo>>start: (in category 'accessing') -----
+ start: anObject
+ "Set the value of start"
+
+ ^start := anObject!
Item was added:
+ ----- Method: SpurSegmentInfo>>swizzle (in category 'accessing') -----
+ swizzle
+ "Answer the value of swizzle"
+
+ ^ swizzle!
Item was added:
+ ----- Method: SpurSegmentInfo>>swizzle: (in category 'accessing') -----
+ swizzle: anObject
+ "Set the value of swizzle"
+
+ ^swizzle := anObject!
Item was added:
+ CogClass subclass: #SpurSegmentManager
+ instanceVariableNames: 'manager numSegments segments'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-SpurMemoryManager'!
+
+ !SpurSegmentManager commentStamp: 'eem 10/6/2013 10:32' prior: 0!
+ Instances of SpurSegmentManager manage oldSpace, which is organized as a sequence of segments. Segments can be obtained from the operating system and returned to the operating system when empty and shrinkage is required. Segments are kept invisible from the SpurMemoryManager by using "bridge" objects, "fake" pinned objects to bridge the gaps between segments. A pinned object header occupies the last 16 bytes of each segment, and the pinned object's size is the distance to the start of the next segment. So when the memory manager enumerates objects it skips over these bridges and memory appears linear. The constraint is that segments obtained from the operating system must be at a higher address than the first segment. The maximum size of large objects, being an overflow slot size, should be big enough to bridge the gaps, because in 32-bits the maximum size is 2^32 slots. In 64-bits the maximum size of large objects is 2^56 slots, or 2^59 bits, which we hope will suffice.
+
+ When an image is written to a snapshot file the second word of the header of the bridge at the end of each segment is replaced by the size of the following segment, the segments are written to the file, and the second word of each bridge is restored. Hence the length of each segment is derived from the bridge at the end of the preceeding segment. The length of the first segment is stored in the image header as firstSegmentBytes. The start of each segment is also derived from the bridge as a delta from the start of the previous segment. The start of The first segment is stored in the image header as startOfMemory.
+
+ On load all segments are read into one single segment, eliminating the bridge objects, and computing the swizzle distance for each segment, based on where the segments were in memory when the image file was written, and where the coallesced segment ends up on load. Then the segment is traversed, swizzling pointers by selecting the relevant swizzle for each oop's segment.
+
+ Instance Variables
+ numSegments: <Integer>
+ segments: <Array of SpurSegmentInfo>
+ manager: <SpurMemoryManager>
+
+ numSegments
+ - the number of segments
+
+ segments
+ - the start addresses, lengths and offsets to adjust oops on image load, for each segment
+
+ manager
+ - the SpurMemoryManager whose oldSpace is managed (simulation only).!
Item was changed:
SharedPool subclass: #VMBasicConstants
instanceVariableNames: ''
+ classVariableNames: 'BaseHeaderSize Byte0Mask Byte0Shift Byte1Mask Byte1Shift Byte1ShiftNegated Byte2Mask Byte2Shift Byte3Mask Byte3Shift Byte3ShiftNegated Byte4Mask Byte4Shift Byte4ShiftNegated Byte5Mask Byte5Shift Byte5ShiftNegated Byte6Mask Byte6Shift Byte7Mask Byte7Shift Byte7ShiftNegated Bytes3to0Mask Bytes7to4Mask BytesPerOop BytesPerWord COGMTVM COGVM DisownVMLockOutFullGC DoAssertionChecks DoExpensiveAssertionChecks GCModeBecome GCModeFull GCModeIncr IMMUTABILITY MULTIPLEBYTECODESETS NewspeakVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrGenericFailure PrimErrInappropriate PrimErrLimitExceeded PrimErrNamedInternal PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrObjectIsPinned PrimErrObjectMayMove PrimErrUnsupported PrimNoErr STACKVM ShiftForWord VMBIGENDIAN'
- classVariableNames: 'BaseHeaderSize Byte0Mask Byte0Shift Byte1Mask Byte1Shift Byte1ShiftNegated Byte2Mask Byte2Shift Byte3Mask Byte3Shift Byte3ShiftNegated Byte4Mask Byte4Shift Byte4ShiftNegated Byte5Mask Byte5Shift Byte5ShiftNegated Byte6Mask Byte6Shift Byte7Mask Byte7Shift Byte7ShiftNegated Bytes3to0Mask Bytes7to4Mask BytesPerOop BytesPerWord COGMTVM COGVM DisownVMLockOutFullGC DoAssertionChecks DoExpensiveAssertionChecks GCModeBecome GCModeFull GCModeIncr IMMUTABILITY MULTIPLEBYTECODESETS NewspeakVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrGenericFailure PrimErrInappropriate PrimErrLimitExceeded PrimErrNamedInternal PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrObjectMayMove PrimErrUnsupported PrimNoErr STACKVM ShiftForWord VMBIGENDIAN'
poolDictionaries: ''
category: 'VMMaker-Interpreter'!
!VMBasicConstants commentStamp: '<historical>' prior: 0!
I am a shared pool for basic constants upon which the VM as a whole depends.
self ensureClassPool.
self classPool declare: #BytesPerWord from: VMSqueakV3ObjectRepresentationConstants classPool.
self classPool declare: #BaseHeaderSize from: VMSqueakV3ObjectRepresentationConstants classPool
(ObjectMemory classPool keys select: [:k| k beginsWith: 'Byte']) do:
[:k| self classPool declare: k from: ObjectMemory classPool]!
Item was changed:
----- Method: VMClass class>>initializePrimitiveErrorCodes (in category 'initialization') -----
initializePrimitiveErrorCodes
"Define the VM's primitive error codes. N.B. these are
replicated in platforms/Cross/vm/sqVirtualMachine.h."
"VMClass initializePrimitiveErrorCodes"
| pet |
PrimErrTableIndex := 51. "Zero-relative"
"See SmalltalkImage>>recreateSpecialObjectsArray for the table definition.
If the table exists and is large enough the corresponding entry is returned as
the primitive error, otherwise the error is answered numerically."
pet := Smalltalk specialObjectsArray at: PrimErrTableIndex + 1 ifAbsent: [#()].
pet isArray ifFalse: [pet := #()].
PrimNoErr := 0. "for helper methods that need to answer success or an error code."
PrimErrGenericFailure := pet indexOf: nil ifAbsent: 1.
PrimErrBadReceiver := pet indexOf: #'bad receiver' ifAbsent: 2.
PrimErrBadArgument := pet indexOf: #'bad argument' ifAbsent: 3.
PrimErrBadIndex := pet indexOf: #'bad index' ifAbsent: 4.
PrimErrBadNumArgs := pet indexOf: #'bad number of arguments' ifAbsent: 5.
PrimErrInappropriate := pet indexOf: #'inappropriate operation' ifAbsent: 6.
PrimErrUnsupported := pet indexOf: #'unsupported operation' ifAbsent: 7.
PrimErrNoModification := pet indexOf: #'no modification' ifAbsent: 8.
PrimErrNoMemory := pet indexOf: #'insufficient object memory' ifAbsent: 9.
PrimErrNoCMemory := pet indexOf: #'insufficient C memory' ifAbsent: 10.
PrimErrNotFound := pet indexOf: #'not found' ifAbsent: 11.
PrimErrBadMethod := pet indexOf: #'bad method' ifAbsent: 12.
PrimErrNamedInternal := pet indexOf: #'internal error in named primitive machinery' ifAbsent: 13.
PrimErrObjectMayMove := pet indexOf: #'object may move' ifAbsent: 14.
+ PrimErrLimitExceeded := pet indexOf: #'resource limit exceeded' ifAbsent: 15.
+ PrimErrObjectIsPinned := pet indexOf: #'object is pinned' ifAbsent: 16!
- PrimErrLimitExceeded := pet indexOf: #'resource limit exceeded' ifAbsent: 15!
More information about the Vm-dev
mailing list