[Vm-dev] VM Maker: VMMaker.oscog-eem.397.mcz
commits at source.squeak.org
commits at source.squeak.org
Fri Sep 20 22:06:15 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.397.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.397
Author: eem
Time: 20 September 2013, 3:03:30.831 pm
UUID: 52862ea4-1375-4ead-852f-2e65e2941a26
Ancestors: VMMaker.oscog-eem.396
weakArrayFormat can also have fixed inst vars. You learn something
new every day.
Add format printing to longPrintOop:.
Fix isIntegerObject: for debugging (add #on:do:).
=============== Diff against VMMaker.oscog-eem.395 ===============
Item was added:
+ ----- Method: CogVMSimulator>>checkStackIntegrity (in category 'object memory support') -----
+ checkStackIntegrity
+ "Override to deal with incomplete initialization."
+ stackPages ifNil: [^true].
+ ^super checkStackIntegrity!
Item was changed:
----- Method: Spur32BitMMLESimulator>>firstIndexableField: (in category 'object format') -----
firstIndexableField: objOop
"NOTE: overridden from SpurMemoryManager to add coercion to CArray, so please duplicate any changes.
There are only two important cases, both for objects with named inst vars, i.e. formats 2,3 & 5.
The first indexable field for formats 2 & 5 is the slot count (by convention, even though that's off the end
of the object). For 3 we must go to the class."
| fmt classFormat |
<returnTypeC: #'void *'>
fmt := self formatOf: objOop.
fmt <= self lastPointerFormat ifTrue: "pointer; may need to delve into the class format word"
+ [(fmt between: self indexablePointersFormat and: self weakArrayFormat) ifTrue:
- [fmt = self indexablePointersFormat ifTrue:
[classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop).
^self cCoerce: (self pointerForOop: objOop
+ self baseHeaderSize
+ ((self fixedFieldsOfClassFormat: classFormat) << self wordSize))
to: #'oop *'].
^self cCoerce: (self pointerForOop: objOop
+ self baseHeaderSize
+ ((self numSlotsOf: objOop) << self wordSize))
to: #'oop *'].
"All bit objects, and indeed CompiledMethod, though this is a non-no, start at 0"
self assert: (fmt >= self sixtyFourBitIndexableFormat and: [fmt < self firstCompiledMethodFormat]).
^self
cCoerce: (self pointerForOop: objOop + self baseHeaderSize)
to: (fmt < self firstByteFormat
ifTrue:
[fmt = self sixtyFourBitIndexableFormat
ifTrue: ["64 bit field objects" #'long long *']
ifFalse:
[fmt < self firstShortFormat
ifTrue: ["32 bit field objects" #'int *']
ifFalse: ["16-bit field objects" #'short *']]]
ifFalse: ["byte objects (including CompiledMethod" #'char *'])!
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])
- ((byteAddress = 16r120DBDC or: [byteAddress = 16r120DBD8])
and: [a64BitValue >> 32 = 16r16000000
or: [(a64BitValue bitAnd: 16rffffffff) = 16r16000000]]) ifTrue:
+ [self halt]."
- [self halt].
memory
at: byteAddress // 4 + 1 put: (a64BitValue bitAnd: 16rffffffff);
at: byteAddress // 4 + 2 put: a64BitValue >> 32.
^a64BitValue!
Item was added:
+ ----- Method: Spur32BitMMLESimulator>>pushBool: (in category 'simulation only') -----
+ pushBool: trueOrFalse
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ ^coInterpreter pushBool: trueOrFalse!
Item was changed:
----- Method: Spur32BitMemoryManager>>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 |
- | ok numRememberedRootsInHeap |
<inline: false>
ok := true.
numRememberedRootsInHeap := 0.
+ self allHeapEntitiesDo:
- self allObjectsDo:
[: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: ' -> '; printHex: classOop; 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].
- ok := false]]]].
numRememberedRootsInHeap ~= scavenger rememberedSetSize ifTrue:
[coInterpreter
print: 'root count mismatch. #heap roots ';
printNum: numRememberedRootsInHeap;
print: '; #roots ';
printNum: scavenger rememberedSetSize;
cr.
"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 rootTable @ '; printNum: i; print: ' = '; printHex: obj; cr.
self eek.
ok := false]
ifFalse:
[(self isYoung: obj) ifTrue:
[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: 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.
- [numSlots := 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: [^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 changed:
----- 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.
- [numSlots := 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: [^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 changed:
----- Method: SpurGenerationScavenger>>scavengeLoop (in category 'scavenger') -----
scavengeLoop
"This is the inner loop of the main routine, scavenge. It first scavenges the new objects immediately
reachable from old ones. Then it scavenges those that are transitively reachable. If this results in a
promotion, the promotee gets remembered, and it first scavenges objects adjacent to the promotee,
then scavenges the ones reachable from the promoted. This loop continues until no more reachable
objects are left. At that point, pastSurvivorSpace is exchanged with futureSurvivorSpace.
Notice that each pointer in a live object is inspected once and only once. The previousRememberedSetSize
and previousFutureSurvivorSpaceLimit variables ensure that no object is scanned twice, as well as
detecting closure. If this were not true, some pointers might get forwarded twice."
| firstTime previousRememberedSetSize previousFutureSurvivorStart |
self assert: futureSurvivorStart = futureSpace start. "future space should be empty at the start"
firstTime := true.
previousRememberedSetSize := 0.
previousFutureSurvivorStart := futureSurvivorStart.
[self scavengeRememberedSetStartingAt: previousRememberedSetSize.
previousFutureSurvivorStart = futureSurvivorStart ifTrue:
[^self].
previousRememberedSetSize := rememberedSetSize.
+ firstTime ifTrue:
- firstTime ifTrue:
[coInterpreter mapInterpreterOops.
firstTime := false].
+
self scavengeFutureSurvivorSpaceStartingAt: previousFutureSurvivorStart.
+ previousRememberedSetSize = rememberedSetSize ifTrue:
- previousFutureSurvivorStart = rememberedSetSize ifTrue:
[^self].
previousFutureSurvivorStart := futureSurvivorStart] repeat!
Item was added:
+ ----- Method: SpurMemoryManager>>allHeapEntitiesDo: (in category 'object enumeration') -----
+ allHeapEntitiesDo: aBlock
+ <inline: true>
+ self allNewSpaceEntitiesDo: aBlock.
+ self allOldSpaceEntitiesDo: aBlock!
Item was added:
+ ----- Method: SpurMemoryManager>>allNewSpaceEntitiesDo: (in category 'object enumeration') -----
+ allNewSpaceEntitiesDo: aBlock
+ "Enumerate all new space objects, including free objects,
+ excluding any objects created during the ennumeration."
+ <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:
+ [aBlock value: objOop.
+ prevPrevObj := prevObj.
+ prevObj := objOop.
+ objOop := self objectAfter: objOop limit: freeStart].
+ objOop := self objectStartingAt: scavenger pastSpace start.
+ limit := pastSpaceStart.
+ [objOop < limit] whileTrue:
+ [aBlock value: objOop.
+ prevPrevObj := prevObj.
+ prevObj := objOop.
+ objOop := self objectAfter: objOop limit: limit].
+ prevPrevObj class.
+ prevObj class!
Item was added:
+ ----- Method: SpurMemoryManager>>allOldSpaceEntitiesDo: (in category 'object enumeration') -----
+ allOldSpaceEntitiesDo: aBlock
+ <inline: true>
+ | prevObj prevPrevObj objOop |
+ prevPrevObj := prevObj := nil.
+ objOop := self firstObject.
+ [self assert: objOop \\ self allocationUnit = 0.
+ objOop < freeOldSpaceStart] whileTrue:
+ [aBlock value: objOop.
+ prevPrevObj := prevObj.
+ prevObj := objOop.
+ objOop := self objectAfter: objOop limit: freeOldSpaceStart].
+ prevPrevObj class.
+ prevObj class!
Item was changed:
----- Method: SpurMemoryManager>>enterIntoClassTable: (in category 'class table') -----
enterIntoClassTable: aBehavior
"Enter aBehavior into the class table and answer 0. Otherwise answer a primitive failure code."
| initialMajorIndex majorIndex minorIndex page |
majorIndex := classTableIndex >> self classTableMajorIndexShift.
initialMajorIndex := majorIndex.
"classTableIndex should never index the first page; it's reserved for known classes"
self assert: initialMajorIndex > 0.
minorIndex := classTableIndex bitAnd: self classTableMinorIndexMask.
[page := self fetchPointer: majorIndex ofObject: classTableRootObj.
page = nilObj ifTrue:
+ [page := self allocateSlotsInOldSpace: self classTablePageSize
- [page := self allocateSlots: self classTablePageSize
format: self arrayFormat
classIndex: self arrayClassIndexPun.
page ifNil:
[^PrimErrNoMemory].
self fillObj: page numSlots: self classTablePageSize with: nilObj.
self storePointer: majorIndex
ofObject: classTableRootObj
withValue: page.
minorIndex := 0].
minorIndex to: self classTablePageSize - 1 do:
[:i|
(self fetchPointer: i ofObject: page) = nilObj ifTrue:
[classTableIndex := majorIndex << self classTableMajorIndexShift + i.
self storePointer: i
ofObject: page
withValue: aBehavior.
self setHashBitsOf: aBehavior to: classTableIndex.
self assert: (self classAtIndex: (self rawHashBitsOf: aBehavior)) = aBehavior.
"now fault-in method lookup chain."
self scanClassPostBecome: aBehavior
effects: BecamePointerObjectFlag+BecameCompiledMethodFlag.
^0]].
majorIndex := (majorIndex + 1 bitAnd: self classIndexMask) max: 1.
majorIndex = initialMajorIndex ifTrue: "wrapped; table full"
[^PrimErrLimitExceeded]] repeat!
Item was changed:
----- Method: SpurMemoryManager>>firstIndexableField: (in category 'object format') -----
firstIndexableField: objOop
"NOTE: overridden in various simulator subclasses to add coercion to CArray, so please duplicate any changes.
There are only two important cases, both for objects with named inst vars, i.e. formats 2,3 & 5.
The first indexable field for formats 2 & 5 is the slot count (by convention, even though that's off the end
of the object). For 3 we must go to the class."
| fmt classFormat |
<returnTypeC: #'void *'>
fmt := self formatOf: objOop.
fmt <= self lastPointerFormat ifTrue: "pointer; may need to delve into the class format word"
+ [(fmt between: self indexablePointersFormat and: self weakArrayFormat) ifTrue:
- [fmt = self indexablePointersFormat ifTrue:
[classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop).
^self pointerForOop: objOop
+ self baseHeaderSize
+ ((self fixedFieldsOfClassFormat: classFormat) << self wordSize)].
^self pointerForOop: objOop
+ self baseHeaderSize
+ ((self numSlotsOf: objOop) << self wordSize)].
"All bit objects, and indeed CompiledMethod, though this is a non-no, start at 0"
self assert: fmt < self firstCompiledMethodFormat.
^self pointerForOop: objOop + self baseHeaderSize!
Item was added:
+ ----- Method: SpurMemoryManager>>freeObject: (in category 'free space') -----
+ freeObject: objOop
+ ^self freeChunkWithBytes: (self bytesInObject: objOop) at: (self startOfObject: objOop)!
Item was changed:
----- Method: SpurMemoryManager>>isIndexableFormat: (in category 'object testing') -----
isIndexableFormat: format
^format >= self arrayFormat
+ and: [format <= self weakArrayFormat
- and: [format <= self indexablePointersFormat
or: [format >= self sixtyFourBitIndexableFormat]]!
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."
+ | sel |
+ sel := thisContext sender method selector.
(#( DoIt
DoItIn:
+ on:do: "from the debugger"
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:
+ numPointerSlotsOf:
+ fileValueOf:) includes: sel) ifFalse:
- isLiveContext:) includes: thisContext sender method selector) ifFalse:
[self halt].
^(oop bitAnd: 1) ~= 0!
Item was changed:
----- Method: StackInterpreter>>bereaveAllMarriedContexts (in category 'frame access') -----
bereaveAllMarriedContexts
"Enumerate all contexts and convert married contexts to widowed contexts so
that the snapshot contains only single contexts. This allows the test for being
married to avoid checking for a context's frame pointer being in bounds.
Thanks to Greg Nuyens for this idea."
- | oop |
<asmLabel: false>
+ objectMemory allObjectsDo:
+ [:obj|
+ ((objectMemory isContextNonImm: obj)
+ and: [self isMarriedOrWidowedContext: obj]) ifTrue:
+ [self markContextAsDead: obj]]!
- oop := objectMemory firstObject.
- [oop < objectMemory freeStart] whileTrue:
- [((objectMemory isFreeObject: oop) not
- and: [(objectMemory isContextNonImm: oop)
- and: [self isMarriedOrWidowedContext: oop]]) ifTrue:
- [self markContextAsDead: oop].
- oop := objectMemory objectAfter: oop]!
Item was changed:
----- Method: StackInterpreter>>checkInterpreterIntegrity (in category 'object memory support') -----
checkInterpreterIntegrity
"Perform an integrity/leak check using the heapMap. Assume
clearLeakMapAndMapAccessibleObjects has set a bit at each
object's header. Check that all oops in the interpreter's state
points to a header. Answer if all checks pass."
| ok |
ok := true.
(objectMemory checkOopIntegrity: objectMemory specialObjectsOop named: 'specialObjectsOop')ifFalse:
[ok := false].
+ "No longer check messageSelector; it is ephemeral, not living beyond message lookup.
(objectMemory isNonImmediate: messageSelector) ifTrue:
[(objectMemory checkOopIntegrity: messageSelector named: 'messageSelector')ifFalse:
+ [ok := false]]."
- [ok := false]].
(objectMemory checkOopIntegrity: newMethod named: 'newMethod')ifFalse:
[ok := false].
+ "No longer check lkupClass; it is ephemeral, not living beyond message lookup.
(objectMemory checkOopIntegrity: lkupClass named: 'lkupClass')ifFalse:
+ [ok := false]."
- [ok := false].
(objectMemory checkOopIntegrity: profileProcess named: 'profileProcess')ifFalse:
[ok := false].
(objectMemory checkOopIntegrity: profileMethod named: 'profileMethod')ifFalse:
[ok := false].
(objectMemory checkOopIntegrity: profileSemaphore named: 'profileSemaphore')ifFalse:
[ok := false].
tempOop = 0 ifFalse:
[(objectMemory checkOopIntegrity: tempOop named: 'tempOop')ifFalse:
[ok := false]].
"Callback support - check suspended callback list"
1 to: jmpDepth do:
[:i|
(objectMemory checkOopIntegrity: (suspendedCallbacks at: i) named: 'suspendedCallbacks' index: i) ifFalse:
[ok := false].
(objectMemory checkOopIntegrity: (suspendedMethods at: i) named: 'suspendedMethods' index: i) ifFalse:
[ok := false]].
self checkLogIntegrity ifFalse:
[ok := false].
^ok!
Item was changed:
----- Method: StackInterpreter>>convertFloatsToPlatformOrderFrom:to: (in category 'image save/restore') -----
convertFloatsToPlatformOrderFrom: startOop to: stopAddr
"Byte-swap the words of all bytes objects in a range of the
image, including Strings, ByteArrays, and CompiledMethods.
This returns these objects to their original byte ordering
after blindly byte-swapping the entire image. For compiled
methods, byte-swap only their bytecodes part.
Ensure floats are in platform-order."
- | oop temp |
objectMemory vmEndianness = imageFloatsBigEndian ifTrue:
[^nil].
self assert: ClassFloatCompactIndex ~= 0.
+ objectMemory allObjectsDo:
+ [:obj| | temp |
+ (objectMemory compactClassIndexOf: obj) = ClassFloatCompactIndex ifTrue:
+ [temp := self longAt: obj + BaseHeaderSize.
+ self longAt: obj + BaseHeaderSize put: (self longAt: obj + BaseHeaderSize + 4).
+ self longAt: obj + BaseHeaderSize + 4 put: temp]]!
- oop := startOop.
- [self oop: oop isLessThan: stopAddr] whileTrue:
- [(objectMemory isFreeObject: oop) ifFalse:
- [(objectMemory compactClassIndexOf: oop) = ClassFloatCompactIndex ifTrue:
- [temp := self longAt: oop + BaseHeaderSize.
- self longAt: oop + BaseHeaderSize put: (self longAt: oop + BaseHeaderSize + 4).
- self longAt: oop + BaseHeaderSize + 4 put: temp]].
- oop := objectMemory objectAfter: oop]!
Item was changed:
----- Method: StackInterpreter>>longPrintOop: (in category 'debug printing') -----
longPrintOop: oop
<api>
| class fmt lastIndex startIP bytecodesPerLine column |
((objectMemory isImmediate: oop)
or: [(objectMemory addressCouldBeObj: oop) not
or: [(oop bitAnd: objectMemory allocationUnit - 1) ~= 0
or: [(objectMemory isFreeObject: oop)
or: [objectMemory isForwarded: oop]]]]) ifTrue:
[^self printOop: oop].
class := objectMemory fetchClassOfNonImm: oop.
self printHex: oop;
print: ': a(n) '; printNameOfClass: class count: 5;
print: ' ('; printHex: class; print: ')'.
fmt := objectMemory formatOf: oop.
+ self print: ' format '; printHex: fmt.
fmt > objectMemory lastPointerFormat ifTrue:
[self print: ' nbytes '; printNum: (objectMemory byteLengthOf: oop)].
objectMemory printHeaderTypeOf: oop.
+ self print: ' hash '; printHex: (objectMemory rawHashBitsOf: oop).
- self print: ', hash '; printHex: (objectMemory rawHashBitsOf: oop).
self cr.
(fmt between: objectMemory firstLongFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue:
[^self].
"this is nonsense. apologies."
startIP := (objectMemory lastPointerOf: oop) + BytesPerOop - objectMemory baseHeaderSize / BytesPerOop.
lastIndex := 256 min: startIP.
lastIndex > 0 ifTrue:
[1 to: lastIndex do:
[:i| | fieldOop |
fieldOop := objectMemory fetchPointer: i - 1 ofObject: oop.
self space; printNum: i - 1; space; printHex: fieldOop; space.
(i = 1 and: [objectMemory isCompiledMethod: oop])
ifTrue: [self printMethodHeaderOop: fieldOop]
ifFalse: [self printOopShort: fieldOop].
self cr]].
(objectMemory isCompiledMethod: oop)
ifFalse:
[startIP > 64 ifTrue: [self print: '...'; cr]]
ifTrue:
[startIP := startIP * BytesPerWord + 1.
lastIndex := objectMemory lengthOf: oop.
lastIndex - startIP > 100 ifTrue:
[lastIndex := startIP + 100].
bytecodesPerLine := 8.
column := 1.
startIP to: lastIndex do:
[:index| | byte |
column = 1 ifTrue:
[self cCode: 'printf("0x%08x: ", oop+BaseHeaderSize+index-1)'
inSmalltalk: [self print: (oop+BaseHeaderSize+index-1) hex; print: ': ']].
byte := objectMemory fetchByte: index - 1 ofObject: oop.
self cCode: 'printf(" %02x/%-3d", byte,byte)'
inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte].
column := column + 1.
column > bytecodesPerLine ifTrue:
[column := 1. self cr]].
column = 1 ifFalse:
[self cr]]!
Item was changed:
----- Method: StackInterpreter>>snapshot: (in category 'image save/restore') -----
snapshot: embedded
"update state of active context"
| activeContext activeProc dataSize rcvr setMacType stackIndex |
<var: #setMacType type: 'void *'>
"For nowe the stack munging below doesn't deal with more than omne argument.
It can, and should."
argumentCount ~= 0 ifTrue:
[^self primitiveFailFor: PrimErrBadNumArgs].
"Need to convert all frames into contexts since the snapshot file only holds objects."
self push: instructionPointer.
activeContext := self voidVMStateForSnapshot.
"update state of active process"
activeProc := self activeProcess.
objectMemory
storePointer: SuspendedContextIndex
ofObject: activeProc
withValue: activeContext.
objectMemory pushRemappableOop: activeContext.
+ "garbage collect, bereave contexts and flush external methods."
- "compact memory and compute the size of the memory actually in use"
- objectMemory incrementalGC.
-
- "maximimize space for forwarding table"
- objectMemory fullGC.
self snapshotCleanUp.
"Nothing moves from here on so it is safe to grab the activeContext again."
activeContext := objectMemory popRemappableOop.
dataSize := objectMemory freeStart - objectMemory startOfMemory. "Assume all objects are below the start of the free block"
self successful ifTrue:
["Without contexts or stacks simulate
rcvr := self popStack.
''pop rcvr''
self push: trueObj.
to arrange that the snapshot resumes with true. N.B. stackIndex is one-relative."
stackIndex := self quickFetchInteger: StackPointerIndex ofObject: activeContext.
rcvr := objectMemory fetchPointer: stackIndex + CtxtTempFrameStart - 1 ofObject: activeContext.
objectMemory
storePointerUnchecked: stackIndex + CtxtTempFrameStart - 1
ofObject: activeContext
withValue: objectMemory trueObject.
"now attempt to write the snapshot file"
self writeImageFileIO: dataSize.
(self successful and: [embedded not]) ifTrue:
["set Mac file type and creator; this is a noop on other platforms"
setMacType := self ioLoadFunction: 'setMacFileTypeAndCreator' From: 'FilePlugin'.
setMacType = 0 ifFalse:
[self cCode: '((sqInt (*)(char *, char *, char *))setMacType)(imageName, "STim", "FAST")']].
"Without contexts or stacks simulate
self pop: 1"
objectMemory
storePointerUnchecked: StackPointerIndex
ofObject: activeContext
withValue: (objectMemory integerObjectOf: stackIndex - 1)].
self marryContextInNewStackPageAndInitializeInterpreterRegisters: activeContext.
self successful
ifTrue: [self push: objectMemory falseObject]
ifFalse:
[self push: rcvr.
self justActivateNewMethod]!
Item was changed:
----- Method: StackInterpreter>>snapshotCleanUp (in category 'image save/restore') -----
snapshotCleanUp
+ "Clean up right before saving an image, garbage collecting, sweeping memory and:
- "Clean up right before saving an image, sweeping memory and:
* nilling out all fields of contexts above the stack pointer.
* flushing external primitives
* clearing the root bit of any object in the root table
* bereaving widowed contexts.
By ensuring that all contexts are single in a snapshot (i.e. that no married contexts
exist) we can maintain the invariant that a married or widowed context's frame
reference (in its sender field) must point into the stack pages since no married or
widowed contexts are present from older runs of the system."
+
+ objectMemory hasSpurMemoryManagerAPI
+ ifTrue: [objectMemory flushNewSpace]
+ ifFalse: [objectMemory incrementalGC] "compact memory and compute the size of the memory actually in use"
+
+ "maximimize space for forwarding table"
+ objectMemory fullGC.
+
+ objectMemory allObjectsDo:
+ [:obj| | header fmt sz |
+ header := self longAt: obj.
+ fmt := objectMemory formatOfHeader: header.
+ "Clean out context"
+ (fmt = objectMemory indexablePointersFormat
+ and: [objectMemory isContextHeader: header]) ifTrue:
+ ["All contexts have been divorced. Bereave remaining widows."
+ (self isMarriedOrWidowedContext: obj) ifTrue:
+ [self markContextAsDead: obj].
+ "Fill slots beyond top of stack with nil"
+ (self fetchStackPointerOf: obj) to: (objectMemory numSlotsOf: obj) do:
+ [:i | objectMemory
+ storePointerUnchecked: i + CtxtTempFrameStart
+ ofObject: obj
+ withValue: objectMemory nilObject]].
+ "Clean out external functions from compiled methods"
+ fmt >= objectMemory firstCompiledMethodFormat ifTrue:
+ ["Its primitiveExternalCall"
+ (self primitiveIndexOf: obj) = PrimitiveExternalCallIndex ifTrue:
+ [self flushExternalPrimitiveOf: obj]]].
+
+ objectMemory hasSpurMemoryManagerAPI ifFalse:
+ [objectMemory clearRootsTable]!
- | oop header fmt sz |
- oop := objectMemory firstObject.
- [self oop: oop isLessThan: objectMemory freeStart] whileTrue:
- [(objectMemory isFreeObject: oop) ifFalse:
- [header := self longAt: oop.
- fmt := objectMemory formatOfHeader: header.
- "Clean out context"
- (fmt = objectMemory indexablePointersFormat
- and: [objectMemory isContextHeader: header]) ifTrue:
- ["All contexts have been divorced. Bereave remaining widows."
- (self isMarriedOrWidowedContext: oop) ifTrue:
- [self markContextAsDead: oop].
- sz := objectMemory sizeBitsOf: oop.
- (objectMemory lastPointerOf: oop) + BytesPerWord
- to: sz - BaseHeaderSize by: BytesPerWord
- do: [:i | self longAt: oop + i put: objectMemory nilObject]].
- "Clean out external functions from compiled methods"
- fmt >= objectMemory firstCompiledMethodFormat ifTrue:
- ["Its primitiveExternalCall"
- (self primitiveIndexOf: oop) = PrimitiveExternalCallIndex ifTrue:
- [self flushExternalPrimitiveOf: oop]]].
- oop := objectMemory objectAfter: oop].
- objectMemory clearRootsTable!
Item was changed:
----- Method: StackInterpreterSimulator>>allObjectsSelect: (in category 'debug support') -----
allObjectsSelect: objBlock
"self allObjectsSelect: [:oop | (self baseHeader: oop) = 1234]"
+ | selected |
- | oop selected |
- oop := objectMemory firstObject.
selected := OrderedCollection new.
+ objectMemory allObjectsDo:
+ [:obj|
+ (objBlock value: obj) ifTrue: [selected addLast: obj]].
+ ^selected!
- [oop < objectMemory endOfMemory] whileTrue:
- [(objectMemory isFreeObject: oop)
- ifFalse: [(objBlock value: oop) ifTrue: [selected addLast: oop]].
- oop := objectMemory objectAfter: oop].
- ^ selected!
Item was added:
+ ----- Method: StackInterpreterSimulator>>checkStackIntegrity (in category 'object memory support') -----
+ checkStackIntegrity
+ "Override to deal with incomplete initialization."
+ stackPages ifNil: [^true].
+ ^super checkStackIntegrity!
More information about the Vm-dev
mailing list