[Vm-dev] VM Maker: VMMaker.oscog-eem.395.mcz
commits at source.squeak.org
commits at source.squeak.org
Fri Sep 20 17:18:47 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.395.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.395
Author: eem
Time: 20 September 2013, 10:16:00.574 am
UUID: eb6732e4-5b88-48f9-b18c-1b613f234197
Ancestors: VMMaker.oscog-eem.394
Fix bug due to use of startOfFreeChunk: which assumed all free
chunks have a two=word header. Easier to keep them like normal
objects with an optional overflow size depending on slot size.
Consequently, make startOfObject: accept any kind of object.
More protocol. Bootstrap now continues until out-of-memory (cuz
boostrap doesn't allocate enough).
=============== Diff against VMMaker.oscog-eem.394 ===============
Item was added:
+ ----- Method: Spur32BitMMLESimulator>>is:KindOf: (in category 'simulation only') -----
+ is: oop KindOf: classNameString
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter is: oop KindOf: classNameString!
Item was changed:
----- Method: Spur32BitMMLESimulator>>longAt:put: (in category 'memory access') -----
longAt: byteAddress put: a32BitValue
"Note: Adjusted for Smalltalk's 1-based array indexing."
+ "(byteAddress = 16r120DBDC and: [a32BitValue = 16r16000000]) ifTrue:
+ [self halt]."
byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError].
^memory at: byteAddress // 4 + 1 put: a32BitValue!
Item was changed:
----- Method: Spur32BitMMLESimulator>>longLongAt:put: (in category 'memory access') -----
longLongAt: byteAddress put: a64BitValue
"memory is a Bitmap, a 32-bit indexable array of bits"
byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError].
+ ((byteAddress = 16r120DBDC or: [byteAddress = 16r120DBD8])
+ and: [a64BitValue >> 32 = 16r16000000
+ or: [(a64BitValue bitAnd: 16rffffffff) = 16r16000000]]) ifTrue:
+ [self halt].
memory
at: byteAddress // 4 + 1 put: (a64BitValue bitAnd: 16rffffffff);
at: byteAddress // 4 + 2 put: a64BitValue >> 32.
^a64BitValue!
Item was added:
+ ----- Method: Spur32BitMMLESimulator>>methodArgumentCount (in category 'simulation only') -----
+ methodArgumentCount
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter methodArgumentCount!
Item was added:
+ ----- Method: Spur32BitMMLESimulator>>pop: (in category 'simulation only') -----
+ pop: nItems
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter pop: nItems!
Item was changed:
----- Method: Spur32BitMemoryManager>>allocateSlotsInOldSpace:format:classIndex: (in category 'allocation') -----
allocateSlotsInOldSpace: numSlots format: formatField classIndex: classIndex
+ "Answer the oop of a chunk of space in oldSpace with numSlots slots. The header
+ will have been filled-in but not the contents."
+ | bytes chunk |
- | bytes freeChunk chunk |
bytes := self objectBytesForSlots: numSlots.
+ chunk := self allocateOldSpaceChunkOfBytes: bytes.
+ chunk ifNil:
- freeChunk := self allocateOldSpaceChunkOfBytes: bytes.
- freeChunk ifNil:
[^nil].
- chunk := self startOfFreeChunk: freeChunk.
numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
[self flag: #endianness.
self longAt: chunk put: numSlots.
self longAt: chunk + 4 put: self numSlotsMask << self numSlotsHalfShift.
self longLongAt: chunk + self baseHeaderSize
put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex).
^chunk + self baseHeaderSize].
self longLongAt: chunk put: (self headerForSlots: numSlots format: formatField classIndex: classIndex).
^chunk!
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. N.B. the chunk is simply a pointer, it has
no valid header. The caller *must* fill in the header correctly."
| index chunk nextIndex nodeBytes parent child smaller larger |
index := chunkBytes / self allocationUnit.
(index < NumFreeLists and: [1 << index >= freeListsMask]) ifTrue:
[(chunk := freeLists at: index) ~= 0 ifTrue:
+ [self assert: chunk = (self startOfObject: chunk).
+ ^self unlinkFreeChunk: chunk atIndex: index].
- [^self unlinkFreeChunk: chunk atIndex: index].
"first search for free chunks of a multiple of chunkBytes in size"
nextIndex := index.
[1 << index >= freeListsMask
and: [(nextIndex := nextIndex + index) < NumFreeLists]] whileTrue:
[((freeListsMask anyMask: 1 << index)
and: [(chunk := freeLists at: index) ~= 0]) ifTrue:
+ [self assert: chunk = (self startOfObject: chunk).
+ self unlinkFreeChunk: chunk atIndex: index.
- [self unlinkFreeChunk: chunk atIndex: index.
self assert: (self bytesInObject: chunk) = index * self allocationUnit.
self freeChunkWithBytes: index * self allocationUnit - chunkBytes
+ at: (self startOfObject: chunk) + chunkBytes.
- at: (self startOfFreeChunk: chunk) + chunkBytes.
^chunk]].
"now get desperate and use the first that'll fit"
nextIndex := index.
[1 << index >= freeListsMask
and: [(nextIndex := nextIndex + 1) < NumFreeLists]] whileTrue:
[(freeListsMask anyMask: 1 << index) ifTrue:
[(chunk := freeLists at: index) ~= 0 ifTrue:
+ [self assert: chunk = (self startOfObject: chunk).
+ self unlinkFreeChunk: chunk atIndex: index.
- [self unlinkFreeChunk: chunk atIndex: index.
self assert: (self bytesInObject: chunk) = index * self allocationUnit.
self freeChunkWithBytes: index * self allocationUnit - chunkBytes
+ at: (self startOfObject: chunk) + chunkBytes.
- at: (self startOfFreeChunk: 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."
parent := 0.
child := freeLists at: 0.
[child ~= 0] whileTrue:
[nodeBytes := self bytesInObject: child.
parent := child.
nodeBytes = chunkBytes
ifTrue: "size match; try to remove from list at node."
[chunk := self fetchPointer: self freeChunkNextIndex
ofFreeChunk: child.
chunk ~= 0 ifTrue:
[self storePointer: self freeChunkNextIndex
ofFreeChunk: child
withValue: (self fetchPointer: self freeChunkNextIndex
ofFreeChunk: chunk).
^chunk].
child := 0] "break out of loop to remove interior node"
ifFalse:"walk down the tree"
[child := self fetchPointer: (nodeBytes > chunkBytes
ifTrue: [self freeChunkSmallerIndex]
ifFalse: [self freeChunkLargerIndex])
ofFreeChunk: child]].
parent = 0 ifTrue:
[self halt].
"self printFreeChunk: parent"
self assert: (self bytesInObject: parent) = nodeBytes.
"attempt to remove from list"
chunk := self fetchPointer: self freeChunkNextIndex
ofFreeChunk: parent.
chunk ~= 0 ifTrue:
[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].
- at: (self startOfFreeChunk: chunk) + chunkBytes].
- ^chunk].
"no list; remove an interior node"
chunk := parent.
parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: chunk.
"no parent; stitch the subnodes back into the root"
parent = 0 ifTrue:
[smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: chunk.
larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: chunk.
smaller = 0
ifTrue: [freeLists at: 0 put: larger]
ifFalse:
[freeLists at: 0 put: smaller.
larger ~= 0 ifTrue:
[self addFreeSubTree: larger]].
"coInterpreter transcript ensureCr.
coInterpreter print: 'new free tree root '.
(freeLists at: 0) = 0 ifTrue: [coInterpreter print: '0'] ifFalse: [self printFreeChunk: (freeLists at: 0)].
coInterpreter cr."
chunkBytes ~= nodeBytes ifTrue:
[self freeChunkWithBytes: nodeBytes - chunkBytes
+ at: (self startOfObject: chunk) + chunkBytes].
+ ^self startOfObject: chunk].
- at: (self startOfFreeChunk: chunk) + chunkBytes].
- ^chunk].
"remove node from tree; 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 |"
self halt.
"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 |"
self halt!
Item was changed:
----- Method: SpurMemoryManager>>isIntegerObject: (in category 'object testing') -----
isIntegerObject: oop
"This list records the valid senders of isIntegerObject: as we replace uses of
isIntegerObject: by isImmediate: where appropriate."
(#( DoIt
DoItIn:
makeBaseFrameFor:
quickFetchInteger:ofObject:
frameOfMarriedContext:
objCouldBeClassObj:
isMarriedOrWidowedContext:
shortPrint:
bytecodePrimAt
bytecodePrimAtPut
commonAt:
commonAtPut:
loadFloatOrIntFrom:
positive32BitValueOf:
primitiveExternalCall
checkedIntegerValueOf:
bytecodePrimAtPut
commonAtPut:
primitiveVMParameter
checkIsStillMarriedContext:currentFP:
displayBitsOf:Left:Top:Right:Bottom:
fetchStackPointerOf:
primitiveContextAt
primitiveContextAtPut
subscript:with:storing:format:
printContext:
compare31or32Bits:equal:
signed64BitValueOf:
primDigitMultiply:negative:
digitLength:
isNegativeIntegerValueOf:
magnitude64BitValueOf:
primitiveMakePoint
primitiveAsCharacter
primitiveInputSemaphore
baseFrameReturn
+ primitiveExternalCall
+ primDigitCompare:
+ isLiveContext:) includes: thisContext sender method selector) ifFalse:
- primitiveExternalCall) includes: thisContext sender method selector) ifFalse:
[self halt].
^(oop bitAnd: 1) ~= 0!
Item was removed:
- ----- Method: SpurMemoryManager>>startOfFreeChunk: (in category 'free space') -----
- startOfFreeChunk: freeChunk
- ^freeChunk - self baseHeaderSize!
Item was changed:
----- Method: SpurMemoryManager>>startOfObject: (in category 'object enumeration') -----
startOfObject: objOop
"Answer the start of objOop, which is either the address of the overflow size word,
+ or objOop itself, depending on the size of the object. This may be applied to
+ any kind of object, normal, forwarders or free chunks."
+ ^(self numSlotsOfAny: objOop) >= self numSlotsMask
- or objOop itself, depending on the size of the object."
- ^(self numSlotsOf: objOop) >= self numSlotsMask
ifTrue: [objOop - self baseHeaderSize]
ifFalse: [objOop]!
Item was changed:
----- Method: StackInterpreter>>flushExternalPrimitives (in category 'plugin primitive support') -----
flushExternalPrimitives
+ "Flush the references to external functions from plugin primitives.
+ This will force a reload of those primitives when accessed next.
+ Note: We must flush the method cache here also, so that any failed
+ primitives are looked up again."
+ objectMemory allObjectsDo:
+ [:oop| | primIdx |
+ (objectMemory isFreeObject: oop) ifFalse:
+ [(objectMemory isCompiledMethod: oop) ifTrue: "This is a compiled method"
+ [primIdx := self primitiveIndexOf: oop.
+ primIdx = PrimitiveExternalCallIndex ifTrue: "It's primitiveExternalCall"
+ [self flushExternalPrimitiveOf: oop]]]].
- "Flush the references to external functions from plugin
- primitives. This will force a reload of those primitives when
- accessed next.
- Note: We must flush the method cache here so that any
- failed primitives are looked up again."
- | oop primIdx |
- oop := objectMemory firstObject.
- [self oop: oop isLessThan: objectMemory freeStart]
- whileTrue: [(objectMemory isFreeObject: oop)
- ifFalse: [(objectMemory isCompiledMethod: oop)
- ifTrue: ["This is a compiled method"
- primIdx := self primitiveIndexOf: oop.
- primIdx = PrimitiveExternalCallIndex
- ifTrue: ["It's primitiveExternalCall"
- self flushExternalPrimitiveOf: oop]]].
- oop := objectMemory objectAfter: oop].
self flushMethodCache.
self flushAtCache.
self flushExternalPrimitiveTable!
More information about the Vm-dev
mailing list