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]]]]!
vm-dev@lists.squeakfoundation.org