[Vm-dev] VM Maker: VMMaker.oscog-eem.3115.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Dec 1 18:18:26 UTC 2021
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3115.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.3115
Author: eem
Time: 1 December 2021, 10:18:11.033997 am
UUID: e71c2bb2-05b8-4d1e-a837-c31a9bcc2148
Ancestors: VMMaker.oscog-eem.3114
StackInterpreter: fix printAllStacks for v3. Do so by changing SpurMemoryManager>>allObjectsDoSafely: to use isNormalObject: (excluding forwarding pointers) rather than allObjectsDo:, which uses isEnumerableObject: (whcih includes forwarding pointers, and all the puns). This is good for allAccessibleObjectsOkay & checkAllAccessibleObjectsOkay which should indeed ignore things like the class table etc.
=============== Diff against VMMaker.oscog-eem.3114 ===============
Item was changed:
----- Method: NewObjectMemory>>allObjectsDoSafely: (in category 'object enumeration') -----
allObjectsDoSafely: aBlock
+ "Enumerate, not being confised by forwarding pointers.
+ This is chosen for compatiblity with Spur, but the semantics differ.
+ Here we're interested in being able to find the next object in memory
+ even when the compactor is running."
<inline: true>
| oop |
oop := self firstObject.
[oop asUnsignedInteger < freeStart] whileTrue:
[(self isFreeObject: oop) ifFalse:
[aBlock value: oop].
oop := self objectAfterWhileForwarding: oop]!
Item was changed:
----- Method: ObjectMemory>>allObjectsDoSafely: (in category 'object enumeration') -----
allObjectsDoSafely: aBlock
+ "Enumerate, not being confised by forwarding pointers.
+ This is chosen for compatiblity with Spur, but the semantics differ.
+ Here we're interested in being able to find the next object in memory
+ even when the compactor is running."
<inline: true>
| oop |
oop := self firstObject.
[oop asUnsignedInteger < freeBlock] whileTrue:
[(self isFreeObject: oop) ifFalse:
[aBlock value: oop].
oop := self objectAfterWhileForwarding: oop]!
Item was changed:
----- Method: SpurMemoryManager>>allObjectsDoSafely: (in category 'object enumeration') -----
allObjectsDoSafely: aBlock
+ "Enumerate, not being confised by forwarding pointers.
+ This is chosen for compatiblity with [New]Objectmemory, but the semantics differ.
+ Here we're interested in enumerating ordinary objects, ignoring forwarding pointers,
+ and puns."
<inline: true>
+ | startObject |
+ startObject := self objectStartingAt: self startAddressForBridgedHeapEnumeration.
+ self enableObjectEnumerationFrom: startObject.
+ self allEntitiesFrom: startObject
+ do: [:objOop|
+ (self isNormalObject: objOop) ifTrue:
+ [aBlock value: objOop]]!
- self allObjectsDo: aBlock!
Item was changed:
----- Method: StackInterpreter>>printAllStacks (in category 'debug printing') -----
printAllStacks
"Print all the stacks of all running processes, including those that are currently suspended."
<export: true> "useful for VM debugging; use export: not api, so it will be accessible on win32 and won't be written to cointerp.h"
| proc schedLists p processList linkedListClass minProcessInstSize processClass |
<inline: false>
proc := self activeProcess. "may not be an instance of process. may in exceptional circumstances be nilObject"
self printNameOfClass: (objectMemory fetchClassOf: proc) count: 5; space; printHex: proc.
self print: ' priority '; printNum: (self quickFetchInteger: PriorityIndex ofObject: proc); cr.
framePointer
ifNil: [self printProcessStack: proc] "at startup..."
ifNotNil: [self printCallStack]. "first the current activation"
schedLists := objectMemory fetchPointer: ProcessListsIndex ofObject: self schedulerPointer.
linkedListClass := nil.
"then the runnable processes"
p := highestRunnableProcessPriority = 0
ifTrue: [objectMemory numSlotsOf: schedLists]
ifFalse: [highestRunnableProcessPriority].
p - 1 to: 0 by: -1 do:
[:pri|
processList := objectMemory fetchPointer: pri ofObject: schedLists.
(self isEmptyList: processList) ifFalse:
[proc = objectMemory nilObject ifTrue:
[proc := objectMemory fetchPointer: FirstLinkIndex ofObject: processList].
self cr; print: 'processes at priority '; printNum: pri + 1.
self printProcsOnList: processList].
linkedListClass ifNil: [linkedListClass := objectMemory fetchClassOfNonImm: processList]].
linkedListClass ifNil: [linkedListClass := objectMemory superclassOf: objectMemory classSemaphore].
proc = objectMemory nilObject ifTrue:
[self cr; print: 'Cannot find a runnable process. Cannot therefore determine class Process. Cannot therefore print suspended processes'.
^self].
self cr; print: 'suspended processes'.
"Find the root of the Process hierarchy. It is the class, or superclass,
of a process, that has inst size at least large enough to include myList"
processClass := proc = objectMemory nilObject ifFalse: [objectMemory fetchClassOf: proc].
minProcessInstSize := MyListIndex + 1.
[(objectMemory instanceSizeOf: (objectMemory superclassOf: processClass)) >= minProcessInstSize] whileTrue:
[processClass := objectMemory superclassOf: processClass].
minProcessInstSize := objectMemory instanceSizeOf: processClass.
"look for all subInstances of process that have a context as a suspendedContext and are on a list other than a LinkedList"
+ objectMemory allObjectsDoSafely:
+ [:obj|
+ ((objectMemory isPointersNonImm: obj)
+ and: [(objectMemory numSlotsOf: obj) >= minProcessInstSize
+ and: [(self is: obj KindOfClass: processClass)
+ and: [objectMemory isContext: (objectMemory fetchPointer: SuspendedContextIndex ofObject: obj)]]]) ifTrue:
+ [| myList myListClass |
+ "Is the process waiting on some delaying list? This will be a subclass of LinkedList.
+ If so, assume it is blocked on the list."
+ myList := objectMemory fetchPointer: MyListIndex ofObject: obj.
+ (myList ~= objectMemory nilObject
+ and: [(myListClass := objectMemory fetchClassOfNonImm: myList) ~= linkedListClass
+ and: [self is: myList KindOfClass: linkedListClass]]) ifTrue:
+ [self printProcessStack: obj]]]!
- objectMemory hasSpurMemoryManagerAPI
- ifTrue:
- [objectMemory allHeapEntitiesDo:
- [:obj|
- ((objectMemory isNormalObject: obj)
- and: [(objectMemory isPointersNonImm: obj)
- and: [(objectMemory numSlotsOf: obj) >= minProcessInstSize
- and: [(self is: obj KindOfClass: processClass)
- and: [objectMemory isContext: (objectMemory fetchPointer: SuspendedContextIndex ofObject: obj)]]]]) ifTrue:
- [| myList myListClass |
- "Is the process waiting on some delaying list? This will be a subclass of LinkedList.
- If so, assume it is blocked on the list."
- myList := objectMemory fetchPointer: MyListIndex ofObject: obj.
- (myList ~= objectMemory nilObject
- and: [(myListClass := objectMemory fetchClassOfNonImm: myList) ~= linkedListClass
- and: [self is: myList KindOfClass: linkedListClass]]) ifTrue:
- [self printProcessStack: obj]]]]
- ifFalse:
- [objectMemory allObjectsDoSafely:
- [:obj|
- ((objectMemory isNormalObject: obj)
- and: [(objectMemory isPointersNonImm: obj)
- and: [(objectMemory numSlotsOf: obj) >= minProcessInstSize
- and: [(self is: obj KindOfClass: processClass)
- and: [objectMemory isContext: (objectMemory fetchPointer: SuspendedContextIndex ofObject: obj)]]]]) ifTrue:
- [| myList myListClass |
- "Is the process waiting on some delaying list? This will be a subclass of LinkedList.
- If so, assume it is blocked on the list."
- myList := objectMemory fetchPointer: MyListIndex ofObject: obj.
- (myList ~= objectMemory nilObject
- and: [(myListClass := objectMemory fetchClassOfNonImm: myList) ~= linkedListClass
- and: [self is: myList KindOfClass: linkedListClass]]) ifTrue:
- [self printProcessStack: obj]]]]!
More information about the Vm-dev
mailing list