[Vm-dev] VM Maker: VMMaker.oscog-eem.501.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Nov 7 00:46:39 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.501.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.501
Author: eem
Time: 6 November 2013, 4:43:51.368 pm
UUID: b9cdef67-871c-409e-8dd8-75c807a82d67
Ancestors: VMMaker.oscog-eem.500
Refactor (pop)storeLiteralVariable in the StackInterpreter so that all
such bytecodes use storeLiteralVariable:withValue:. Put breakpoints
in the simulator's pushLiteralVariable: & storeLiteralVariable:withValue:
to catch forwarded objects. This for debugging restarting prims that
have failed because of forwarded args.
Use ^self in the clients (and in itemporary:in:put:) now that Slang can
cope.
Spur:
Revise (and refactor) markAndTrace: so that
- pure bits objects are not pushed on the stack
- classes of objects are traced
- checking for immediates, pure bits and weakness is done in markAndShouldScan:
- class processing uses the classTableBitmap to expunge duplicate entries.
Remove the bogus postCompactScanClassTable call from
globalGarbageCollect.
Add followForwardingPointersInScheduler and use it post-become.
Refactor the all*Object*Do: methods to use isEnumerableObject:.
Change the classIsItselfPun so that such objects answer true to
isEnumerableObject:.
Make sure that allocateSlots:format:classIndex: is inlined and that
allocateSlotsInOldSpace:bytes:format:classIndex: and
eliminateAndFreeForwarders are not.
Provide class side utilities to show the class puns and the formats in order.
Add the missing longPrintReferencesTo:.
Fix printOopShortInner: for simulation.
Mimic the free space determination in sqMacMain.c in
the simulator's openOn:. [N.B. this fails to mimic because of
bugs in or around readImageFormatFromFile:StartingAt:.
Slang:
Fix generation of asserts within struct classes in
shouldExcludeReceiverAsFirstArgument:.
=============== Diff against VMMaker.oscog-eem.500 ===============
Item was changed:
----- Method: CoInterpreter>>extendedStoreBytecode (in category 'stack bytecodes') -----
extendedStoreBytecode
"Override to use itemporary:in:put:"
+ | descriptor variableType variableIndex |
- | descriptor variableType variableIndex association |
<inline: true>
descriptor := self fetchByte.
self fetchNextBytecode.
variableType := descriptor >> 6 bitAnd: 3.
variableIndex := descriptor bitAnd: 63.
variableType = 0 ifTrue:
[^objectMemory storePointer: variableIndex ofObject: self receiver withValue: self internalStackTop].
variableType = 1 ifTrue:
[^self itemporary: variableIndex in: localFP put: self internalStackTop].
variableType = 3 ifTrue:
+ [^self storeLiteralVariable: variableIndex withValue: self internalStackTop].
+ self error: 'illegal store'!
- [association := self literal: variableIndex.
- ^objectMemory storePointer: ValueIndex ofObject: association withValue: self internalStackTop].
- self error: 'illegal store'.
- ^nil!
Item was changed:
----- Method: CoInterpreter>>itemporary:in:put: (in category 'internal interpreter access') -----
itemporary: offset in: theFP put: valueOop
"Temporary access for an interpreter frame only."
"See StackInterpreter class>>initializeFrameIndices"
| frameNumArgs |
<inline: true>
<var: #theFP type: #'char *'>
+ offset < (frameNumArgs := self iframeNumArgs: theFP)
- ^offset < (frameNumArgs := self iframeNumArgs: theFP)
ifTrue: [stackPages longAt: theFP + FoxCallerSavedIP + ((frameNumArgs - offset) * BytesPerWord) put: valueOop]
ifFalse: [stackPages longAt: theFP + FoxIFReceiver - BytesPerWord + ((frameNumArgs - offset) * BytesPerWord) put: valueOop]!
Item was changed:
----- Method: CogVMSimulator>>openOn: (in category 'initialization') -----
openOn: fileName
+ "(CogVMSimulator new openOn: 'clonex.image') test"
+ objectMemory hasSpurMemoryManagerAPI ifTrue:
+ [| fileSize potSize |
+ fileSize := (FileDirectory directoryEntryFor: fileName) fileSize.
+ potSize := 1 << (fileSize - 1) highBit.
+ ^self openOn: fileName extraMemory: potSize / 4 + potSize - fileSize].
- "(InterpreterSimulator new openOn: 'clonex.image') test"
self openOn: fileName extraMemory: 2500000.!
Item was added:
+ ----- Method: Spur32BitMMLESimulator>>markAndTrace: (in category 'gc - global') -----
+ markAndTrace: objOop
+ "objOop = 16rB26020 ifTrue: [self halt].
+ objOop = 16rB25FD8 ifTrue: [self halt].
+ objOop = 16rB26010 ifTrue: [self halt]."
+ ^super markAndTrace: objOop!
Item was changed:
----- Method: Spur32BitMMLESimulator>>setIsMarkedOf:to: (in category 'header access') -----
setIsMarkedOf: objOop to: aBoolean
+ "objOop = 16rB26020 ifTrue: [self halt]."
super setIsMarkedOf: objOop to: aBoolean.
"(aBoolean
and: [(self isContextNonImm: objOop)
and: [(coInterpreter
checkIsStillMarriedContext: objOop
currentFP: coInterpreter framePointer)
and: [(coInterpreter stackPages stackPageFor: (coInterpreter frameOfMarriedContext: objOop)) trace = 0]]]) ifTrue:
[self halt]"!
Item was changed:
----- Method: Spur32BitMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') -----
allocateSlots: numSlots format: formatField classIndex: classIndex
+ <inline: true>
| numBytes newObj |
"Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow),
16 bytes otherwise (num slots in preceeding word).
Objects always have at least one slot, for the forwarding pointer,
and are multiples of 8 bytes in length."
numSlots >= self numSlotsMask
ifTrue:
[newObj := freeStart + self baseHeaderSize.
numBytes := self baseHeaderSize + self baseHeaderSize "double header"
+ (numSlots + (numSlots bitAnd: 1) * self bytesPerSlot)] "roundTo allocationUnit"
ifFalse:
[newObj := freeStart.
numBytes := self baseHeaderSize "single header"
+ (numSlots <= 1
ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer"
ifFalse: [numSlots + (numSlots bitAnd: 1) * self bytesPerSlot])]. "roundTo allocationUnit"
freeStart + numBytes > scavengeThreshold ifTrue:
[needGCFlag ifFalse: [self scheduleScavenge].
freeStart + numBytes > scavenger eden limit ifTrue:
[^self allocateSlotsInOldSpace: numSlots bytes: numBytes format: formatField classIndex: classIndex]].
numSlots >= self numSlotsMask
ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
[self flag: #endianness.
self longAt: freeStart put: numSlots.
self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift.
self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)]
ifFalse:
[self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)].
self assert: numBytes \\ self allocationUnit = 0.
self assert: newObj \\ self allocationUnit = 0.
freeStart := freeStart + numBytes.
^newObj!
Item was changed:
----- Method: Spur32BitMemoryManager>>allocateSlotsInOldSpace:bytes:format:classIndex: (in category 'allocation') -----
allocateSlotsInOldSpace: numSlots bytes: totalBytes 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."
+ <inline: false>
| chunk |
chunk := self allocateOldSpaceChunkOfBytes: totalBytes.
self checkFreeSpace.
chunk ifNil:
[^nil].
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: Spur64BitMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') -----
allocateSlots: numSlots format: formatField classIndex: classIndex
+ <inline: true>
| numBytes newObj |
"Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow),
16 bytes otherwise (num slots in preceeding word).
Objects always have at least one slot, for the forwarding pointer,
and are multiples of 8 bytes in length."
numSlots >= self numSlotsMask
ifTrue:
[numSlots > 16rffffffff ifTrue:
[^nil].
newObj := freeStart + self baseHeaderSize.
numBytes := (self baseHeaderSize + self baseHeaderSize) "double header"
+ (numSlots * self bytesPerSlot)]
ifFalse:
[newObj := freeStart.
numBytes := self baseHeaderSize "single header"
+ (numSlots < 1
ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer"
ifFalse: [numSlots * self bytesPerSlot])].
freeStart + numBytes > scavengeThreshold ifTrue:
[needGCFlag ifFalse: [self scheduleScavenge].
freeStart + numBytes > scavenger eden limit ifTrue:
[^self allocateSlotsInOldSpace: numSlots bytes: numBytes format: formatField classIndex: classIndex]].
numSlots >= self numSlotsMask
ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
[self flag: #endianness.
self longAt: freeStart put: numSlots.
self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift.
self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)]
ifFalse:
[self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)].
self assert: numBytes \\ self allocationUnit = 0.
self assert: newObj \\ self allocationUnit = 0.
freeStart := freeStart + numBytes.
^newObj!
Item was changed:
----- Method: Spur64BitMemoryManager>>allocateSlotsInOldSpace:bytes:format:classIndex: (in category 'allocation') -----
allocateSlotsInOldSpace: numSlots bytes: totalBytes 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."
+ <inline: false>
| chunk |
chunk := self allocateOldSpaceChunkOfBytes: totalBytes.
chunk ifNil:
[^nil].
numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
[self longAt: chunk
put: numSlots + (self numSlotsMask << self numSlotsFullShift).
self longAt: chunk + self baseHeaderSize
put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex).
^chunk + self baseHeaderSize].
self longAt: chunk
put: (self headerForSlots: numSlots format: formatField classIndex: classIndex).
^chunk!
Item was added:
+ ----- Method: SpurMemoryManager class>>classIndicesMap (in category 'accessing') -----
+ classIndicesMap
+ "self classIndicesMap"
+ | map |
+ map := Dictionary new.
+ self selectorsAndMethodsDo:
+ [:s :m| | mn |
+ (('*classindex*' match: s) or: ['*bridge*'match: s])
+ and: [mn := m methodNode block.
+ (mn statements size = 1
+ and: [mn statements first expr isConstantNumber]) ifTrue:
+ [map at: mn statements first expr key put: s]]].
+ ^map keys sort collect:
+ [:n|
+ { n. map at: n }]!
Item was added:
+ ----- Method: SpurMemoryManager class>>objectFormatsMap (in category 'accessing') -----
+ objectFormatsMap
+ "self objectFormatsMap"
+ | map |
+ map := Dictionary new.
+ self selectorsAndMethodsDo:
+ [:s :m| | mn |
+ ('*format*' match: s)
+ and: [mn := m methodNode block.
+ (mn statements size = 1
+ and: [mn statements first expr isConstantNumber]) ifTrue:
+ [map at: mn statements first expr key put: s]]].
+ ^map keys sort collect:
+ [:n|
+ { n. map at: n }]!
Item was changed:
----- Method: SpurMemoryManager>>allExistingNewSpaceObjectsDo: (in category 'object enumeration') -----
allExistingNewSpaceObjectsDo: aBlock
<inline: true>
| prevObj prevPrevObj objOop limit |
prevPrevObj := prevObj := nil.
"After a scavenge eden is empty, futureSpace is empty, and all newSpace objects are
in pastSpace. Objects are allocated in eden. So enumerate only eden and pastSpace."
objOop := self objectStartingAt: scavenger eden start.
limit := freeStart.
[objOop < limit] whileTrue:
+ [(self isEnumerableObject: objOop) ifTrue:
- [(self isFreeObject: objOop) ifFalse:
[aBlock value: objOop].
prevPrevObj := prevObj.
prevObj := objOop.
objOop := self objectAfter: objOop limit: freeStart].
objOop := self objectStartingAt: scavenger pastSpace start.
limit := pastSpaceStart.
[objOop < limit] whileTrue:
[(self isFreeObject: objOop) ifFalse:
[aBlock value: objOop].
prevPrevObj := prevObj.
prevObj := objOop.
objOop := self objectAfter: objOop limit: limit].
self touch: prevPrevObj.
self touch: prevObj!
Item was changed:
----- Method: SpurMemoryManager>>allExistingOldSpaceObjectsDo: (in category 'object enumeration') -----
allExistingOldSpaceObjectsDo: aBlock
"Enumerate all old space objects, excluding any objects created
during the execution of allExistingOldSpaceObjectsDo:."
<inline: true>
| oldSpaceLimit prevObj prevPrevObj objOop |
prevPrevObj := prevObj := nil.
objOop := self firstObject.
oldSpaceLimit := freeOldSpaceStart.
[self assert: objOop \\ self allocationUnit = 0.
objOop < oldSpaceLimit] whileTrue:
+ [(self isEnumerableObject: objOop) ifTrue:
- [(self isFreeObject: objOop) ifFalse:
[aBlock value: objOop].
prevPrevObj := prevObj.
prevObj := objOop.
objOop := self objectAfter: objOop limit: freeOldSpaceStart].
self touch: prevPrevObj.
self touch: prevObj!
Item was changed:
----- Method: SpurMemoryManager>>allNewSpaceObjectsDo: (in category 'object enumeration') -----
allNewSpaceObjectsDo: aBlock
"Enumerate all new space objects, excluding any objects created
during the execution of allNewSpaceObjectsDo:."
<inline: true>
| prevObj prevPrevObj objOop limit |
prevPrevObj := prevObj := nil.
"After a scavenge eden is empty, futureSpace is empty, and all newSpace objects are
in pastSpace. Objects are allocated in eden. So enumerate only eden and pastSpace."
objOop := self objectStartingAt: scavenger eden start.
[objOop < freeStart] whileTrue:
+ [(self isEnumerableObject: objOop) ifTrue:
- [(self isFreeObject: objOop) ifFalse:
[aBlock value: objOop].
prevPrevObj := prevObj.
prevObj := objOop.
objOop := self objectAfter: objOop limit: freeStart].
objOop := self objectStartingAt: scavenger pastSpace start.
limit := pastSpaceStart.
[objOop < limit] whileTrue:
+ [(self isEnumerableObject: objOop) ifTrue:
- [(self isFreeObject: objOop) ifFalse:
[aBlock value: objOop].
prevPrevObj := prevObj.
prevObj := objOop.
objOop := self objectAfter: objOop limit: limit].
self touch: prevPrevObj.
self touch: prevObj!
Item was changed:
----- Method: SpurMemoryManager>>allOldSpaceObjectsFrom:do: (in category 'object enumeration') -----
allOldSpaceObjectsFrom: initialObject do: aBlock
+ "Enumerate all objects (i.e. exclude bridges, forwarders and free chunks)
+ in oldSpace starting at initialObject."
<inline: true>
| prevObj prevPrevObj objOop |
prevPrevObj := prevObj := nil.
objOop := initialObject.
[self assert: objOop \\ self allocationUnit = 0.
objOop < freeOldSpaceStart] whileTrue:
+ [(self isEnumerableObject: objOop) ifTrue:
- [(self isFreeObject: objOop) ifFalse:
[aBlock value: objOop].
prevPrevObj := prevObj.
prevObj := objOop.
objOop := self objectAfter: objOop limit: freeOldSpaceStart].
self touch: prevPrevObj.
self touch: prevObj!
Item was changed:
----- Method: SpurMemoryManager>>classIsItselfClassIndexPun (in category 'class table puns') -----
classIsItselfClassIndexPun
+ "Class puns are class indices not used by any class. There is an entry
+ for the pun that refers to the notional class of objects with this class
+ index. But because the index doesn't match the class it won't show up
+ in allInstances, hence hiding the object with a pun as its class index.
+ The puns occupy indices 16 through 31."
+ ^31!
- ^4!
Item was changed:
----- Method: SpurMemoryManager>>eliminateAndFreeForwarders (in category 'gc - global') -----
eliminateAndFreeForwarders
"As the final phase of global garbage collect, sweep
the heap to follow forwarders, then free forwarders"
| lowestForwarded firstForwarded lastForwarded |
+ <inline: false>
self assert: (self isForwarded: nilObj) not.
self assert: (self isForwarded: falseObj) not.
self assert: (self isForwarded: trueObj) not.
self assert: (self isForwarded: hiddenRootsObj) not.
(self isForwarded: specialObjectsOop) ifTrue:
[specialObjectsOop := self followForwarded: specialObjectsOop].
self followForwardedObjStacks.
scavenger followRememberedForwardersAndForgetFreeObjects.
self doScavenge: DontTenureButDoUnmark.
lowestForwarded := 0.
"sweep, following forwarders in all live objects, and finding the first forwarder."
self allOldSpaceObjectsDo:
[:o|
(self isForwarded: o)
ifTrue:
[lowestForwarded = 0 ifTrue:
[lowestForwarded := o]]
ifFalse:
[0 to: (self numPointerSlotsOf: o) - 1 do:
[:i| | f |
f := self fetchPointer: i ofObject: o.
(self isOopForwarded: f) ifTrue:
[f := self followForwarded: f.
self assert: ((self isImmediate: f) or: [self isYoung: f]) not.
self storePointerUnchecked: i ofObject: o withValue: f]]]].
firstForwarded := lastForwarded := 0.
"sweep from lowest forwarder, coalescing runs of forwarders."
self allOldSpaceObjectsFrom: lowestForwarded do:
[:o|
(self isForwarded: o)
ifTrue:
[firstForwarded = 0 ifTrue:
[firstForwarded := o].
lastForwarded := o]
ifFalse:
[firstForwarded ~= 0 ifTrue:
[| start bytes |
start := self startOfObject: firstForwarded.
bytes := (self addressAfter: lastForwarded) - start.
self addFreeChunkWithBytes: bytes at: start].
firstForwarded := 0]].
firstForwarded ~= 0 ifTrue:
[| start bytes |
start := self startOfObject: firstForwarded.
bytes := (self addressAfter: lastForwarded) - start.
self addFreeChunkWithBytes: bytes at: start].!
Item was changed:
----- Method: SpurMemoryManager>>forwardSurvivor:to: (in category 'become implementation') -----
forwardSurvivor: obj1 to: obj2
self assert: (self isInNewSpace: obj1).
+ self assert: ((self isInFutureSpace: obj2) or: [self isInOldSpace: obj2]).
- self assert: ((self isInFutureSpace: obj2) or: (self isInOldSpace: obj2)).
self storePointerUnchecked: 0 ofObject: obj1 withValue: obj2.
self setFormatOf: obj1 to: self forwardedFormat.
self setClassIndexOf: obj1 to: self isForwardedObjectClassIndexPun!
Item was changed:
----- Method: SpurMemoryManager>>globalGarbageCollect (in category 'gc - global') -----
globalGarbageCollect
self runLeakCheckerForFullGC: true.
self assert: self validObjStacks.
self markObjects.
self nilUnmarkedWeaklingSlots.
self freeUnmarkedObjectsAndSortAndCoalesceFreeSpace.
self bestFitCompact.
- self postCompactScanClassTable.
self eliminateAndFreeForwarders.
self assert: self validObjStacks.
self assert: self allObjectsUnmarked.
self runLeakCheckerForFullGC: true!
Item was added:
+ ----- Method: SpurMemoryManager>>isEnumerableObject: (in category 'object enumeration') -----
+ isEnumerableObject: objOop
+ "Answer if objOop should be included in an allObjects...Do: enumeration.
+ Non-objects should be excluded; these are bridges and free chunks."
+ ^(self classIndexOf: objOop) >= self isForwardedObjectClassIndexPun!
Item was added:
+ ----- Method: SpurMemoryManager>>isPureBitsFormat: (in category 'header formats') -----
+ isPureBitsFormat: format
+ ^format >= self sixtyFourBitIndexableFormat
+ and: [format < self firstCompiledMethodFormat]!
Item was added:
+ ----- Method: SpurMemoryManager>>longPrintReferencesTo: (in category 'debug printing') -----
+ longPrintReferencesTo: anOop
+ "Scan the heap long printing the oops of any and all objects that refer to anOop"
+ | prntObj |
+ <api>
+ prntObj := false.
+ self allObjectsDo:
+ [:obj| | i |
+ ((self isPointersNonImm: obj) or: [self isCompiledMethod: obj]) ifTrue:
+ [(self isCompiledMethod: obj)
+ ifTrue:
+ [i := (coInterpreter literalCountOf: obj) + LiteralStart]
+ ifFalse:
+ [(self isContextNonImm: obj)
+ ifTrue: [i := CtxtTempFrameStart + (coInterpreter fetchStackPointerOf: obj)]
+ ifFalse: [i := self numSlotsOf: obj]].
+ [(i := i - 1) >= 0] whileTrue:
+ [anOop = (self fetchPointer: i ofObject: obj) ifTrue:
+ [coInterpreter printHex: obj; print: ' @ '; printNum: i; cr.
+ prntObj := true.
+ i := 0]].
+ prntObj ifTrue:
+ [prntObj := false.
+ coInterpreter longPrintOop: obj]]]!
Item was added:
+ ----- Method: SpurMemoryManager>>markAndShouldScan: (in category 'gc - global') -----
+ markAndShouldScan: objOop
+ "Mark the argument, and answer if its fields should be scanned now.
+ Immediate objects don't need to be marked.
+ Already marked objects have already been processed.
+ Pure bits objects don't need scanning, although their class does.
+ Weak objects should be pushed on the weakling stack.
+ Anything else need scanning."
+ | format |
+ (self isImmediate: objOop) ifTrue:
+ [^false].
+ self assert: (self isForwarded: objOop) not.
+ (self isMarked: objOop) ifTrue:
+ [^false].
+ self setIsMarkedOf: objOop to: true.
+ format := self formatOf: objOop.
+ (self isPureBitsFormat: format) ifTrue: "avoid pushing non-pointer objects on the markStack"
+ [self markAndTraceClassOf: objOop.
+ ^false].
+ format = self weakArrayFormat ifTrue: "push weaklings on the weakling stack to scan later"
+ [self push: objOop onObjStack: weaklingStack.
+ ^false].
+ ^true!
Item was changed:
----- Method: SpurMemoryManager>>markAndTrace: (in category 'gc - global') -----
markAndTrace: objOop
"Mark the argument, and all objects reachable from it, and any remaining objects on the mark stack.
Follow forwarding pointers in the scan."
+ | objToScan numStrongSlots index field |
+ (self markAndShouldScan: objOop) ifFalse:
+ [^self].
- | objToScan index field |
- self assert: (self isNonImmediate: objOop).
"if markAndTrace: is to follow and eliminate forwarding pointers
in its scan it cannot be handed an r-value which is forwarded."
self assert: (self isForwarded: objOop) not.
- (self isMarked: objOop) ifTrue:
- [^self].
- "self setIsMarkedOf: objOop to: false" "for debugging"
- self setIsMarkedOf: objOop to: true.
"Now scan the object, and any remaining objects on the mark stack."
objToScan := objOop.
"To avoid overflowing the mark stack when we encounter large objects, we
push the obj, then its numStrongSlots, and then index the object from the stack."
+ [((self isImmediate: objToScan)
+ or: [numStrongSlots := self numStrongSlotsOf: objToScan ephemeronInactiveIf: #inactiveOrFailedToDeferScan:.
- [| numStrongSlots |
- ((self isImmediate: objToScan)
- or: [numStrongSlots := self numStrongSlotsOf: objToScan ephemeronInactiveIf: #inactiveOrFailedToDeferScan:.
numStrongSlots > self traceImmediatelySlotLimit])
ifTrue: "scanning a large object. scan until hitting an unmarked object, then switch to it, if any."
[(self isImmediate: objToScan)
ifTrue:
[index := self integerValueOf: objToScan.
objToScan := self topOfObjStack: markStack]
ifFalse:
+ [index := numStrongSlots.
+ self markAndTraceClassOf: objToScan].
- [index := numStrongSlots].
[index > 0] whileTrue:
[index := index - 1.
field := self fetchPointer: index ofObject: objToScan.
(self isOopForwarded: field) ifTrue:
[field := self followForwarded: field.
self storePointerUnchecked: index ofObject: objToScan withValue: field].
+ (self markAndShouldScan: field) ifTrue:
+ [index > 0 ifTrue:
+ [(self topOfObjStack: markStack) ~= objToScan ifTrue:
+ [self push: objToScan onObjStack: markStack].
+ self push: (self integerObjectOf: index) onObjStack: markStack].
+ objToScan := field.
+ index := -1]].
- ((self isImmediate: field)
- or: [self isMarked: field]) ifFalse:
- [self setIsMarkedOf: field to: true.
- (self isWeakNonImm: field)
- ifTrue: [self push: field onObjStack: weaklingStack]
- ifFalse:
- [index > 0 ifTrue:
- [(self topOfObjStack: markStack) ~= objToScan ifTrue:
- [self push: objToScan onObjStack: markStack].
- self push: (self integerObjectOf: index) onObjStack: markStack.
- objToScan := field.
- index := -1]]]].
index >= 0 ifTrue: "if loop terminated without finding an unmarked referent, switch to top of stack."
[objToScan := self popObjStack: markStack.
objToScan = objOop ifTrue:
[objToScan := self popObjStack: markStack]]]
ifFalse: "scanning a small object. scan, marking, pushing unmarked referents, then switch to the top of the stack."
[index := numStrongSlots.
+ self markAndTraceClassOf: objToScan.
[index > 0] whileTrue:
[index := index - 1.
field := self fetchPointer: index ofObject: objToScan.
(self isOopForwarded: field) ifTrue:
[field := self followForwarded: field.
self storePointerUnchecked: index ofObject: objToScan withValue: field].
+ (self markAndShouldScan: field) ifTrue:
+ [self push: field onObjStack: markStack.
+ numStrongSlots := self numStrongSlotsOf: field ephemeronInactiveIf: #inactiveOrFailedToDeferScan:.
+ numStrongSlots > self traceImmediatelySlotLimit ifTrue:
+ [self push: (self integerObjectOf: numStrongSlots) onObjStack: markStack]]].
- ((self isImmediate: field)
- or: [self isMarked: field]) ifFalse:
- [self setIsMarkedOf: field to: true.
- (self isWeakNonImm: field)
- ifTrue: [self push: field onObjStack: weaklingStack]
- ifFalse:
- [self push: field onObjStack: markStack.
- numStrongSlots := self numStrongSlotsOf: field ephemeronInactiveIf: #inactiveOrFailedToDeferScan:.
- numStrongSlots > self traceImmediatelySlotLimit ifTrue:
- [self push: (self integerObjectOf: numStrongSlots) onObjStack: markStack]]]].
objToScan := self popObjStack: markStack].
objToScan notNil] whileTrue!
Item was added:
+ ----- Method: SpurMemoryManager>>markAndTraceClassOf: (in category 'gc - global') -----
+ markAndTraceClassOf: objOop
+ "Ensure the class of the argument is marked, pushing it on the markStack if not already marked.
+ Also set the relevant bit in the classTableBitmap so that duplicate entries can be eliminated."
+ <inline: false>
+ | classIndex classObj |
+ classIndex := self classIndexOf: objOop.
+ self inClassTableBitmapSet: classIndex.
+ classObj := self classAtIndex: classIndex.
+ (self isMarked: classObj) ifFalse:
+ [self setIsMarkedOf: classObj to: true.
+ self push: classObj onObjStack: markStack]!
Item was changed:
----- Method: SpurMemoryManager>>markAndTraceWeaklingsFrom: (in category 'weakness and ephemerality') -----
markAndTraceWeaklingsFrom: startIndex
"Mark weaklings on the weaklingStack, ignoring startIndex
number of elements on the bottom of the stack. Answer
the size of the stack *before* the enumeration began."
^self objStack: weaklingStack from: startIndex do:
[:weakling|
+ self markAndTraceClassOf: weakling.
0 to: (self numStrongSlotsOf: weakling ephemeronInactiveIf: nil) - 1 do:
[:i| | field |
field := self fetchPointer: i ofObject: weakling.
((self isImmediate: field) or: [self isMarked: field]) ifFalse:
[self markAndTrace: field]]]!
Item was changed:
----- Method: SpurMemoryManager>>markObjects (in category 'gc - global') -----
markObjects
"Mark all accessible objects."
"If the incremental collector is running mark bits may be set; stop it and clear them if necessary."
self ensureAllMarkBitsAreZero.
+ self ensureAdequateClassTableBitmap.
self initializeUnscannedEphemerons.
self initializeMarkStack.
self initializeWeaklingStack.
+ self markAccessibleObjects.
+ self expungeDuplicateClasses!
- self markAccessibleObjects!
Item was changed:
----- Method: SpurMemoryManager>>printReferencesTo: (in category 'debug printing') -----
printReferencesTo: anOop
"Scan the heap printing the oops of any and all objects that refer to anOop"
<api>
self allObjectsDo:
[:obj| | i |
i := self numPointerSlotsOf: obj.
[(i := i - 1) >= 0] whileTrue:
+ [anOop = (self fetchPointer: i ofMaybeForwardedObject: obj) ifTrue:
- [anOop = (self fetchPointer: i ofObject: obj) ifTrue:
[coInterpreter printHex: obj; print: ' @ '; printNum: i; space; printOopShort: obj; cr.
i := 0]]]!
Item was changed:
----- Method: StackInterpreter>>doubleExtendedDoAnythingBytecode (in category 'send bytecodes') -----
doubleExtendedDoAnythingBytecode
"Replaces the Blue Book double-extended send [132], in which the first byte was wasted on 8 bits of argument count.
Here we use 3 bits for the operation sub-type (opType), and the remaining 5 bits for argument count where needed.
The last byte give access to 256 instVars or literals.
See also secondExtendedSendBytecode"
+ | byte2 byte3 opType top |
- | byte2 byte3 opType top lit |
byte2 := self fetchByte.
byte3 := self fetchByte.
opType := byte2 >> 5.
opType = 0 ifTrue:
[messageSelector := self literal: byte3.
argumentCount := byte2 bitAnd: 31.
^self normalSend].
opType = 1 ifTrue:
[messageSelector := self literal: byte3.
argumentCount := byte2 bitAnd: 31.
^self superclassSend].
self fetchNextBytecode.
opType = 2 ifTrue: [^self pushMaybeContextReceiverVariable: byte3].
opType = 3 ifTrue: [^self pushLiteralConstant: byte3].
opType = 4 ifTrue: [^self pushLiteralVariable: byte3].
top := self internalStackTop.
opType = 7 ifTrue:
+ [^self storeLiteralVariable: byte3 withValue: top].
- [lit := self literal: byte3.
- objectMemory storePointer: ValueIndex ofObject: lit withValue: top.
- ^self].
"opType = 5 is store; opType = 6 = storePop"
opType = 6 ifTrue:
[self internalPop: 1].
+ self storeMaybeContextReceiverVariable: byte3 withValue: top!
- ^self storeMaybeContextReceiverVariable: byte3 withValue: top!
Item was changed:
----- Method: StackInterpreter>>extStoreLiteralVariableBytecode (in category 'stack bytecodes') -----
extStoreLiteralVariableBytecode
"233 11101001 i i i i i i i i Store Literal Variable #iiiiiiii (+ Extend A * 256)"
+ | variableIndex |
- | association variableIndex |
variableIndex := self fetchByte + (extA << 8).
self fetchNextBytecode.
extA := 0.
+ self storeLiteralVariable: variableIndex withValue: self internalStackTop!
- association := self literal: variableIndex.
- objectMemory storePointer: ValueIndex ofObject: association withValue: self internalStackTop!
Item was changed:
----- Method: StackInterpreter>>extendedStoreBytecode (in category 'stack bytecodes') -----
extendedStoreBytecode
+ | descriptor variableType variableIndex |
- | descriptor variableType variableIndex association |
<inline: true>
descriptor := self fetchByte.
self fetchNextBytecode.
variableType := descriptor >> 6 bitAnd: 3.
variableIndex := descriptor bitAnd: 63.
variableType = 0 ifTrue:
[^objectMemory storePointer: variableIndex ofObject: self receiver withValue: self internalStackTop].
variableType = 1 ifTrue:
[^self temporary: variableIndex in: localFP put: self internalStackTop].
variableType = 3 ifTrue:
+ [^self storeLiteralVariable: variableIndex withValue: self internalStackTop].
+ self error: 'illegal store'!
- [association := self literal: variableIndex.
- ^objectMemory storePointer: ValueIndex ofObject: association withValue: self internalStackTop].
- self error: 'illegal store'.
- ^nil!
Item was added:
+ ----- Method: StackInterpreter>>followField:in: (in category 'lazy become') -----
+ followField: fieldIndex in: anObject
+ "Make sure the oop at fieldIndex in anObject is not forwarded (follow the
+ forwarder there-in if so). Answer the (possibly followed) oop at fieldIndex."
+ | field |
+ field := objectMemory fetchPointer: fieldIndex ofObject: anObject.
+ (objectMemory isForwarded: field) ifTrue:
+ [field := objectMemory followForwarded: field.
+ objectMemory storePointer: fieldIndex ofObject: anObject withValue: field].
+ ^field!
Item was added:
+ ----- Method: StackInterpreter>>followForwardingPointersInScheduler (in category 'object memory support') -----
+ followForwardingPointersInScheduler
+ | schedAssoc sched procLists |
+ schedAssoc := objectMemory splObj: SchedulerAssociation.
+ "the GC follows pointers in the special objects array for us."
+ self assert: (objectMemory isForwarded: schedAssoc) not.
+
+ sched := self followField: ValueIndex in: schedAssoc.
+
+ procLists := self followField: ProcessListsIndex in: sched.
+
+ 0 to: (objectMemory numSlotsOf: procLists) - 1 do:
+ [:i| | list first last next |
+ list := self followField: i in: procLists.
+ first := self followField: FirstLinkIndex in: list.
+ last := self followField: LastLinkIndex in: list.
+ [first ~= last] whileTrue:
+ [next := self followField: NextLinkIndex in: first.
+ first := next]]
+ !
Item was changed:
----- Method: StackInterpreter>>methodClassOf: (in category 'compiled methods') -----
methodClassOf: methodPointer
^self cppIf: NewspeakVM
ifTrue:
+ [| literal |
+ literal := self literal: (self literalCountOf: methodPointer) - 1 ofMethod: methodPointer.
+ self assert: (objectMemory isForwarded: literal) not.
+ literal = objectMemory nilObject
- [ | literal |
- literal := self literal: (self literalCountOf: methodPointer) - 1 ofMethod: methodPointer.
- literal = objectMemory nilObject
ifTrue: [literal]
ifFalse: [objectMemory fetchPointer: ValueIndex ofObject: literal]]
ifFalse:
+ [| literal |
+ literal := self literal: (self literalCountOf: methodPointer) - 1 ofMethod: methodPointer.
+ self assert: (objectMemory isForwarded: literal) not.
+ objectMemory fetchPointer: ValueIndex ofObject: literal]!
- [objectMemory fetchPointer: ValueIndex ofObject: (self literal: (self literalCountOf: methodPointer) - 1 ofMethod: methodPointer)]!
Item was changed:
----- Method: StackInterpreter>>postBecomeAction: (in category 'object memory support') -----
postBecomeAction: theBecomeEffectsFlags
theBecomeEffectsFlags ~= 0 ifTrue:
+ [self followForwardingPointersInStackZone: theBecomeEffectsFlags.
+ self followForwardingPointersInScheduler]!
- [self followForwardingPointersInStackZone: theBecomeEffectsFlags]!
Item was changed:
----- Method: StackInterpreter>>printOopShortInner: (in category 'debug printing') -----
printOopShortInner: oop
| classOop name nameLen |
<var: #name type: #'char *'>
<inline: true>
(objectMemory isImmediate: oop) ifTrue:
[(objectMemory isImmediateCharacter: oop) ifTrue:
[self printChar: $$;
printChar: (objectMemory characterValueOf: oop);
printChar: $(;
printHex: (objectMemory integerValueOf: oop);
printChar: $).
^nil].
self printNum: (objectMemory integerValueOf: oop);
printChar: $(;
printHex: (objectMemory integerValueOf: oop);
printChar: $).
^nil].
(objectMemory addressCouldBeObj: oop) ifFalse:
[self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
ifTrue: [' is misaligned']
ifFalse: [' is not on the heap']); cr.
^nil].
(self isFloatObject: oop) ifTrue:
[self printFloat: (self dbgFloatValueOf: oop).
^nil].
classOop := objectMemory fetchClassOfNonImm: oop.
(objectMemory addressCouldBeObj: classOop) ifFalse:
[self print: 'a ??'. ^nil].
(objectMemory numSlotsOf: classOop) = metaclassNumSlots ifTrue:
[self printNameOfClass: oop count: 5.
^nil].
oop = objectMemory nilObject ifTrue: [self print: 'nil'. ^nil].
oop = objectMemory trueObject ifTrue: [self print: 'true'. ^nil].
oop = objectMemory falseObject ifTrue: [self print: 'false'. ^nil].
nameLen := self lengthOfNameOfClass: classOop.
nameLen = 0 ifTrue: [self print: 'a ??'. ^nil].
name := self nameOfClass: classOop.
nameLen = 10 ifTrue:
[(self str: name n: 'ByteString' cmp: 10) not "strncmp is weird" ifTrue:
[self printChar: $'; printStringOf: oop; printChar: $'.
^nil].
(self str: name n: 'ByteSymbol' cmp: 10) not "strncmp is weird" ifTrue:
[self printChar: $#; printStringOf: oop.
^nil]].
(nameLen = 9 and: [(self str: name n: 'Character' cmp: 9) not]) ifTrue:
[self printChar: $$; printChar: (objectMemory integerValueOf: (objectMemory fetchPointer: 0 ofObject: oop)).
^nil].
self print: 'a(n) '.
+ self
+ cCode: [0 to: nameLen - 1 do: [:i| self printChar: (name at: i)]]
+ inSmalltalk:
+ [name isString
+ ifTrue: [self print: name]
+ ifFalse: [0 to: nameLen - 1 do: [:i| self printChar: (name at: i)]]].
- 0 to: nameLen - 1 do: [:i| self printChar: (name at: i)].
"Try to spot association-like things; they're all subclasses of LookupKey"
((objectMemory instanceSizeOf: classOop) = (ValueIndex + 1)
and: [(self superclassOf: classOop) = (self superclassOf: (objectMemory fetchClassOfNonImm: (objectMemory splObj: SchedulerAssociation)))
and: [objectMemory isBytes: (objectMemory fetchPointer: KeyIndex ofObject: oop)]]) ifTrue:
[self space;
printOopShort: (objectMemory fetchPointer: KeyIndex ofObject: oop);
print: ' -> ';
printHex: (objectMemory fetchPointer: ValueIndex ofObject: oop)]!
Item was changed:
----- Method: StackInterpreter>>pushLiteralVariable: (in category 'stack bytecodes') -----
pushLiteralVariable: literalIndex
+ objectMemory hasSpurMemoryManagerAPI
+ ifTrue:
+ [| litVar |
+ "push/store/popLiteralVariable all fetch a literal, and either read or write the literal's value field.
+ The fetch of the literal needs an explicit check (otherwise we would have to scan all literals in
+ all methods in the stack zone, and the entire method on return, and global variables are relatively
+ rare; in my work image 8.7% of literals are globals)."
+ litVar := self literal: literalIndex.
+ (objectMemory isForwarded: litVar) ifTrue:
+ [litVar := objectMemory followForwarded: litVar].
+ self internalPush:
+ (objectMemory fetchPointer: ValueIndex ofObject: litVar)]
+ ifFalse:
+ [self internalPush:
+ (objectMemory fetchPointer: ValueIndex ofObject: (self literal: literalIndex))]!
-
- self internalPush:
- (objectMemory fetchPointer: ValueIndex ofObject: (self literal: literalIndex)).!
Item was added:
+ ----- Method: StackInterpreter>>storeLiteralVariable:withValue: (in category 'stack bytecodes') -----
+ storeLiteralVariable: literalIndex withValue: anObject
+ | litVar |
+ litVar := self literal: literalIndex.
+ "push/store/popLiteralVariable all fetch a literal, and either read or write the literal's value field.
+ The fetch of the literal needs an explicit check (otherwise we would have to scan all literals in
+ all methods in the stack zone, and the entire method on return, and global variables are relatively
+ rare; in my work image 8.7% of literals are globals)."
+
+ (objectMemory isForwarded: litVar) ifTrue:
+ [litVar := objectMemory followForwarded: litVar].
+ objectMemory storePointer: ValueIndex ofObject: litVar withValue: anObject!
Item was added:
+ ----- Method: StackInterpreterSimulator>>literal: (in category 'compiled methods') -----
+ literal: offset
+ "trap pushes of forwarded literals to help debug following forwarded primitive args.
+ it is not an error to push a forwarded literal, but we'd like to step through any resulting
+ primtive failure code"
+ | lit |
+ lit := super literal: offset.
+ (objectMemory isOopForwarded: lit) ifTrue:
+ [self halt: 'forwarded literal in ', thisContext selector].
+ ^lit!
Item was changed:
----- Method: StackInterpreterSimulator>>openOn: (in category 'initialization') -----
openOn: fileName
+ "(StackInterpreterSimulator new openOn: 'clonex.image') test"
+ objectMemory hasSpurMemoryManagerAPI ifTrue:
+ [| fileSize potSize |
+ fileSize := (FileDirectory directoryEntryFor: fileName) fileSize.
+ potSize := 1 << (fileSize - 1) highBit.
+ ^self openOn: fileName extraMemory: potSize / 4 + potSize - fileSize].
- "(InterpreterSimulator new openOn: 'clonex.image') test"
-
self openOn: fileName extraMemory: 2500000.!
Item was changed:
----- Method: TSendNode>>shouldExcludeReceiverAsFirstArgument: (in category 'C code generation') -----
shouldExcludeReceiverAsFirstArgument: aCodeGen
"Only include the receiver as the first argument in certain cases.
The receiver is always included if it is an expression.
If it is a variable:
If the vmClass says it is an implicit variable, don't include it.
If the method's definingClass says it is an implicit variable, don't include it.
If the variable is 'self' and the method being called is not in
the method set (i.e. it is some external code), don't include it.
If it is a struct send of something the vm says is an implicit variable, don't include it."
| m |
+ (aCodeGen isAssertSelector: selector) ifTrue:
+ [^true].
+
(receiver isSend
and: [receiver receiver isVariable
and: [(self isSelfReference: receiver receiver in: aCodeGen)
or: [self isStructReference: receiver receiver in: aCodeGen]]]) ifTrue:
[^aCodeGen isNonArgumentImplicitReceiverVariableName: receiver selector].
^receiver isVariable
and: [(aCodeGen isNonArgumentImplicitReceiverVariableName: receiver name)
or: [(self isSelfReference: receiver in: aCodeGen)
and: [(m := aCodeGen methodNamed: selector) isNil
or: [m typeForSelf == #implicit]]]]!
More information about the Vm-dev
mailing list