[Vm-dev] VM Maker: VMMaker.oscog-eem.413.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Sep 26 18:58:35 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.413.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.413
Author: eem
Time: 26 September 2013, 11:55:56.418 am
UUID: c9d2ca92-5900-4492-8e52-0ad86af3530f
Ancestors: VMMaker.oscog-eem.412
Fix allocateOldSpaceChunkOfBytes: in two ways
a) to not create slivers of 1 allocationUnit long wnen taking storage
from the tree (already handled the lists).
b) to nil the parent pointer of nodes stitched back into the root
(this was a baaad bug)
Provide allFreeObjectsDo: and isValidFreeObject: to check ammount
and validity of free space.
Fix bug in SpurMemMgr>>clone: that misremembered.
Add assert to SpurGenerationScavenger>>remember:.
Change the assert in ensureBehaviorHash:.
More safety in SpurNBitMemMgr>instantiateClass:indexableSize: for
the instSpec fall through case.
Refactor fillObj:numSlots:with:; it differs between 32 and 64 bits.
Sionara initPastSpaceForObjectEnumeration.
Fix send printing in commonSend now the VM uses lkupClassTag.
Use runLeakCheckerForFullGC: in loadInitialContext instead of
internals.
Fix simulator initialization of pluginList to include anonynous empty
entry for the VM itself.
Fix heap map's byteIndex calculation (!!).
Nuke unused objectIsOld:.
Now bootstrap can run a test for weak arrays and ephemerons
through to failure (no support for weakness or ephemerality in the
scavenger yet).
=============== Diff against VMMaker.oscog-eem.412 ===============
Item was removed:
- ----- Method: CoInterpreter>>objectIsOld: (in category 'cog jit support') -----
- objectIsOld: anObject
- <api>
- ^self oop: anObject isLessThan: objectMemory youngStart!
Item was changed:
Object subclass: #CogCheck32BitHeapMap
instanceVariableNames: 'pages'
+ classVariableNames: 'ByteShift NumPages PageMask PageShift PageSize'
- classVariableNames: 'NumPages PageMask PageShift PageSize'
poolDictionaries: ''
category: 'VMMaker-InterpreterSimulation'!
!CogCheck32BitHeapMap commentStamp: 'eem 2/27/2013 16:26' prior: 0!
A CogCheckHeapMap is a simulation of the code in platforms/Cross/vm/sqHeapMap.c. This is a map for leak checking that allocates 1 bit for every 4 bytes of address space. It uses an array of pages to keep space overhead low, only allocating a page if that portion of the address space is used. So the maximum overhead is address space size / (word size * bits per byte), or (2 raisedTo: 32) / (4 * 8) or 134,217,728 bytes.
Instance Variables
pages: <Array of: ByteArray>
pages
- array of pages of bits, 1 bit per word of address space
!
Item was changed:
----- Method: CogCheck32BitHeapMap class>>initialize (in category 'class initialization') -----
initialize
"self initialize"
| wordSize bitsPerByte |
wordSize := 4. "4 bytes per bit in the map"
bitsPerByte := 8.
NumPages := 256.
+ PageShift := -24. "(32 - (NumPages log: 2)) negated asInteger"
- PageShift := -24. "32 - (NumPages log: 2)"
PageSize := 2 << 32 / wordSize / NumPages / bitsPerByte.
+ PageMask := PageSize - 1.
+ ByteShift := -5 "1 bit per 4 bytes, 8 bits per byte = 32 bytes of address space per map byte"!
- PageMask := PageSize - 1!
Item was changed:
----- Method: CogCheck32BitHeapMap>>byteIndex: (in category 'accessing') -----
byteIndex: address
+ ^((address bitShift: ByteShift) bitAnd: PageMask) + 1!
- ^((address bitShift: -2) bitAnd: PageMask) + 1!
Item was changed:
----- Method: CogCheck32BitHeapMap>>pageIndex: (in category 'accessing') -----
+ pageIndex: address
- pageIndex: address
^(address bitShift: PageShift) + 1 "32 - (pageSize log: 2)"!
Item was changed:
----- Method: CogVMSimulator>>initialize (in category 'initialization') -----
initialize
"Initialize the CogVMSimulator when running the interpreter inside Smalltalk. The
primary responsibility of this method is to allocate Smalltalk Arrays for variables
that will be declared as statically-allocated global arrays in the translated code."
objectMemory ifNil:
[objectMemory := self class objectMemoryClass simulatorClass new].
cogit ifNil:
[cogit := self class cogitClass new setInterpreter: self].
objectMemory coInterpreter: self cogit: cogit.
cogit numRegArgs > 0 ifTrue:
[debugStackDepthDictionary := Dictionary new].
cogThreadManager ifNotNil:
[super initialize].
"Note: we must initialize ConstMinusOne & HasBeenReturnedFromMCPC differently
for simulation, due to the fact that the simulator works only with +ve 32-bit values"
ConstMinusOne := objectMemory integerObjectOf: -1.
HasBeenReturnedFromMCPC := objectMemory integerObjectOf: -1.
cogMethodZone := cogit methodZone. "Because Slang can't remove intermediate implicit receivers (cogit methodZone foo doesn't reduce to foo())"
enableCog := true.
methodCache := Array new: MethodCacheSize.
atCache := Array new: AtCacheTotalSize.
self flushMethodCache.
self flushAtCache.
cogCompiledCodeCompactionCalledFor := false.
gcSemaphoreIndex := 0.
externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
externalPrimitiveTableFirstFreeIndex := 0.
primitiveTable := self class primitiveTable copy.
+ pluginList := {'' -> self }.
- pluginList := #().
mappedPluginEntries := OrderedCollection new.
desiredNumStackPages := desiredEdenBytes := desiredCogCodeSize := 0.
"This is initialized on loading the image, but convenient for testing stack page values..."
numStackPages := self defaultNumStackPages.
startMicroseconds := Time totalSeconds * 1000000.
maxLiteralCountForCompile := MaxLiteralCountForCompile.
minBackwardJumpCountForCompile := MinBackwardJumpCountForCompile.
flagInterpretedMethods := false.
"initialize InterpreterSimulator variables used for debugging"
byteCount := lastPollCount := sendCount := 0.
quitBlock := [^ self].
traceOn := true.
printSends := printFrameAtEachStep := printBytecodeAtEachStep := false.
myBitBlt := BitBltSimulator new setInterpreter: self.
transcript := Transcript.
displayForm := 'Display has not yet been installed' asDisplayText form.
suppressHeartbeatFlag := deferSmash := deferredSmash := false.
systemAttributes := Dictionary new.
primTraceLog := CArrayAccessor on: (Array new: 256 withAll: 0).
primTraceLogIndex := 0.
traceLog := CArrayAccessor on: (Array new: TraceBufferSize withAll: 0).
traceLogIndex := 0.
traceSources := TraceSources.
statCodeCompactionCount := 0.
statCodeCompactionUsecs := 0.
extSemTabSize := 256!
Item was changed:
----- Method: InterpreterSimulator>>initialize (in category 'initialization') -----
initialize
"Initialize the InterpreterSimulator when running the interpreter inside
Smalltalk. The primary responsibility of this method is to allocate
Smalltalk Arrays for variables that will be declared as statically-allocated
global arrays in the translated code."
"Note: we must initialize ConstMinusOne differently for simulation,
due to the fact that the simulator works only with +ve 32-bit values"
ConstMinusOne := self integerObjectOf: -1.
methodCache := Array new: MethodCacheSize.
atCache := Array new: AtCacheTotalSize.
self flushMethodCache.
rootTable := Array new: RootTableSize.
weakRoots := Array new: RootTableSize + RemapBufferSize + 100.
remapBuffer := Array new: RemapBufferSize.
gcSemaphoreIndex := 0.
semaphoresUseBufferA := true.
semaphoresToSignalA := Array new: SemaphoresToSignalSize.
semaphoresToSignalB := Array new: SemaphoresToSignalSize.
externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
primitiveTable := self class primitiveTable.
+ pluginList := {'' -> self }.
- pluginList := #().
mappedPluginEntries := #().
"initialize InterpreterSimulator variables used for debugging"
byteCount := 0.
sendCount := 0.
quitBlock := [^ self].
traceOn := true.
printSends := "printReturns := printBytecodeAtEachStep :=" false.
myBitBlt := BitBltSimulator new setInterpreter: self.
headerTypeBytes := CArrayAccessor on: HeaderTypeExtraBytes.
transcript := Transcript.
displayForm := 'Display has not yet been installed' asDisplayText form.
!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>initialize (in category 'initialization') -----
initialize
"Initialize the NewspeakInterpreterSimulator when running the interpreter inside
Smalltalk. The primary responsibility of this method is to allocate
Smalltalk Arrays for variables that will be declared as statically-allocated
global arrays in the translated code."
"initialize class variables"
ObjectMemory initBytesPerWord: self wordSize.
ObjectMemory initialize.
NewspeakInterpreter initialize.
super initialize.
"Note: we must initialize ConstMinusOne differently for simulation,
due to the fact that the simulator works only with +ve 32-bit values"
ConstMinusOne := self integerObjectOf: -1.
methodCache := Array new: MethodCacheSize.
atCache := Array new: AtCacheTotalSize.
self flushMethodCache.
rootTable := Array new: RootTableSize.
weakRoots := Array new: RootTableSize + RemapBufferSize + 100.
remapBuffer := Array new: RemapBufferSize.
gcSemaphoreIndex := 0.
externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
primitiveTable := self class primitiveTable.
+ pluginList := {'' -> self }.
- pluginList := #().
mappedPluginEntries := #().
primTraceLog := CArrayAccessor on: (Array new: 256 withAll: 0).
sendTraceLog := CArrayAccessor on: (Array new: 256 withAll: 0).
"initialize NewspeakInterpreterSimulator variables used for debugging"
byteCount := 0.
sendCount := 0.
quitBlock := [^ self].
traceOn := true.
printSends := "printReturns := " printBytecodeAtEachStep := printContextAtEachStep := false.
myBitBlt := BitBltSimulator new setInterpreter: self.
headerTypeBytes := CArrayAccessor on: HeaderTypeExtraBytes.
transcript := Transcript.
displayForm := 'Display has not yet been installed' asDisplayText form.
!
Item was added:
+ ----- Method: Spur32BitMemoryManager>>fillObj:numSlots:with: (in category 'instantiation') -----
+ fillObj: objOop numSlots: numSlots with: fillValue
+ self assert: (objOop + self baseHeaderSize + (numSlots * self bytesPerOop) - 1)
+ < (self addressAfter: objOop).
+ objOop + self baseHeaderSize
+ to: objOop + self baseHeaderSize + (numSlots * self wordSize) - 1
+ by: self allocationUnit
+ do: [:p|
+ self longAt: p put: fillValue;
+ longAt: p + 4 put: fillValue]!
Item was changed:
+ ----- Method: Spur32BitMemoryManager>>instantiateClass:indexableSize: (in category 'instantiation') -----
- ----- Method: Spur32BitMemoryManager>>instantiateClass:indexableSize: (in category 'allocation') -----
instantiateClass: classObj indexableSize: nElements
| instSpec classFormat numSlots classIndex newObj fillValue |
classFormat := self formatOfClass: classObj.
instSpec := self instSpecOfClassFormat: classFormat.
fillValue := 0.
instSpec caseOf: {
[self arrayFormat] ->
[numSlots := nElements.
fillValue := nilObj].
[self indexablePointersFormat] ->
[numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements.
fillValue := nilObj].
[self weakArrayFormat] ->
[numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements.
fillValue := nilObj].
[self sixtyFourBitIndexableFormat] ->
[numSlots := nElements * 2].
[self firstLongFormat] ->
[numSlots := nElements].
[self firstShortFormat] ->
[numSlots := nElements + 1 // 2.
instSpec := instSpec + (nElements bitAnd: 1)].
[self firstByteFormat] ->
[numSlots := nElements + 3 // 4.
instSpec := instSpec + (4 - nElements bitAnd: 3)].
[self firstCompiledMethodFormat] ->
[numSlots := nElements + 3 // 4.
instSpec := instSpec + (4 - nElements bitAnd: 3)] }
otherwise: ["some Squeak images include funky fixed subclasses of abstract variable
superclasses. e.g. DirectoryEntry as a subclass of ArrayedCollection.
Allow fixed classes to be instantiated here iff nElements = 0."
+ (nElements ~= 0 or: [instSpec >= self sixtyFourBitIndexableFormat]) ifTrue:
+ [^nil].
+ numSlots := self fixedFieldsOfClassFormat: classFormat]. "non-indexable"
- numSlots := self fixedFieldsOfClassFormat: classFormat.
- nElements ~= 0 ifTrue:
- [^nil]]. "non-indexable"
classIndex := self ensureBehaviorHash: classObj.
classIndex < 0 ifTrue:
[coInterpreter primitiveFailFor: classIndex negated.
^nil].
newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex.
newObj ifNotNil:
[self fillObj: newObj numSlots: numSlots with: fillValue].
^newObj!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>fillObj:numSlots:with: (in category 'instantiation') -----
+ fillObj: objOop numSlots: numSlots with: fillValue
+ self assert: (objOop + self baseHeaderSize + (numSlots * self bytesPerOop) - 1)
+ < (self addressAfter: objOop).
+ objOop + self baseHeaderSize
+ to: objOop + self baseHeaderSize + (numSlots * self bytesPerOop) - 1
+ by: self allocationUnit
+ do: [:p| self longAt: p put: fillValue]!
Item was changed:
+ ----- Method: Spur64BitMemoryManager>>instantiateClass:indexableSize: (in category 'instantiation') -----
- ----- Method: Spur64BitMemoryManager>>instantiateClass:indexableSize: (in category 'allocation') -----
instantiateClass: classObj indexableSize: nElements
| instSpec classFormat numSlots classIndex newObj fillValue |
classFormat := self formatOfClass: classObj.
instSpec := self instSpecOfClassFormat: classFormat.
fillValue := 0.
instSpec caseOf: {
[self arrayFormat] ->
[numSlots := nElements.
fillValue := nilObj].
[self indexablePointersFormat] ->
[numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements.
fillValue := nilObj].
[self weakArrayFormat] ->
[numSlots := (self fixedFieldsOfClassFormat: classFormat) + nElements.
fillValue := nilObj].
[self sixtyFourBitIndexableFormat] ->
[numSlots := nElements].
[self firstLongFormat] ->
[numSlots := nElements + 1 // 2.
instSpec := instSpec + (nElements bitAnd: 1)].
[self firstShortFormat] ->
[numSlots := nElements + 3 // 4.
instSpec := instSpec + (4 - nElements bitAnd: 3)].
[self firstByteFormat] ->
[numSlots := nElements + 7 // 8.
instSpec := instSpec + (8 - nElements bitAnd: 7)].
[self firstCompiledMethodFormat] ->
[numSlots := nElements + 7 // 8.
instSpec := instSpec + (8 - nElements bitAnd: 7)] }
+ otherwise: ["some Squeak images include funky fixed subclasses of abstract variable
+ superclasses. e.g. DirectoryEntry as a subclass of ArrayedCollection.
+ Allow fixed classes to be instantiated here iff nElements = 0."
+ (nElements ~= 0 or: [instSpec >= self sixtyFourBitIndexableFormat]) ifTrue:
+ [^nil].
+ numSlots := self fixedFieldsOfClassFormat: classFormat]. "non-indexable"
- otherwise: [^nil]. "non-indexable"
classIndex := self ensureBehaviorHash: classObj.
classIndex < 0 ifTrue:
[coInterpreter primitiveFailFor: classIndex negated.
^nil].
newObj := self allocateSlots: numSlots format: instSpec classIndex: classIndex.
newObj ifNotNil:
[self fillObj: newObj numSlots: numSlots with: fillValue].
^newObj!
Item was removed:
- ----- Method: SpurGenerationScavenger>>initPastSpaceForObjectEnumeration (in category 'initialization') -----
- initPastSpaceForObjectEnumeration
- "For SuurMemoryManager allNewSpaceObjectsDo: fill pastSpace with
- a single empty object."
- | objOop |
- manager initFreeChunkWithBytes: pastSpace limit - pastSpace start at: pastSpace start.
- objOop := manager objectStartingAt: pastSpace start.
- self assert: (manager addressAfter: objOop) = pastSpace limit!
Item was changed:
----- Method: SpurGenerationScavenger>>manager:newSpaceStart:newSpaceBytes:edenBytes: (in category 'initialization') -----
manager: aSpurMemoryManager newSpaceStart: startAddress newSpaceBytes: totalBytes edenBytes: requestedEdenBytes
| edenBytes survivorBytes |
manager := aSpurMemoryManager.
edenBytes := requestedEdenBytes.
survivorBytes := totalBytes - edenBytes // 2 truncateTo: manager allocationUnit.
edenBytes := totalBytes - survivorBytes - survivorBytes truncateTo: manager allocationUnit.
self assert: totalBytes - edenBytes - survivorBytes - survivorBytes < manager allocationUnit.
"for tenuring we require older objects below younger objects. since allocation
grows up this means that the survivor spaces must preceed eden."
pastSpace := SpurNewSpaceSpace new.
futureSpace := SpurNewSpaceSpace new.
eden := SpurNewSpaceSpace new.
pastSpace start: startAddress limit: startAddress + survivorBytes.
futureSpace start: pastSpace limit limit: pastSpace limit + survivorBytes.
eden start: futureSpace limit limit: futureSpace limit + edenBytes.
self assert: futureSpace limit <= (startAddress + totalBytes).
self assert: eden start \\ manager allocationUnit
+ (eden limit \\ manager allocationUnit) = 0.
self assert: pastSpace start \\ manager allocationUnit
+ (pastSpace limit \\ manager allocationUnit) = 0.
self assert: futureSpace start \\ manager allocationUnit
+ (futureSpace limit \\ manager allocationUnit) = 0.
self initFutureSpaceStart.
- self initPastSpaceForObjectEnumeration.
manager initSpaceForAllocationCheck: eden!
Item was changed:
----- Method: SpurGenerationScavenger>>remember: (in category 'store check') -----
remember: objOop
+ self assert: ((manager isNonImmediate: objOop)
+ and: [(manager isYoung: objOop) not]).
rememberedSetSize < RememberedSetLimit
ifTrue:
[rememberedSet at: rememberedSetSize put: objOop.
(rememberedSetSize := rememberedSetSize + 1) >= RememberedSetRedZone ifTrue:
[manager scheduleScavenge]]
ifFalse:
[self error: 'remembered set overflow' "for now"]!
Item was added:
+ ----- Method: SpurGenerationScavengerSimulator>>remember: (in category 'store check') -----
+ remember: objOop
+ (rememberedSetSize > 0
+ and: [(rememberedSet at: rememberedSetSize - 1) = objOop]) ifTrue:
+ [self halt].
+ ^super remember: objOop!
Item was added:
+ ----- Method: SpurMemoryManager>>allFreeObjectsDo: (in category 'free space') -----
+ allFreeObjectsDo: aBlock
+ | obj |
+ 1 to: NumFreeLists - 1 do:
+ [:i|
+ obj := freeLists at: i.
+ [obj ~= 0] whileTrue:
+ [aBlock value: obj.
+ obj := self fetchPointer: self freeChunkNextIndex ofFreeChunk: obj]].
+ self allObjectsInFreeTree: (freeLists at: 0) do: aBlock!
Item was added:
+ ----- Method: SpurMemoryManager>>allObjectsInFreeTree:do: (in category 'free space') -----
+ allObjectsInFreeTree: freeNode do: aBlock
+ | listNode |
+ freeNode = 0 ifTrue: [^0].
+ listNode := freeNode.
+ [listNode ~= 0] whileTrue:
+ [aBlock value: listNode.
+ listNode := self fetchPointer: self freeChunkNextIndex ofFreeChunk: listNode].
+ self allObjectsInFreeTree: (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: freeNode)
+ do: aBlock.
+ self allObjectsInFreeTree: (self fetchPointer: self freeChunkLargerIndex ofFreeChunk: freeNode)
+ do: aBlock!
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."
| 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:
[(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).
- self assert: (self isFreeObject: 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
- [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)
- 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]].
parent = 0 ifTrue:
[totalFreeOldSpace := totalFreeOldSpace + chunkBytes. "optimism was unfounded"
+ self halt.
+ ^nil].
- self halt].
"self printFreeChunk: parent"
+ self assert: (nodeBytes = chunkBytes or: [nodeBytes >= (chunkBytes + (2 * self allocationUnit))]).
- self assert: nodeBytes >= chunkBytes.
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
- [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]
- ifTrue: [freeLists at: 0 put: larger]
ifFalse:
+ [self storePointer: self freeChunkParentIndex ofFreeChunk: smaller withValue: 0.
+ freeLists at: 0 put: smaller.
- [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]
ifFalse:
[self storePointer: (chunk = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent)
ifTrue: [self freeChunkSmallerIndex]
ifFalse: [self freeChunkLargerIndex])
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 changed:
----- Method: SpurMemoryManager>>bytesInFreeTree: (in category 'free space') -----
bytesInFreeTree: freeNode
| freeBytes bytesInObject listNode |
freeNode = 0 ifTrue: [^0].
freeBytes := 0.
bytesInObject := self bytesInObject: freeNode.
self assert: bytesInObject / self allocationUnit >= NumFreeLists.
- self assert: (self isFreeObject: freeNode).
listNode := freeNode.
[listNode ~= 0] whileTrue:
+ ["self printFreeChunk: listNode"
+ self assert: (self isValidFreeObject: listNode).
+ freeBytes := freeBytes + bytesInObject.
- [freeBytes := freeBytes + bytesInObject.
self assert: bytesInObject = (self bytesInObject: listNode).
listNode := self fetchPointer: self freeChunkNextIndex ofFreeChunk: listNode].
^freeBytes
+ (self bytesInFreeTree: (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: freeNode))
+ (self bytesInFreeTree: (self fetchPointer: self freeChunkLargerIndex ofFreeChunk: freeNode))!
Item was changed:
----- Method: SpurMemoryManager>>checkHeapIntegrity (in category 'debug support') -----
checkHeapIntegrity
"Perform an integrity/leak check using the heapMap. Assume
clearLeakMapAndMapAccessibleObjects has set a bit at each
object's header. Scan all objects in the heap checking that every
pointer points to a header. Scan the rootTable, remapBuffer and
extraRootTable checking that every entry is a pointer to a header.
Check that the number of roots is correct and that all rootTable
entries have their rootBit set. Answer if all checks pass."
| prevObj prevPrevObj ok numRememberedRootsInHeap |
<inline: false>
ok := true.
numRememberedRootsInHeap := 0.
self allHeapEntitiesDo:
[:obj| | containsYoung fieldOop classIndex classOop |
(self isFreeObject: obj) ifFalse:
[containsYoung := false.
(self isRemembered: obj) ifTrue:
[numRememberedRootsInHeap := numRememberedRootsInHeap + 1.
(scavenger isInRememberedTable: obj) ifFalse:
[coInterpreter print: 'remembered object '; printHex: obj; print: ' is not in remembered table'; cr.
self eek.
ok := false]].
(self isForwarded: obj)
ifTrue:
[fieldOop := self fetchPointer: 0 ofMaybeForwardedObject: obj.
(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
[coInterpreter print: 'object leak in forwarder '; printHex: obj; print: ' to unmapped '; printHex: fieldOop; cr.
self eek.
ok := false].
(self isYoung: fieldOop) ifTrue:
[containsYoung := true]]
ifFalse:
[classOop := self classAtIndex: (classIndex := self classIndexOf: obj).
(classOop isNil or: [classOop = nilObj]) ifTrue:
[coInterpreter print: 'object leak in '; printHex: obj; print: ' invalid class index '; printHex: classIndex; print: ' -> '; print: (classOop ifNil: ['nil'] ifNotNil: ['nilObj']); cr.
self eek.
ok := false].
self baseHeaderSize to: (self lastPointerOf: obj) by: BytesPerOop do:
[:ptr|
fieldOop := self longAt: obj + ptr.
(self isNonImmediate: fieldOop) ifTrue:
[| fi |
fi := ptr - self baseHeaderSize / self wordSize.
(fieldOop bitAnd: self wordSize - 1) ~= 0
ifTrue:
[coInterpreter print: 'misaligned oop in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
self eek.
ok := false]
ifFalse:
[(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
[coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
self eek.
ok := false].
(self isYoung: fieldOop) ifTrue:
[containsYoung := true]]]]].
(containsYoung and: [(self isYoung: obj) not]) ifTrue:
[(self isRemembered: obj) ifFalse:
[coInterpreter print: 'unremembered object '; printHex: obj; print: ' contains young oop(s)'; cr.
self eek.
ok := false]]].
prevPrevObj := prevObj.
prevObj := obj].
numRememberedRootsInHeap ~= scavenger rememberedSetSize ifTrue:
[coInterpreter
print: 'root count mismatch. #heap roots ';
printNum: numRememberedRootsInHeap;
print: '; #roots ';
printNum: scavenger rememberedSetSize;
cr.
+ self eek.
"But the system copes with overflow..."
self flag: 'no support for remembered set overflow yet'.
"ok := rootTableOverflowed and: [needGCFlag]"].
scavenger rememberedSetWithIndexDo:
[:obj :i|
(obj bitAnd: self wordSize - 1) ~= 0
ifTrue:
[coInterpreter print: 'misaligned oop in rootTable @ '; printNum: i; print: ' = '; printHex: obj; cr.
self eek.
ok := false]
ifFalse:
[(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0
ifTrue:
+ [coInterpreter print: 'object leak in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr.
- [coInterpreter print: 'object leak in rootTable @ '; printNum: i; print: ' = '; printHex: obj; cr.
self eek.
ok := false]
ifFalse:
[(self isYoung: obj) ifTrue:
+ [coInterpreter print: 'non-root in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr.
- [coInterpreter print: 'non-root in rootTable @ '; printNum: i; print: ' = '; printHex: obj; cr.
self eek.
ok := false]]]].
self flag: 'no support for remap buffer yet'.
"1 to: remapBufferCount do:
[:ri|
obj := remapBuffer at: ri.
(obj bitAnd: self wordSize - 1) ~= 0
ifTrue:
[coInterpreter print: 'misaligned remapRoot @ '; printNum: ri; print: ' = '; printHex: obj; cr.
self eek.
ok := false]
ifFalse:
[(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0
ifTrue:
[coInterpreter print: 'object leak in remapRoots @ '; printNum: ri; print: ' = '; printHex: obj; cr.
self eek.
ok := false]]]."
self flag: 'no support for extraRoots yet'.
"1 to: extraRootCount do:
[:ri|
obj := (extraRoots at: ri) at: 0.
(obj bitAnd: self wordSize - 1) ~= 0
ifTrue:
[coInterpreter print: 'misaligned extraRoot @ '; printNum: ri; print: ' => '; printHex: obj; cr.
self eek.
ok := false]
ifFalse:
[(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0
ifTrue:
[coInterpreter print: 'object leak in extraRoots @ '; printNum: ri; print: ' => '; printHex: obj; cr.
self eek.
ok := false]]]."
^ok!
Item was changed:
----- Method: SpurMemoryManager>>clone: (in category 'allocation') -----
clone: objOop
| numSlots newObj |
numSlots := self numSlotsOf: objOop.
newObj := self allocateSlots: (self numSlotsOf: objOop)
format: (self formatOf: objOop)
classIndex: (self classIndexOf: objOop).
(self isPointersNonImm: objOop)
ifTrue:
[0 to: numSlots - 1 do:
[:i| | oop |
oop := self fetchPointer: i ofObject: objOop.
((self isNonImmediate: oop)
and: [self isForwarded: oop]) ifTrue:
[oop := self followForwarded: oop].
self storePointerUnchecked: i
ofObject: newObj
withValue: oop].
((self isRemembered: objOop)
+ and: [(self isYoung: newObj) not]) ifTrue:
+ [scavenger remember: newObj.
+ self setIsRememberedOf: newObj to: true]]
- and: [self isYoung: newObj]) ifTrue:
- [scavenger remember: objOop.
- self setIsRememberedOf: objOop to: true]]
ifFalse:
[0 to: numSlots - 1 do:
[:i|
self storePointerUnchecked: i
ofObject: newObj
withValue: (self fetchPointer: i ofObject: objOop)]].
^newObj!
Item was changed:
----- Method: SpurMemoryManager>>ensureBehaviorHash: (in category 'class table') -----
ensureBehaviorHash: aBehavior
| newHash err |
<inline: true>
+ self assert: (coInterpreter addressCouldBeClassObj: aBehavior).
- self assert: (self isImmediate: aBehavior) not.
(newHash := self rawHashBitsOf: aBehavior) = 0 ifTrue:
[(err := self enterIntoClassTable: aBehavior) ~= 0 ifTrue:
[^err negated].
newHash := self rawHashBitsOf: aBehavior.
self assert: (self classAtIndex: newHash) = aBehavior].
^newHash!
Item was changed:
+ ----- Method: SpurMemoryManager>>fillObj:numSlots:with: (in category 'instantiation') -----
- ----- Method: SpurMemoryManager>>fillObj:numSlots:with: (in category 'allocation') -----
fillObj: objOop numSlots: numSlots with: fillValue
+ self subclassResponsibility!
- objOop + self baseHeaderSize
- to: objOop + self baseHeaderSize + (numSlots * self bytesPerOop) - 1
- by: self allocationUnit
- do: [:p|
- self assert: p < (self addressAfter: objOop).
- self longAt: p put: fillValue;
- longAt: p + 4 put: fillValue]!
Item was changed:
----- Method: SpurMemoryManager>>isNonIntegerObject: (in category 'object testing') -----
isNonIntegerObject: oop
"This list records the valid senders of isNonIntegerObject: as we replace uses of
isNonIntegerObject: by isNonImmediate: where appropriate."
+ (#( on:do: "from the dbeugger"
+ reverseDisplayFrom:to:
- (#( reverseDisplayFrom:to:
primitiveObjectAtPut) includes: thisContext sender method selector) ifFalse:
[self halt].
^(oop bitAnd: 1) = 0!
Item was added:
+ ----- Method: SpurMemoryManager>>isValidFreeObject: (in category 'free space') -----
+ isValidFreeObject: objOop
+ | chunk |
+ ^(self isFreeObject: objOop)
+ and: [((chunk := (self fetchPointer: self freeChunkNextIndex ofFreeChunk: objOop)) = 0
+ or: [self isFreeObject: chunk])
+ and: [(self bytesInObject: objOop) / self allocationUnit < NumFreeLists
+ or: [((chunk := (self fetchPointer: self freeChunkParentIndex ofFreeChunk: objOop)) = 0
+ or: [self isFreeObject: chunk])
+ and: [((chunk := (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: objOop)) = 0
+ or: [self isFreeObject: chunk])
+ and: [(chunk := (self fetchPointer: self freeChunkLargerIndex ofFreeChunk: objOop)) = 0
+ or: [self isFreeObject: chunk]]]]]]!
Item was added:
+ ----- Method: SpurMemoryManager>>sizeOfFree: (in category 'free space') -----
+ sizeOfFree: objOop
+ "For compatibility with ObjectMemory, answer the size of a free chunk in bytes,
+ ignoring the overflow header. Do *not* use internally."
+ self assert: (self isFreeObject: objOop).
+ ^self baseHeaderSize + (self wordSize * (self numSlotsOfAny: objOop))!
Item was changed:
----- Method: SpurMemoryManager>>totalFreeListBytes (in category 'free space') -----
totalFreeListBytes
| freeBytes bytesInObject obj |
freeBytes := 0.
1 to: NumFreeLists - 1 do:
[:i|
bytesInObject := i * self allocationUnit.
obj := freeLists at: i.
[obj ~= 0] whileTrue:
[freeBytes := freeBytes + bytesInObject.
self assert: bytesInObject = (self bytesInObject: obj).
+ self assert: (self isValidFreeObject: obj).
- self assert: (self isFreeObject: obj).
obj := self fetchPointer: self freeChunkNextIndex ofFreeChunk: obj]].
^freeBytes + (self bytesInFreeTree: (freeLists at: 0))!
Item was changed:
----- Method: StackInterpreter>>commonSend (in category 'send bytecodes') -----
commonSend
"Send a message, starting lookup with the receiver's class."
"Assume: messageSelector and argumentCount have been set, and that
the receiver and arguments have been pushed onto the stack,"
"Note: This method is inlined into the interpreter dispatch loop."
<sharedCodeNamed: 'commonSend' inCase: #singleExtendedSendBytecode>
self sendBreakpoint: messageSelector receiver: (self internalStackValue: argumentCount).
self printSends ifTrue:
+ [self printActivationNameForSelector: messageSelector startClass: (objectMemory classForClassTag: lkupClassTag); cr].
- [self printActivationNameForSelector: messageSelector startClass: lkupClass; cr].
self internalFindNewMethod.
self internalExecuteNewMethod.
self fetchNextBytecode!
Item was changed:
----- Method: StackInterpreter>>loadInitialContext (in category 'initialization') -----
loadInitialContext
<inline: false>
| activeProc activeContext |
self cCode: [] inSmalltalk: [self initExtensions].
+ objectMemory runLeakCheckerForFullGC: true.
- objectMemory leakCheckFullGC ifTrue:
- [objectMemory clearLeakMapAndMapAccessibleObjects.
- self assert: objectMemory checkHeapIntegrity].
activeProc := self activeProcess.
activeContext := objectMemory fetchPointer: SuspendedContextIndex ofObject: activeProc.
self marryContextInNewStackPageAndInitializeInterpreterRegisters: activeContext!
Item was changed:
----- Method: StackInterpreterSimulator>>initialize (in category 'initialization') -----
initialize
"Initialize the StackInterpreterSimulator when running the interpreter
inside Smalltalk. The primary responsibility of this method is to allocate
Smalltalk Arrays for variables that will be declared as statically-allocated
global arrays in the translated code."
objectMemory ifNil:
[objectMemory := self class objectMemoryClass simulatorClass new].
objectMemory coInterpreter: self.
"Note: we must initialize ConstMinusOne differently for simulation,
due to the fact that the simulator works only with +ve 32-bit values"
ConstMinusOne := objectMemory integerObjectOf: -1.
methodCache := Array new: MethodCacheSize.
atCache := Array new: AtCacheTotalSize.
self flushMethodCache.
self flushAtCache.
gcSemaphoreIndex := 0.
externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
externalPrimitiveTableFirstFreeIndex := 0.
primitiveTable := self class primitiveTable copy.
+ pluginList := {'' -> self }.
- pluginList := #().
mappedPluginEntries := #().
desiredNumStackPages := desiredEdenBytes := 0.
"This is initialized on loading the image, but convenient for testing stack page values..."
numStackPages := self defaultNumStackPages.
startMicroseconds := Time totalSeconds * 1000000.
"initialize InterpreterSimulator variables used for debugging"
byteCount := 0.
sendCount := 0.
quitBlock := [^ self].
traceOn := true.
printSends := printReturns := printFrameAtEachStep := printBytecodeAtEachStep := false.
myBitBlt := BitBltSimulator new setInterpreter: self.
transcript := Transcript.
displayForm := 'Display has not yet been installed' asDisplayText form.
suppressHeartbeatFlag := false.
extSemTabSize := 256.
disableBooleanCheat := false!
Item was changed:
----- Method: StackInterpreterSimulator>>primitiveExecuteMethodArgsArray (in category 'control primitives') -----
primitiveExecuteMethodArgsArray
+ self halt: thisContext selector.
- self halt.
^super primitiveExecuteMethodArgsArray!
More information about the Vm-dev
mailing list