Smalltalk › Squeak › Squeak VM

VM Maker: VMMaker.oscog-eem.2951.mcz

_‹ Previous Topic Next Topic _›

Classic

List

Threaded

1 message

commits-2

VM Maker: VMMaker.oscog-eem.2951.mcz

Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2951.mcz

==================== Summary ====================

Name: VMMaker.oscog-eem.2951
Author: eem
Time: 13 April 2021, 6:11:29.780025 pm
UUID: 5ebb0375-9fe1-4133-b602-5f607dd20f3e
Ancestors: VMMaker.oscog-eem.2950

All debug printing routines must use <export: true> not <api> to be accessible on win32.

=============== Diff against VMMaker.oscog-eem.2950 ===============

Item was changed:
----- Method: CoInterpreter>>printCogMethod: (in category 'debug printing') -----
printCogMethod: cogMethod
+ <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"
- <api>
<var: #cogMethod type: #'CogMethod *'>
| address primitive |
self cCode: ''
inSmalltalk:
[self transcript ensureCr.
cogMethod isInteger ifTrue:
[^self printCogMethod: (self cCoerceSimple: cogMethod to: #'CogMethod *')]].
address := cogMethod asInteger.
self printHex: address;
print: ' <-> ';
printHex: address + cogMethod blockSize.
cogMethod cmType = CMMethod ifTrue:
[self print: ': method: ';
printHex: cogMethod methodObject.
primitive := self primitiveIndexOfMethod: cogMethod methodObject
header: cogMethod methodHeader.
primitive ~= 0 ifTrue:
[self print: ' prim '; printNum: primitive].
((objectMemory addressCouldBeObj: cogMethod methodObject)
and: [objectMemory addressCouldBeObj: (self methodClassOf: cogMethod methodObject)]) ifTrue:
[self space; printNameOfClass: (self methodClassOf: cogMethod methodObject) count: 2]].
cogMethod cmType = CMBlock ifTrue:
[self print: ': block home: ';
printHex: (self cCoerceSimple: cogMethod to: #'CogBlockMethod *') cmHomeMethod asUnsignedInteger].
cogMethod cmType = CMClosedPIC ifTrue:
[self print: ': Closed PIC N: ';
printHex: cogMethod cPICNumCases].
cogMethod cmType = CMOpenPIC ifTrue:
[self print: ': Open PIC '].
self print: ' selector: '; printHex: cogMethod selector.
cogMethod selector = objectMemory nilObject
ifTrue: [| s |
(cogMethod cmType = CMMethod
and: [(s := self maybeSelectorOfMethod: cogMethod methodObject) notNil])
ifTrue: [self print: ' (nil: '; printStringOf: s; print: ')']
ifFalse: [self print: ' (nil)']]
ifFalse: [self space; printStringOf: cogMethod selector].
self cr!

Item was changed:
----- Method: CoInterpreter>>printFrame:WithSP: (in category 'debug printing') -----
printFrame: theFP WithSP: theSP
+ <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"
- <api>
| theMethod theMethodEnd numArgs numTemps rcvrAddress topThing |
<inline: false>
<var: #theFP type: #'char *'>
<var: #theSP type: #'char *'>
<var: #addr type: #'char *'>
<var: #rcvrAddress type: #'char *'>
<var: #cogMethod type: #'CogBlockMethod *'>
<var: #homeMethod type: #'CogMethod *'>
self cCode: '' inSmalltalk: [self transcript ensureCr].
(stackPages couldBeFramePointer: theFP) ifNil:
[self printHexPtr: theFP; print: ' is not in the stack zone?!!'; cr.
^nil].
(self isMachineCodeFrame: theFP)
ifTrue:
[| cogMethod homeMethod |
cogMethod := self mframeCogMethod: theFP.
homeMethod := self mframeHomeMethod: theFP.
theMethod := homeMethod asInteger.
theMethodEnd := homeMethod asInteger + homeMethod blockSize.
numArgs := cogMethod cmNumArgs.
numTemps := self temporaryCountOfMethodHeader: homeMethod methodHeader]
ifFalse:
[theMethod := self frameMethodObject: theFP.
theMethodEnd := theMethod + (objectMemory sizeBitsOfSafe: theMethod).
numArgs := self iframeNumArgs: theFP.
numTemps := self tempCountOf: theMethod].
(self frameIsBlockActivation: theFP) ifTrue:
[| rcvrOrClosure |
"No BlockLocalTempCounter in the Cogit's C code, so quick hack is to use numCopied + numArgs"
rcvrOrClosure := self pushedReceiverOrClosureOfFrame: theFP.
((objectMemory isNonImmediate: rcvrOrClosure)
and: [(objectMemory addressCouldBeObj: rcvrOrClosure)
and: [(objectMemory fetchClassOfNonImm: rcvrOrClosure) = (objectMemory splObj: ClassBlockClosure)]])
ifTrue: [numTemps := numArgs + (self stSizeOf: rcvrOrClosure)]
ifFalse: [numTemps := numArgs]].
self shortPrintFrame: theFP.
(self isBaseFrame: theFP) ifTrue:
[self printFrameOop: '(caller ctxt'
at: theFP + (self frameStackedReceiverOffset: theFP) + (2 * objectMemory wordSize).
self printFrameOop: '(saved ctxt'
at: theFP + (self frameStackedReceiverOffset: theFP) + (1 * objectMemory wordSize)].
self printFrameOop: 'rcvr/clsr'
at: theFP + FoxCallerSavedIP + ((numArgs + 1) * objectMemory wordSize).
numArgs to: 1 by: -1 do:
[:i|
self printFrameOop: 'arg' index: numArgs - i at: theFP + FoxCallerSavedIP + (i * objectMemory wordSize)].
self printFrameThing: 'caller ip'
at: theFP + FoxCallerSavedIP
extraString: ((stackPages longAt: theFP + FoxCallerSavedIP) = cogit ceReturnToInterpreterPC ifTrue:
['ceReturnToInterpreter']).
self printFrameThing: 'saved fp' at: theFP + FoxSavedFP.
self printFrameMethodFor: theFP.
(self isMachineCodeFrame: theFP) ifTrue:
[self printFrameFlagsForFP: theFP].
self printFrameOop: 'context' at: theFP + FoxThisContext.
(self isMachineCodeFrame: theFP) ifFalse:
[self printFrameFlagsForFP: theFP].
(self isMachineCodeFrame: theFP)
ifTrue: [rcvrAddress := theFP + FoxMFReceiver]
ifFalse:
[self printFrameThing: 'saved ip'
at: theFP + FoxIFSavedIP
extra: ((self iframeSavedIP: theFP) = 0
ifTrue: [0]
ifFalse: [(self iframeSavedIP: theFP) - theMethod + 2 - objectMemory baseHeaderSize]).
rcvrAddress := theFP + FoxIFReceiver].
self printFrameOop: 'receiver' at: rcvrAddress.
topThing := stackPages longAt: theSP.
(self oop: topThing isGreaterThanOrEqualTo: theMethod andLessThan: theMethodEnd)
ifTrue:
[rcvrAddress - objectMemory wordSize to: theSP + objectMemory wordSize by: objectMemory wordSize negated do:
[:addr| | index |
index := rcvrAddress - addr / objectMemory wordSize + numArgs.
index <= numTemps
ifTrue: [self printFrameOop: 'temp' index: index - 1 at: addr]
ifFalse: [self printFrameOop: ((self frameIsBlockActivation: theFP)
ifTrue: ['temp/stck']
ifFalse: ['stck'])
at: addr]].
self printFrameThing: 'frame ip'
at: theSP
extra: ((self isMachineCodeFrame: theFP)
ifTrue: [topThing - theMethod]
ifFalse: [topThing - theMethod + 2 - objectMemory baseHeaderSize])]
ifFalse:
[rcvrAddress - objectMemory wordSize to: theSP by: objectMemory wordSize negated do:
[:addr| | index |
index := rcvrAddress - addr / objectMemory wordSize + numArgs.
index <= numTemps
ifTrue: [self printFrameOop: 'temp' index: index - 1 at: addr]
ifFalse: [self printFrameOop: ((self frameIsBlockActivation: theFP)
ifTrue: ['temp/stck']
ifFalse: ['stck'])
at: addr]]]!

Item was changed:
----- Method: CoInterpreter>>printMethodCacheFor: (in category 'debug printing') -----
printMethodCacheFor: thing
+ <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"
- <api>
| n |
n := 0.
0 to: MethodCacheSize - 1 by: MethodCacheEntrySize do:
[:i | | s c m p |
s := methodCache at: i + MethodCacheSelector.
c := methodCache at: i + MethodCacheClass.
m := methodCache at: i + MethodCacheMethod.
p := methodCache at: i + MethodCachePrimFunction.
((thing = -1 or: [s = thing or: [c = thing or: [p = thing or: [m = thing
or: [(objectMemory addressCouldBeObj: m)
and: [(self maybeMethodHasCogMethod: m)
and: [(self cogMethodOf: m) asInteger = thing]]]]]]])
and: [(objectMemory addressCouldBeOop: s)
and: [c ~= 0
and: [(self addressCouldBeClassObj: c)
or: [self addressCouldBeClassObj: (objectMemory classForClassTag: c)]]]]) ifTrue:
[n := n + 1.
self cCode: [] inSmalltalk: [self transcript ensureCr].
self printNum: i; space; printHexnp: i; cr; tab.
(objectMemory isBytesNonImm: s)
ifTrue: [self cCode: 'printf("%" PRIxSQPTR " %.*s\n", s, (int)(numBytesOf(s)), (char *)firstIndexableField(s))'
inSmalltalk: [self printHex: s; space; print: (self stringOf: s); cr]]
ifFalse: [self shortPrintOop: s].
self tab.
(self addressCouldBeClassObj: c)
ifTrue: [self shortPrintOop: c]
ifFalse: [self printNum: c; space; printHexnp: c; space; shortPrintOop: (objectMemory classForClassTag: c)].
self tab; shortPrintOop: m; tab.
self cCode:
[p > 1024
ifTrue: [self printHexnp: p]
ifFalse: [self printNum: p]]
inSmalltalk:
[p isSymbol ifTrue: [self print: p] ifFalse: [self printNum: p]].
self cr]].
n > 1 ifTrue:
[self printNum: n; cr]!

Item was changed:
----- Method: CogMethodZone>>whereIsMaybeCodeThing: (in category 'debug printing') -----
whereIsMaybeCodeThing: anOop
+ <export: true> "useful for VM debugging; use export: not api, so it will be accessible on win32"
+ <returnTypeC: #'char *'>
- <api>
- <returnTypeC: 'char *'>
(self oop: anOop isGreaterThanOrEqualTo: cogit cogCodeBase andLessThan: limitAddress) ifTrue:
[(self oop: anOop isLessThan: cogit minCogMethodAddress) ifTrue:
[^' is in generated runtime'].
(self oop: anOop isLessThan: mzFreeStart) ifTrue:
[^' is in generated methods'].
(self oop: anOop isLessThan: youngReferrers) ifTrue:
[^' is in code zone'].
^' is in young referrers'].
^nil!

Item was changed:
----- Method: NewObjectMemory>>longPrintReferencesTo: (in category 'debug printing') -----
longPrintReferencesTo: anOop
"Scan the heap long printing the oops of any and all objects that refer to anOop"
+ <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"
| oop i prntObj |
- <api>
prntObj := false.
oop := self firstAccessibleObject.
[oop = nil] whileFalse:
[((self isPointersNonImm: oop) or: [self isCompiledMethod: oop]) ifTrue:
[(self isCompiledMethod: oop)
ifTrue:
[i := (self literalCountOf: oop) + LiteralStart]
ifFalse:
[(self isContextNonImm: oop)
ifTrue: [i := CtxtTempFrameStart + (coInterpreter fetchStackPointerOf: oop)]
ifFalse: [i := self lengthOf: oop]].
[(i := i - 1) >= 0] whileTrue:
[anOop = (self fetchPointer: i ofObject: oop) ifTrue:
[self printHex: oop; print: ' @ '; printNum: i; cr.
prntObj := true.
i := 0]].
prntObj ifTrue:
[prntObj := false.
coInterpreter longPrintOop: oop]].
oop := self accessibleObjectAfter: oop]!

Item was changed:
----- Method: NewObjectMemory>>printActivationsOf: (in category 'debug printing') -----
printActivationsOf: aMethodObj
"Scan the heap printing the oops of any and all contexts that refer to anOop"
+ <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"
| oop |
- <api>
oop := self firstAccessibleObject.
[oop = nil] whileFalse:
[((self isContextNonImm: oop)
and: [aMethodObj = (self fetchPointer: MethodIndex ofObject: oop)]) ifTrue:
[coInterpreter
printHex: oop; space; printOopShort: oop; print: ' pc ';
printHex: (self fetchPointer: InstructionPointerIndex ofObject: oop); cr].
oop := self accessibleObjectAfter: oop]!

Item was changed:
----- Method: NewObjectMemory>>printContextReferencesTo: (in category 'debug printing') -----
printContextReferencesTo: anOop
"Scan the heap printing the oops of any and all contexts that refer to anOop"
+ <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"
| oop i |
- <api>
oop := self firstAccessibleObject.
[oop = nil] whileFalse:
[(self isContextNonImm: oop) ifTrue:
[i := CtxtTempFrameStart + (coInterpreter fetchStackPointerOf: oop)].
[(i := i - 1) >= 0] whileTrue:
[anOop = (self fetchPointer: i ofObject: oop) ifTrue:
[coInterpreter
printHex: oop; print: ' @ '; printNum: i; space; printOopShort: oop;
print: ' pc '; printHex: (self fetchPointer: InstructionPointerIndex ofObject: oop); cr.
i := 0]].
oop := self accessibleObjectAfter: oop]!

Item was changed:
----- Method: NewObjectMemory>>printObjectsFrom:to: (in category 'debug printing') -----
printObjectsFrom: startAddress to: endAddress
+ <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"
- <api>
| oop |
oop := startAddress.
[self oop: oop isLessThan: endAddress] whileTrue:
[(self isFreeObject: oop) ifFalse:
[coInterpreter printOop: oop].
oop := self objectAfter: oop].!

Item was changed:
----- Method: NewObjectMemory>>printReferencesTo: (in category 'debug printing') -----
printReferencesTo: anOop
"Scan the heap printing the oops of any and all objects that refer to anOop"
+ <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"
| oop i |
- <api>
oop := self firstAccessibleObject.
[oop = nil] whileFalse:
[((self isPointersNonImm: oop) or: [self isCompiledMethod: oop]) ifTrue:
[(self isCompiledMethod: oop)
ifTrue:
[i := (self literalCountOf: oop) + LiteralStart]
ifFalse:
[(self isContextNonImm: oop)
ifTrue: [i := CtxtTempFrameStart + (coInterpreter fetchStackPointerOf: oop)]
ifFalse: [i := self lengthOf: oop]].
[(i := i - 1) >= 0] whileTrue:
[anOop = (self fetchPointer: i ofObject: oop) ifTrue:
[coInterpreter printHex: oop; print: ' @ '; printNum: i; space; printOopShort: oop; cr.
i := 0]]].
oop := self accessibleObjectAfter: oop]!

Item was changed:
----- Method: NewObjectMemory>>printWronglySizedContexts: (in category 'debug printing') -----
printWronglySizedContexts: printContexts
"Scan the heap printing the oops of any and all contexts whose size is not either SmallContextSize or LargeContextSize"
+ <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"
| oop |
- <api>
oop := self firstAccessibleObject.
[oop = nil] whileFalse:
[((self isContextNonImm: oop)
and: [self badContextSize: oop]) ifTrue:
[self printHex: oop; space; printNum: (self numBytesOf: oop); cr.
printContexts ifTrue:
[coInterpreter printContext: oop]].
oop := self accessibleObjectAfter: oop]!

Item was changed:
----- Method: ObjectMemory>>longPrintInstancesOf: (in category 'debug printing') -----
longPrintInstancesOf: aClassOop
"Scan the heap printing the oops of any and all objects that are instances of aClassOop"
+ <export: true> "useful for VM debugging; use export: not api, so it will be accessible on win32"
| oop |
- <api>
oop := self firstAccessibleObject.
[oop = nil] whileFalse:
[(self fetchClassOfNonImm: oop) = aClassOop ifTrue:
[self longPrintOop: oop; cr].
oop := self accessibleObjectAfter: oop]!

Item was changed:
----- Method: ObjectMemory>>printActivationsOf: (in category 'debug printing') -----
printActivationsOf: aMethodObj
"Scan the heap printing the oops of any and all contexts that refer to anOop"
+ <export: true> "useful for VM debugging; use export: not api, so it will be accessible on win32"
| oop |
- <api>
oop := self firstAccessibleObject.
[oop = nil] whileFalse:
[((self isContextNonImm: oop)
and: [aMethodObj = (self fetchPointer: MethodIndex ofObject: oop)]) ifTrue:
[self interpreter
printHex: oop; space; printOopShort: oop; print: ' pc ';
printHex: (self fetchPointer: InstructionPointerIndex ofObject: oop); cr].
oop := self accessibleObjectAfter: oop]!

Item was changed:
----- Method: ObjectMemory>>printContextReferencesTo: (in category 'debug printing') -----
printContextReferencesTo: anOop
"Scan the heap printing the oops of any and all contexts that refer to anOop"
+ <export: true> "useful for VM debugging; use export: not api, so it will be accessible on win32"
| oop i |
- <api>
oop := self firstAccessibleObject.
[oop = nil] whileFalse:
[(self isContextNonImm: oop) ifTrue:
[i := CtxtTempFrameStart + (self fetchStackPointerOf: oop)].
[(i := i - 1) >= 0] whileTrue:
[anOop = (self fetchPointer: i ofObject: oop) ifTrue:
[self interpreter printHex: oop; print: ' @ '; printNum: i; space; printOopShort: oop; cr.
i := 0]].
oop := self accessibleObjectAfter: oop]!

Item was changed:
----- Method: ObjectMemory>>printInstancesOf: (in category 'debug printing') -----
printInstancesOf: aClassOop
"Scan the heap printing the oops of any and all objects that are instances of aClassOop"
+ <export: true> "useful for VM debugging; use export: not api, so it will be accessible on win32"
| oop |
- <api>
oop := self firstAccessibleObject.
[oop = nil] whileFalse:
[(self fetchClassOfNonImm: oop) = aClassOop ifTrue:
[self printHex: oop; cr].
oop := self accessibleObjectAfter: oop]!

Item was changed:
----- Method: ObjectMemory>>printMethodImplementorsOf: (in category 'debug printing') -----
printMethodImplementorsOf: anOop
"Scan the heap printing the oops of any and all methods that implement anOop"
+ <export: true> "useful for VM debugging; use export: not api, so it will be accessible on win32"
- <api>
| obj |
obj := self firstAccessibleObject.
[obj = nil] whileFalse:
[((self isCompiledMethod: obj)
and: [(self maybeSelectorOfMethod: obj) = anOop]) ifTrue:
[self printHex: obj; space; printOopShort: obj; cr]]!

Item was changed:
----- Method: ObjectMemory>>printMethodReferencesTo: (in category 'debug printing') -----
printMethodReferencesTo: anOop
"Scan the heap printing the oops of any and all objects that refer to anOop"
+ <export: true> "useful for VM debugging; use export: not api, so it will be accessible on win32"
| oop i |
- <api>
oop := self firstAccessibleObject.
[oop = nil] whileFalse:
[(self isCompiledMethod: oop) ifTrue:
[i := (self literalCountOf: oop) + LiteralStart - 1.
[i >= 0] whileTrue:
[anOop = (self fetchPointer: i ofObject: oop) ifTrue:
[self printHex: oop; print: ' @ '; printNum: i; cr.
i := 0].
i := i - 1]].
oop := self accessibleObjectAfter: oop]!

Item was changed:
----- Method: ObjectMemory>>printReferencesTo: (in category 'debug printing') -----
printReferencesTo: anOop
"Scan the heap printing the oops of any and all objects that refer to anOop"
+ <export: true> "useful for VM debugging; use export: not api, so it will be accessible on win32"
| oop i |
- <api>
oop := self firstAccessibleObject.
[oop = nil] whileFalse:
[((self isPointersNonImm: oop) or: [self isCompiledMethod: oop]) ifTrue:
[(self isCompiledMethod: oop)
ifTrue:
[i := (self literalCountOf: oop) + LiteralStart]
ifFalse:
[(self isContextNonImm: oop)
ifTrue: [i := CtxtTempFrameStart + (self fetchStackPointerOf: oop)]
ifFalse: [i := self lengthOf: oop]].
[(i := i - 1) >= 0] whileTrue:
[anOop = (self fetchPointer: i ofObject: oop) ifTrue:
[self interpreter printHex: oop; print: ' @ '; printNum: i; space; printOopShort: oop; cr.
i := 0]]].
oop := self accessibleObjectAfter: oop]!

Item was changed:
----- Method: ObjectMemory>>printWronglySizedContexts (in category 'debug printing') -----
printWronglySizedContexts
"Scan the heap printing the oops of any and all contexts whose size is not either SmallContextSize or LargeContextSize"
+ <export: true> "useful for VM debugging; use export: not api, so it will be accessible on win32"
| oop |
- <api>
oop := self firstAccessibleObject.
[oop = nil] whileFalse:
[((self isContextNonImm: oop)
and: [self badContextSize: oop]) ifTrue:
[self printHex: oop; space; printNum: (self numBytesOf: oop); cr].
oop := self accessibleObjectAfter: oop]!

Item was changed:
----- Method: SpurMemoryManager>>inOrderPrintFreeTree:printList: (in category 'debug printing') -----
inOrderPrintFreeTree: freeChunk printList: printNextList
"print free chunks in freeTree in order."
+ <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"
- <api>
| next |
(next := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: freeChunk) ~= 0 ifTrue:
[self inOrderPrintFreeTree: next printList: printNextList].
self printFreeChunk: freeChunk printAsTreeNode: true.
printNextList ifTrue:
[next := freeChunk.
[(next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: next) ~= 0] whileTrue:
[coInterpreter tab.
self printFreeChunk: next printAsTreeNode: false]].
(next := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: freeChunk) ~= 0 ifTrue:
[self inOrderPrintFreeTree: next printList: printNextList]!

Item was changed:
----- Method: SpurMemoryManager>>longPrintInstancesOf: (in category 'debug printing') -----
longPrintInstancesOf: aClassOop
"Scan the heap printing the oops of any and all objects that are instances of aClassOop"
+ <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"
- <api>
| classIndex |
classIndex := self rawHashBitsOf: aClassOop.
classIndex ~= self isFreeObjectClassIndexPun ifTrue:
[self longPrintInstancesWithClassIndex: classIndex]!

Item was changed:
----- Method: SpurMemoryManager>>longPrintInstancesWithClassIndex: (in category 'debug printing') -----
longPrintInstancesWithClassIndex: classIndex
"Scan the heap printing any and all objects whose classIndex equals the argument."
+ <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"
- <api>
<inline: false>
self allHeapEntitiesDo:
[:obj|
(self classIndexOf: obj) = classIndex ifTrue:
[coInterpreter longPrintOop: obj; cr]]!

Item was changed:
----- 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"
+ <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"
| prntObj |
- <api>
prntObj := false.
self allObjectsDo:
[:obj| | i |
((self isPointersNonImm: obj) or: [self isCompiledMethod: obj]) ifTrue:
[(self isCompiledMethod: obj)
ifTrue:
[i := (self 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 changed:
----- Method: SpurMemoryManager>>printActivationsOf: (in category 'debug printing') -----
printActivationsOf: aMethodObj
"Scan the heap printing the oops of any and all contexts that refer to anOop"
+ <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"
- <api>
self allObjectsDo:
[:obj|
((self isContextNonImm: obj)
and: [aMethodObj = (self fetchPointer: MethodIndex ofObject: obj)]) ifTrue:
[coInterpreter
printHex: obj; space; printOopShort: obj; print: ' pc ';
printHex: (self fetchPointer: InstructionPointerIndex ofObject: obj); cr]]!

Item was changed:
----- Method: SpurMemoryManager>>printBogons (in category 'debug printing') -----
printBogons
+ <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"
- <api>
compactor printTheBogons: bogon!

Item was changed:
----- Method: SpurMemoryManager>>printContextReferencesTo: (in category 'debug printing') -----
printContextReferencesTo: anOop
"Scan the heap printing the oops of any and all contexts that refer to anOop"
+ <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"
- <api>
self allObjectsDo:
[:obj| | i |
(self isContextNonImm: obj) ifTrue:
[i := CtxtTempFrameStart + (coInterpreter fetchStackPointerOf: obj).
[(i := i - 1) >= 0] whileTrue:
[anOop = (self fetchPointer: i ofObject: obj) ifTrue:
[coInterpreter
printHex: obj; print: ' @ '; printNum: i; space; printOopShort: obj;
print: ' pc '; printHex: (self fetchPointer: InstructionPointerIndex ofObject: obj); cr.
i := 0]]]]!

Item was changed:
----- Method: SpurMemoryManager>>printEntity: (in category 'debug printing') -----
printEntity: oop
+ <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"
- <api>
| printFlags |
printFlags := false.
coInterpreter printHex: oop; space.
(self addressCouldBeObj: oop) ifFalse:
[^coInterpreter print: ((self isImmediate: oop) ifTrue: ['immediate'] ifFalse: ['unknown'])].
coInterpreter
print: ((self isFreeObject: oop) ifTrue: ['free'] ifFalse:
[(self isSegmentBridge: oop) ifTrue: ['bridge'] ifFalse:
[(self isForwarded: oop) ifTrue: ['forwarder'] ifFalse:
[(self classIndexOf: oop) <= self lastClassIndexPun ifTrue: [printFlags := true. 'pun/obj stack'] ifFalse:
[printFlags := true. 'object']]]]);
space; printHexnpnp: (self rawNumSlotsOf: oop); print: '/'; printHexnpnp: (self bytesInObject: oop); print: '/'; printNum: (self bytesInObject: oop).
printFlags ifTrue:
[coInterpreter
space;
print: ((self formatOf: oop) <= 16rF ifTrue: ['f:0'] ifFalse: ['f:']);
printHexnpnp: (self formatOf: oop);
print: ((self isGrey: oop) ifTrue: [' g'] ifFalse: [' .']);
print: ((self isImmutable: oop) ifTrue: ['i'] ifFalse: ['.']);
print: ((self isMarked: oop) ifTrue: ['m'] ifFalse: ['.']);
print: ((self isPinned: oop) ifTrue: ['p'] ifFalse: ['.']);
print: ((self isRemembered: oop) ifTrue: ['r'] ifFalse: ['.'])].
coInterpreter cr!

Item was changed:
----- Method: SpurMemoryManager>>printForwarders (in category 'debug printing') -----
printForwarders
+ <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"
- <api>
self allHeapEntitiesDo:
[:objOop|
(self isUnambiguouslyForwarder: objOop) ifTrue:
[coInterpreter printHex: objOop; cr]]!

Item was changed:
----- Method: SpurMemoryManager>>printFreeChunk: (in category 'debug printing') -----
printFreeChunk: freeChunk
+ <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"
- <api>
self printFreeChunk: freeChunk printAsTreeNode: true!

Item was changed:
----- Method: SpurMemoryManager>>printFreeList: (in category 'debug printing') -----
printFreeList: chunkOrIndex
+ <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"
- <api>
| freeChunk |
(chunkOrIndex >= 0 and: [chunkOrIndex < self numFreeLists]) ifTrue:
[^self printFreeList: (freeLists at: chunkOrIndex)].
freeChunk := chunkOrIndex.
[freeChunk ~= 0] whileTrue:
[self printFreeChunk: freeChunk.
freeChunk := self fetchPointer: self freeChunkNextIndex ofFreeChunk: freeChunk]!

Item was changed:
----- Method: SpurMemoryManager>>printFreeListHeads (in category 'debug printing') -----
printFreeListHeads
+ <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"
- <api>
| expectedMask |
expectedMask := 0.
0 to: self numFreeLists - 1 do:
[:i|
coInterpreter printHex: (freeLists at: i).
(freeLists at: i) ~= 0 ifTrue:
[expectedMask := expectedMask + (1 << i)].
i + 1 \\ (32 >> self logBytesPerOop) = 0
ifTrue: [coInterpreter cr]
ifFalse: [coInterpreter print: ' ']].
coInterpreter
cr;
print: 'mask: '; printHexnp: freeListsMask;
print: ' expected: '; printHexnp: expectedMask;
cr!

Item was changed:
----- Method: SpurMemoryManager>>printFreeTree (in category 'debug printing') -----
printFreeTree
+ <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"
- <api>
self printFreeTreeChunk: (freeLists at: 0)!

Item was changed:
----- Method: SpurMemoryManager>>printHeaderOf: (in category 'debug printing') -----
printHeaderOf: objOop
+ <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"
- <api>
"N.B. No safety bounds checks!!!! We need to look e.g. at corpses."
coInterpreter printHexnp: objOop.
(self numSlotsOfAny: objOop) >= self numSlotsMask
ifTrue: [coInterpreter
print: ' hdr16 slotf '; printHexnp: (self numSlotsOfAny: objOop - self allocationUnit);
print: ' slotc '; printHexnp: (self rawOverflowSlotsOf: objOop); space]
ifFalse: [coInterpreter print: ' hdr8 slots '; printHexnp: (self numSlotsOfAny: objOop)].
coInterpreter
space;
printChar: ((self isMarked: objOop) ifTrue: [$M] ifFalse: [$m]);
printChar: ((self isGrey: objOop) ifTrue: [$G] ifFalse: [$g]);
printChar: ((self isPinned: objOop) ifTrue: [$P] ifFalse: [$p]);
printChar: ((self isRemembered: objOop) ifTrue: [$R] ifFalse: [$r]);
printChar: ((self isImmutable: objOop) ifTrue: [$I] ifFalse: [$i]);
print: ' hash '; printHexnp: (self rawHashBitsOf: objOop);
print: ' fmt '; printHexnp: (self formatOf: objOop);
print: ' cidx '; printHexnp: (self classIndexOf: objOop);
cr!

Item was changed:
----- Method: SpurMemoryManager>>printInstancesOf: (in category 'debug printing') -----
printInstancesOf: aClassOop
"Scan the heap printing the oops of any and all objects that are instances of aClassOop"
+ <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"
- <api>
| classIndex |
classIndex := self rawHashBitsOf: aClassOop.
classIndex ~= self isFreeObjectClassIndexPun ifTrue:
[self printInstancesWithClassIndex: classIndex]!

Item was changed:
----- Method: SpurMemoryManager>>printInstancesWithClassIndex: (in category 'debug printing') -----
printInstancesWithClassIndex: classIndex
"Scan the heap printing the oops of any and all objects whose classIndex equals the argument."
+ <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"
- <api>
<inline: false>
self allHeapEntitiesDo:
[:obj|
(self classIndexOf: obj) = classIndex ifTrue:
[coInterpreter printHex: obj; cr]]!

Item was changed:
----- Method: SpurMemoryManager>>printMarkedOops (in category 'debug printing') -----
printMarkedOops
+ <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"
- <api>
<option: #LLDB>
self printOopsSuchThat: #isMarked!

Item was changed:
----- Method: SpurMemoryManager>>printMethodImplementorsOf: (in category 'debug printing') -----
printMethodImplementorsOf: anOop
"Scan the heap printing the oops of any and all methods that implement anOop"
+ <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"
- <api>
self allObjectsDo:
[:obj|
((self isCompiledMethod: obj)
and: [(coInterpreter maybeSelectorOfMethod: obj) = anOop]) ifTrue:
[coInterpreter printHex: obj; space; printOopShort: obj; cr]]!

Item was changed:
----- Method: SpurMemoryManager>>printMethodReferencesTo: (in category 'debug printing') -----
printMethodReferencesTo: anOop
"Scan the heap printing the oops of any and all methods that refer to anOop"
+ <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"
- <api>
self allObjectsDo:
[:obj| | i |
(self isCompiledMethod: obj) ifTrue:
[i := (self literalCountOf: obj) + LiteralStart - 1.
[(i := i - 1) >= 0] whileTrue:
[anOop = (self fetchPointer: i ofObject: obj) ifTrue:
[coInterpreter printHex: obj; print: ' @ '; printNum: i; space; printOopShort: obj; cr.
i := 0]]]]!

Item was changed:
----- Method: SpurMemoryManager>>printObjectsFrom:to: (in category 'debug printing') -----
printObjectsFrom: startAddress to: endAddress
+ <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"
- <api>
| oop |
oop := self objectBefore: startAddress.
oop := oop
ifNil: [startAddress]
ifNotNil: [(self objectAfter: oop) = startAddress
ifTrue: [startAddress]
ifFalse: [oop]].
[self oop: oop isLessThan: endAddress] whileTrue:
[((self isFreeObject: oop)
or: [self isSegmentBridge: oop]) ifFalse:
[coInterpreter printOop: oop].
oop := self objectAfter: oop]!

Item was changed:
----- Method: SpurMemoryManager>>printObjectsWithHash: (in category 'debug printing') -----
printObjectsWithHash: hash
"Scan the heap printing the oops of any and all objects whose hash equals the argument."
+ <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"
- <api>
self allHeapEntitiesDo:
[:obj|
(self rawHashBitsOf: obj) = hash ifTrue:
[coInterpreter shortPrintOop: obj; cr]]!

Item was changed:
----- Method: SpurMemoryManager>>printOopsExcept: (in category 'debug printing') -----
printOopsExcept: function
+ <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"
- <api>
<var: #function declareC: 'sqInt (*function)(sqInt)'>
<inline: #never>
| n |
n := 0.
self allHeapEntitiesDo:
[:o|
(self perform: function with: o) ifFalse:
[n := n + 1.
self printEntity: o]].
n > 4 ifTrue: "rabbits"
[self printNum: n; print: ' objects'; cr]!

Item was changed:
----- Method: SpurMemoryManager>>printOopsFrom:to: (in category 'debug printing') -----
printOopsFrom: startAddress to: endAddress
+ <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"
- <api>
| oop limit firstNonEntity inEmptySpace lastNonEntity |
oop := self objectBefore: startAddress.
limit := endAddress asUnsignedIntegerPtr min: endOfMemory.
oop := oop
ifNil: [startAddress]
ifNotNil: [(self objectAfter: oop) = startAddress
ifTrue: [startAddress]
ifFalse: [oop]].
inEmptySpace := false.
[self oop: oop isLessThan: limit] whileTrue:
[self printEntity: oop.
[oop := self objectAfter: oop.
(self long64At: oop) = 0] whileTrue:
[inEmptySpace ifFalse:
[inEmptySpace := true.
firstNonEntity := oop].
lastNonEntity := oop].
inEmptySpace ifTrue:
[inEmptySpace := false.
coInterpreter
print: 'skipped empty space from '; printHexPtrnp: firstNonEntity;
print:' to '; printHexPtrnp: lastNonEntity; cr.
oop := self objectStartingAt: oop]]!

Item was changed:
----- Method: SpurMemoryManager>>printOopsSuchThat: (in category 'debug printing') -----
printOopsSuchThat: function
+ <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"
- <api>
<var: #function declareC: 'sqInt (*function)(sqInt)'>
<inline: #never>
| n |
n := 0.
self allHeapEntitiesDo:
[:o|
(self perform: function with: o) ifTrue:
[n := n + 1.
self printEntity: o]].
n > 4 ifTrue: "rabbits"
[self printNum: n; print: ' objects'; cr]!

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"
+ <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"
- <api>
self allObjectsDo:
[:obj| | i |
i := self numPointerSlotsOf: obj.
[(i := i - 1) >= 0] whileTrue:
[anOop = (self fetchPointer: i ofMaybeForwardedObject: obj) ifTrue:
[coInterpreter printHex: obj; print: ' @ '; printNum: i; space; printOopShort: obj; cr.
i := 0]]]!

Item was changed:
----- Method: SpurMemoryManager>>printUnmarkedOops (in category 'debug printing') -----
printUnmarkedOops
+ <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"
- <api>
<option: #LLDB>
self printOopsExcept: #isMarked!

Item was changed:
----- Method: SpurMemoryManager>>shortPrintObjectsFrom:to: (in category 'debug printing') -----
shortPrintObjectsFrom: startAddress to: endAddress
+ <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"
- <api>
| oop |
oop := self objectBefore: startAddress.
oop := oop
ifNil: [startAddress]
ifNotNil: [(self objectAfter: oop) = startAddress
ifTrue: [startAddress]
ifFalse: [oop]].
[self oop: oop isLessThan: endAddress] whileTrue:
[(self isFreeObject: oop) ifFalse:
[coInterpreter shortPrintOop: oop].
oop := self objectAfter: oop]!

Item was changed:
----- Method: StackInterpreter class>>requiredMethodNames: (in category 'translation') -----
requiredMethodNames: options
"Answer the list of method names that should be retained for export or other support reasons"
| requiredList |
"A number of methods required by VM support code, specific platforms, etc"
requiredList := #(
assertValidExecutionPointe:r:s:
characterForAscii:
findClassOfMethod:forReceiver: findSelectorOfMethod:
forceInterruptCheck forceInterruptCheckFromHeartbeat fullDisplayUpdate
getCurrentBytecode getFullScreenFlag getInterruptKeycode getInterruptPending
getSavedWindowSize getThisSessionID
interpret
loadInitialContext
primitiveFail primitiveFailFor: primitiveFlushExternalPrimitives printAllStacks printCallStack printContext:
+ printExternalHeadFrame printFramesInPage: printFrame: printMemory printOop:
- printExternalHeadFrame printFramesInPage: printFrame: printHeadFrame printMemory printOop:
printStackPages printStackPageList printStackPagesInUse printStackPageListInUse
readImageFromFile:HeapSize:StartingAt:
setFullScreenFlag: setInterruptKeycode: setInterruptPending: setInterruptCheckChain:
setSavedWindowSize: success:
validInstructionPointer:inMethod:framePointer:) asSet.

"Nice to actually have all the primitives available"
requiredList addAll: (self primitiveTable select: [:each| each isSymbol]).

"InterpreterProxy is the internal analogue of sqVirtualMachine.c, so make sure to keep all those"
InterpreterProxy organization categories do:
[:cat |
((cat ~= 'initialize') and: [cat ~= 'private']) ifTrue:
[requiredList addAll: (InterpreterProxy organization listAtCategoryNamed: cat)]].

^requiredList!

Item was changed:
----- Method: StackInterpreter>>activeProcess (in category 'process primitive support') -----
activeProcess
"Answer the current activeProcess."
+ <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"
- <api> "useful for VM debugging"
^objectMemory fetchPointer: ActiveProcessIndex ofObject: self schedulerPointer!

Item was changed:
----- Method: StackInterpreter>>checkAllAccessibleObjectsOkay (in category 'debug support') -----
checkAllAccessibleObjectsOkay
"Ensure that all accessible objects in the heap are okay."
+ <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"
- <api>
| ok |
ok := true.
objectMemory allObjectsDoSafely:
[:oop| ok := ok & (self checkOkayFields: oop)].
^ok!

Item was changed:
----- Method: StackInterpreter>>checkOkayInterpreterObjects: (in category 'debug support') -----
checkOkayInterpreterObjects: writeBack
+ <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"
- <api>
| ok oopOrZero oop |
ok := true.
ok := ok & (self checkOkayFields: objectMemory nilObject).
ok := ok & (self checkOkayFields: objectMemory falseObject).
ok := ok & (self checkOkayFields: objectMemory trueObject).
ok := ok & (self checkOkayFields: objectMemory specialObjectsOop).
ok := ok & (self checkOkayFields: messageSelector).
ok := ok & (self checkOkayFields: newMethod).
ok := ok & (self checkOkayFields: lkupClass).
0 to: MethodCacheEntries - 1 by: MethodCacheEntrySize do:
[ :i |
oopOrZero := methodCache at: i + MethodCacheSelector.
oopOrZero = 0 ifFalse:
[ok := ok & (self checkOkayFields: (methodCache at: i + MethodCacheSelector)).
objectMemory hasSpurMemoryManagerAPI ifFalse:
[ok := ok & (self checkOkayFields: (methodCache at: i + MethodCacheClass))].
ok := ok & (self checkOkayFields: (methodCache at: i + MethodCacheMethod))]].
1 to: objectMemory remapBufferCount do:
[ :i |
oop := objectMemory remapBuffer at: i.
(objectMemory isImmediate: oop) ifFalse:
[ok := ok & (self checkOkayFields: oop)]].
ok := ok & (self checkOkayStackZone: writeBack).
^ok!

Item was changed:
----- Method: StackInterpreter>>longPrintOop: (in category 'debug printing') -----
longPrintOop: oop
+ <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"
- <api>
| fmt lastIndex startIP bytecodesPerLine column |
<var: 'field16' type: #'unsigned short'>
<var: 'field32' type: #'unsigned int'>
<var: 'field64' type: #usqLong>
((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.
^self].
self printHex: oop.
(objectMemory fetchClassOfNonImm: oop)
ifNil: [self print: ' has a nil class!!!!']
ifNotNil: [:class|
self print: ': a(n) '; printNameOfClass: class count: 5;
print: ' ('.
objectMemory hasSpurMemoryManagerAPI ifTrue:
[self printHexnp: (objectMemory compactClassIndexOf: oop); print: '=>'].
self printHexnp: class; print: ')'].
fmt := objectMemory formatOf: oop.
self print: ' format '; printHexnp: fmt.
fmt > objectMemory lastPointerFormat
ifTrue: [self print: ' nbytes '; printNum: (objectMemory numBytesOf: oop)]
ifFalse: [(objectMemory isIndexableFormat: fmt) ifTrue:
[| len |
len := objectMemory lengthOf: oop.
self print: ' size '; printNum: len - (objectMemory fixedFieldsOf: oop format: fmt length: len)]].
objectMemory printHeaderTypeOf: oop.
self print: ' hash '; printHexnp: (objectMemory rawHashBitsOf: oop).
self cr.
(fmt between: objectMemory firstByteFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue:
[^self printStringOf: oop; cr].
(fmt between: objectMemory firstLongFormat and: objectMemory firstByteFormat - 1) ifTrue:
[0 to: ((objectMemory num32BitUnitsOf: oop) min: 256) - 1 do:
[:i| | field32 |
field32 := objectMemory fetchLong32: i ofObject: oop.
self space; printNum: i; space; printHex: field32; space; cr].
^self].
objectMemory hasSpurMemoryManagerAPI ifTrue:
[fmt = objectMemory sixtyFourBitIndexableFormat ifTrue:
[0 to: ((objectMemory num64BitUnitsOf: oop) min: 256) - 1 do:
[:i| | field64 |
field64 := objectMemory fetchLong64: i ofObject: oop.
self space; printNum: i; space; printHex: field64; space; cr].
^self].
(fmt between: objectMemory firstShortFormat and: objectMemory firstShortFormat + 1) ifTrue:
[0 to: ((objectMemory num16BitUnitsOf: oop) min: 256) - 1 do:
[:i| | field16 |
field16 := objectMemory fetchShort16: i ofObject: oop.
self space; printNum: i; space; printHex: field16; space; cr].
^self]].
"this is nonsense. apologies."
startIP := (objectMemory lastPointerOf: oop) + objectMemory bytesPerOop - objectMemory baseHeaderSize / objectMemory 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 cCode: [self printOopShort: fieldOop]
inSmalltalk: [self print: (self shortPrint: fieldOop)]].
self cr]].
(objectMemory isCompiledMethod: oop)
ifFalse:
[startIP > lastIndex ifTrue: [self print: '...'; cr]]
ifTrue:
[startIP := startIP * objectMemory wordSize + 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%08" PRIxSQPTR ": ", (usqIntptr_t)(oop+BaseHeaderSize+index-1))'
inSmalltalk: [self print: (oop+objectMemory baseHeaderSize+index-1) hex; print: ': ']].
byte := objectMemory fetchByte: index - 1 ofObject: oop.
self cCode: 'printf(" %02x/%-3d", (int)byte,(int)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>>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"
- <api>
| proc semaphoreClass mutexClass schedLists p processList |
<inline: false>
proc := self activeProcess.
self printNameOfClass: (objectMemory fetchClassOf: proc) count: 5; space; printHex: proc.
self print: ' priority '; printNum: (self quickFetchInteger: PriorityIndex ofObject: proc); cr.
self printCallStackFP: framePointer. "first the current activation"
schedLists := objectMemory fetchPointer: ProcessListsIndex ofObject: self schedulerPointer.
"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:
[self cr; print: 'processes at priority '; printNum: pri + 1.
self printProcsOnList: processList]].
self cr; print: 'suspended processes'.
semaphoreClass := objectMemory classSemaphore.
mutexClass := objectMemory classMutex.
objectMemory hasSpurMemoryManagerAPI
ifTrue:
[semaphoreClass := objectMemory compactIndexOfClass: semaphoreClass.
mutexClass := objectMemory compactIndexOfClass: mutexClass.
objectMemory allHeapEntitiesDo:
[:obj| | classIdx |
classIdx := objectMemory classIndexOf: obj.
(classIdx = semaphoreClass
or: [classIdx = mutexClass]) ifTrue:
[self printProcsOnList: obj]]]
ifFalse:
[objectMemory allObjectsDoSafely:
[:obj| | classObj |
classObj := objectMemory fetchClassOfNonImm: obj.
(classObj = semaphoreClass
or: [classObj = mutexClass]) ifTrue:
[self printProcsOnList: obj]]]!

Item was changed:
----- Method: StackInterpreter>>printCallStack (in category 'debug printing') -----
printCallStack
+ <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"
<inline: false>
framePointer = nil
ifTrue: [self printCallStackOf: (objectMemory fetchPointer: SuspendedContextIndex ofObject: self activeProcess)]
ifFalse: [self printCallStackFP: framePointer]!

Item was changed:
----- Method: StackInterpreter>>printCallStackOf: (in category 'debug printing') -----
printCallStackOf: aContextOrProcessOrFrame
+ <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"
- <api>
| context |
<inline: false>
(stackPages couldBeFramePointer: aContextOrProcessOrFrame) ifTrue:
[^self printCallStackFP: (self cCoerceSimple: aContextOrProcessOrFrame to: #'char *')].
aContextOrProcessOrFrame = self activeProcess ifTrue:
[^self printCallStackOf: (self cCode: [framePointer asInteger] inSmalltalk: [self headFramePointer])].
(self couldBeProcess: aContextOrProcessOrFrame) ifTrue:
[^self printCallStackOf: (objectMemory
fetchPointer: SuspendedContextIndex
ofObject: aContextOrProcessOrFrame)].
context := aContextOrProcessOrFrame.
[context = objectMemory nilObject] whileFalse:
[(self isMarriedOrWidowedContext: context)
ifTrue:
[(self checkIsStillMarriedContext: context currentFP: framePointer) ifFalse:
[self shortPrintContext: context.
^nil].
context := self shortReversePrintFrameAndCallers: (self frameOfMarriedContext: context)]
ifFalse:
[context := self printContextCallStackOf: context]]!

Item was changed:
----- Method: StackInterpreter>>printContext: (in category 'debug printing') -----
printContext: aContext
+ <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"
| sender ip sp |
<inline: false>
self shortPrintContext: aContext.
sender := objectMemory fetchPointer: SenderIndex ofObject: aContext.
ip := objectMemory fetchPointer: InstructionPointerIndex ofObject: aContext.
(objectMemory isIntegerObject: sender)
ifTrue:
[(self checkIsStillMarriedContext: aContext currentFP: framePointer)
ifTrue: [self print: 'married (assuming framePointer valid)'; cr]
ifFalse: [self print: 'widowed (assuming framePointer valid)'; cr].
self print: 'sender '; printNum: sender; print: ' (';
printHexPtr: (self withoutSmallIntegerTags: sender); printChar: $); cr.
self print: 'ip '; printNum: ip; print: ' (';
printHexPtr: (self withoutSmallIntegerTags: ip); printChar: $); cr]
ifFalse:
[self print: 'sender '; shortPrintOop: sender.
self print: 'ip '.
ip = objectMemory nilObject
ifTrue: [self shortPrintOop: ip]
ifFalse: [self printNum: ip; print: ' ('; printNum: (objectMemory integerValueOf: ip); space; printHex: (objectMemory integerValueOf: ip); printChar: $); cr]].
sp := objectMemory fetchPointer: StackPointerIndex ofObject: aContext.
self print: 'sp '; printNum: (objectMemory integerValueOf: sp); print: ' ('; printHex: sp; printChar: $); cr.
self print: 'method '; printMethodFieldForPrintContext: aContext.
self print: 'closure '; shortPrintOop: (objectMemory fetchPointer: ClosureIndex ofObject: aContext).
self print: 'receiver '; shortPrintOop: (objectMemory fetchPointer: ReceiverIndex ofObject: aContext).
sp := objectMemory integerValueOf: sp.
sp := sp min: (objectMemory lengthOf: aContext) - ReceiverIndex.
1 to: sp do:
[:i|
self print: ' '; printNum: i; space; shortPrintOop: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)]!

Item was changed:
----- Method: StackInterpreter>>printExternalHeadFrame (in category 'debug printing') -----
printExternalHeadFrame
+ <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"
<inline: false>
self printFrame: framePointer WithSP: stackPointer!

Item was changed:
----- Method: StackInterpreter>>printFrame: (in category 'debug printing') -----
printFrame: theFP
+ <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"
| thePage frameAbove theSP |
<inline: false>
<var: #theFP type: #'char *'>
<var: #theSP type: #'char *'>
<var: #frameAbove type: #'char *'>
<var: #thePage type: #'StackPage *'>
(stackPages couldBeFramePointer: theFP) ifFalse:
[((objectMemory addressCouldBeObj: theFP asInteger)
and: [(objectMemory isInMemory: theFP asInteger)
and: [(objectMemory isContextNonImm: theFP asInteger)
and: [(self checkIsStillMarriedContext: theFP asInteger currentFP: framePointer)]]]) ifTrue:
[^self printFrame: (self frameOfMarriedContext: theFP asInteger)].
self printHexPtr: theFP; print: ' is not in the stack zone?!!'; cr.
^nil].
frameAbove := nil.
theFP = framePointer
ifTrue: [theSP := stackPointer]
ifFalse:
[thePage := stackPages stackPageFor: theFP.
(stackPages isFree: thePage) ifTrue:
[self printHexPtr: theFP; print: ' is on a free page?!!'; cr.
^nil].
(thePage ~= stackPage
and: [theFP = thePage headFP])
ifTrue: [theSP := thePage headSP]
ifFalse:
[frameAbove := self safeFindFrameAbove: theFP
on: thePage
startingFrom: ((thePage = stackPage
and: [framePointer
between: thePage realStackLimit
and: thePage baseAddress])
ifTrue: [framePointer]
ifFalse: [thePage headFP]).
theSP := frameAbove ifNotNil:
[self frameCallerSP: frameAbove]]].
theSP ifNil:
[self print: 'could not find sp; using bogus value'; cr.
theSP := self frameReceiverLocation: theFP].
self printFrame: theFP WithSP: theSP.
frameAbove ifNotNil:
[self printFrameThing: 'frame pc' at: frameAbove + FoxCallerSavedIP]!

Item was changed:
----- Method: StackInterpreter>>printFrame:WithSP: (in category 'debug printing') -----
printFrame: theFP WithSP: theSP
+ <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"
- <api>
| theMethod numArgs topThing |
<inline: false>
<var: #theFP type: #'char *'>
<var: #theSP type: #'char *'>
<var: #addr type: #'char *'>
self cCode: '' inSmalltalk: [self transcript ensureCr].
(stackPages couldBeFramePointer: theFP) ifFalse:
[self printHexPtr: theFP; print: ' is not in the stack zone?!!'; cr.
^nil].
theMethod := self frameMethod: theFP.
numArgs := self frameNumArgs: theFP.
self shortPrintFrame: theFP.
self printFrameOop: 'rcvr/clsr'
at: theFP + FoxCallerSavedIP + ((numArgs + 1) * objectMemory wordSize).
numArgs to: 1 by: -1 do:
[:i| self printFrameOop: 'arg' at: theFP + FoxCallerSavedIP + (i * objectMemory wordSize)].
self printFrameThing: 'cllr ip/ctxt' at: theFP + FoxCallerSavedIP.
self printFrameThing: 'saved fp' at: theFP + FoxSavedFP.
self printFrameOop: 'method' at: theFP + FoxMethod.
self printFrameFlagsForFP: theFP.
self printFrameThing: 'context' at: theFP + FoxThisContext.
self printFrameOop: 'receiver' at: theFP + FoxReceiver.
topThing := stackPages longAt: theSP.
(topThing >= theMethod
and: [topThing <= (theMethod + (objectMemory sizeBitsOfSafe: theMethod))])
ifTrue:
[theFP + FoxReceiver - objectMemory wordSize to: theSP + objectMemory wordSize by: objectMemory wordSize negated do:
[:addr|
self printFrameOop: 'temp/stck' at: addr].
self printFrameThing: 'frame ip' at: theSP]
ifFalse:
[theFP + FoxReceiver - objectMemory wordSize to: theSP by: objectMemory wordSize negated do:
[:addr|
self printFrameOop: 'temp/stck' at: addr]]!

Item was changed:
----- Method: StackInterpreter>>printLikelyImplementorsOfSelector: (in category 'debug printing') -----
printLikelyImplementorsOfSelector: selector
"Print all methods whose penultimate literal is either selector,
or an object whose first inst var is the method and whose
second is selector (e.g. an AdditionalMethodState)."
+ <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"
- <api>
objectMemory allObjectsDo:
[:obj| | methodClassAssociation |
((objectMemory isCompiledMethod: obj)
and: [(self maybeSelectorOfMethod: obj) = selector]) ifTrue:
["try and print the key of the method class association (the name of the implementing class)"
methodClassAssociation := self methodClassAssociationOf: obj.
self printHexnp: obj;
space;
printOopShortInner: (((objectMemory isPointers: methodClassAssociation)
and: [(objectMemory numSlotsOf: methodClassAssociation) >= 2])
ifTrue: [objectMemory fetchPointer: 0 ofObject: methodClassAssociation]
ifFalse: [methodClassAssociation]);
cr]]!

Item was changed:
----- Method: StackInterpreter>>printMethodCache (in category 'debug printing') -----
printMethodCache
+ <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"
- <api>
self printMethodCacheFor: -1!

Item was changed:
----- Method: StackInterpreter>>printMethodCacheFor: (in category 'debug printing') -----
printMethodCacheFor: thing
+ <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"
- <api>
| n |
n := 0.
0 to: MethodCacheSize - 1 by: MethodCacheEntrySize do:
[:i | | s c m p |
s := methodCache at: i + MethodCacheSelector.
c := methodCache at: i + MethodCacheClass.
m := methodCache at: i + MethodCacheMethod.
p := methodCache at: i + MethodCachePrimFunction.
((thing = -1 or: [s = thing or: [c = thing or: [p = thing or: [m = thing]]]])
and: [(objectMemory addressCouldBeOop: s)
and: [c ~= 0
and: [(self addressCouldBeClassObj: c)
or: [self addressCouldBeClassObj: (objectMemory classForClassTag: c)]]]]) ifTrue:
[self cCode: [] inSmalltalk: [self transcript ensureCr].
self printNum: i; space; printHexnp: i; cr; tab.
(objectMemory isBytesNonImm: s)
ifTrue: [self cCode: 'printf("%" PRIxSQPTR " %.*s\n", s, (int)(numBytesOf(s)), (char *)firstIndexableField(s))'
inSmalltalk: [self printHex: s; space; print: (self stringOf: s); cr]]
ifFalse: [self shortPrintOop: s].
self tab.
(self addressCouldBeClassObj: c)
ifTrue: [self shortPrintOop: c]
ifFalse: [self printNum: c; space; shortPrintOop: (objectMemory classForClassTag: c)].
self tab; shortPrintOop: m; tab.
self cCode:
[p > 1024
ifTrue: [self printHexnp: p]
ifFalse: [self printNum: p]]
inSmalltalk:
[p isSymbol ifTrue: [self print: p] ifFalse: [self printNum: p]].
self cr]].
n > 1 ifTrue:
[self printNum: n; cr]!

Item was changed:
----- Method: StackInterpreter>>printMethodDictionary: (in category 'debug printing') -----
printMethodDictionary: dictionary
+ <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"
- <api>
| methodArray |
methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: dictionary.
SelectorStart to: (objectMemory numSlotsOf: dictionary) - 1 do:
[:index | | selector meth |
selector := objectMemory fetchPointer: index ofObject: dictionary.
selector ~= objectMemory nilObject ifTrue:
[meth := objectMemory fetchPointer: index - SelectorStart ofObject: methodArray.
self
printOopShort: selector;
print: ' => ';
printOopShort: meth;
print: ' (';
printHex: selector;
print: ' => ';
printHex: meth;
putchar: $);
cr]]!

Item was changed:
----- Method: StackInterpreter>>printMethodDictionaryOf: (in category 'debug printing') -----
printMethodDictionaryOf: behavior
+ <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"
- <api>
self printMethodDictionary: (objectMemory fetchPointer: MethodDictionaryIndex ofObject: behavior)!

Item was changed:
----- Method: StackInterpreter>>printOop: (in category 'debug printing') -----
printOop: oop
+ <export: true> "use export: not api, so it won't be written to cointerp.h"
| cls fmt lastIndex startIP bytecodesPerLine column |
<inline: false>
(objectMemory isImmediate: oop) ifTrue:
[^self shortPrintOop: oop].
self printHex: oop.
(objectMemory addressCouldBeObj: oop) ifFalse:
[(oop bitAnd: objectMemory allocationUnit - 1) ~= 0 ifTrue: [^self print: ' is misaligned'; cr].
((objectMemory isInNewSpace: oop)
and: [objectMemory isForwarded: oop]) ifTrue:
[self printForwarder: oop].
^self print: (self whereIs: oop); cr].
(objectMemory isFreeObject: oop) ifTrue:
[self print: ' is a free chunk of size '; printNum: (objectMemory sizeOfFree: oop).
objectMemory hasSpurMemoryManagerAPI ifTrue:
[self print: ' 0th: '; printHex: (objectMemory fetchPointer: 0 ofFreeChunk: oop).
objectMemory printHeaderTypeOf: oop].
^self cr].
(objectMemory isForwarded: oop) ifTrue:
[^self printForwarder: oop].
self print: ': a(n) '.
self printNameOfClass: (cls := objectMemory fetchClassOfNonImm: oop) count: 5.
cls = (objectMemory splObj: ClassFloat) ifTrue:
[^self cr; printFloat: (objectMemory dbgFloatValueOf: oop); cr].
fmt := objectMemory formatOf: oop.
fmt > objectMemory lastPointerFormat ifTrue:
[self print: ' nbytes '; printNum: (objectMemory numBytesOf: oop)].
self cr.
(fmt between: objectMemory firstLongFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue:
["This will answer false if splObj: ClassAlien is nilObject"
(self is: oop KindOfClass: (objectMemory splObj: ClassAlien)) ifTrue:
[self print: ' datasize '; printNum: (objectMemory sizeFieldOfAlien: oop).
self print: ((self isIndirectAlien: oop)
ifTrue: [' indirect @ ']
ifFalse:
[(self isPointerAlien: oop)
ifTrue: [' pointer @ ']
ifFalse: [' direct @ ']]).
^self printHex: (self startOfAlienData: oop) asUnsignedInteger; cr].
(objectMemory isWordsNonImm: oop) ifTrue:
[lastIndex := 64 min: ((objectMemory numBytesOf: oop) / objectMemory wordSize).
lastIndex > 0 ifTrue:
[1 to: lastIndex do:
[:index|
self space; printHex: (self cCoerceSimple: (objectMemory fetchLong32: index - 1 ofObject: oop)
to: #'unsigned int').
(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
[self cr]].
(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
[self cr]].
^self].
^self printStringOf: oop; cr].
"this is nonsense. apologies."
startIP := (objectMemory lastPointerOf: oop) + objectMemory bytesPerOop - objectMemory baseHeaderSize / objectMemory bytesPerOop.
lastIndex := 256 min: startIP.
lastIndex > 0 ifTrue:
[1 to: lastIndex do:
[:index|
self cCode: [self printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space]
inSmalltalk: [self space; printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space.
self print: (self shortPrint: (objectMemory fetchPointer: index - 1 ofObject: oop))].
(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
[self cr]].
(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
[self cr]].
(objectMemory isCompiledMethod: oop)
ifFalse:
[startIP > 64 ifTrue: [self print: '...'; cr]]
ifTrue:
[startIP := startIP * objectMemory wordSize + 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%08" PRIxSQPTR ": ", (usqIntptr_t)(oop+BaseHeaderSize+index-1))'
inSmalltalk: [self print: (oop+objectMemory baseHeaderSize+index-1) hex; print: ': ']].
byte := objectMemory fetchByte: index - 1 ofObject: oop.
self cCode: 'printf(" %02x/%-3d", (int)byte,(int)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>>printProcessStack: (in category 'debug printing') -----
printProcessStack: aProcess
+ <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"
- <api>
<inline: false>
| ctx |
self cr; printNameOfClass: (objectMemory fetchClassOf: aProcess) count: 5; space; printHex: aProcess.
self print: ' priority '; printNum: (self quickFetchInteger: PriorityIndex ofObject: aProcess); cr.
ctx := objectMemory followField: SuspendedContextIndex ofObject: aProcess.
ctx = objectMemory nilObject ifFalse:
[self printCallStackOf: ctx currentFP: framePointer]!

Item was changed:
----- Method: StackInterpreter>>printProcsOnList: (in category 'debug printing') -----
printProcsOnList: procList
+ <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"
- <api>
<inline: false>
| proc firstProc |
proc := firstProc := objectMemory followField: FirstLinkIndex ofObject: procList.
[proc = objectMemory nilObject] whileFalse:
[self printProcessStack: proc.
proc := objectMemory followField: NextLinkIndex ofObject: proc.
proc = firstProc ifTrue:
[self warning: 'circular process list!!!!'.
^nil]]!

Item was changed:
----- Method: StackInterpreter>>printStackCallStackOf: (in category 'debug printing') -----
printStackCallStackOf: aContextOrProcessOrFrame
+ <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"
- <api>
| theFP context |
<var: #theFP type: #'char *'>
(self cCode: [false] "In the stack simulator, frame pointers are negative which upsets addressCouldBeObj:"
inSmalltalk: [stackPages couldBeFramePointer: aContextOrProcessOrFrame]) ifFalse:
[(objectMemory addressCouldBeObj: aContextOrProcessOrFrame) ifTrue:
[((objectMemory isContext: aContextOrProcessOrFrame)
and: [self checkIsStillMarriedContext: aContextOrProcessOrFrame currentFP: nil]) ifTrue:
[^self printStackCallStackOf: (self frameOfMarriedContext: aContextOrProcessOrFrame) asInteger].
aContextOrProcessOrFrame = self activeProcess ifTrue:
[^self printStackCallStackOf: (self cCode: [framePointer asInteger] inSmalltalk: [self headFramePointer])].
(self couldBeProcess: aContextOrProcessOrFrame) ifTrue:
[^self printCallStackOf: (objectMemory
fetchPointer: SuspendedContextIndex
ofObject: aContextOrProcessOrFrame)].
^nil]].

theFP := aContextOrProcessOrFrame asVoidPointer.
[context := self shortReversePrintFrameAndCallers: theFP.
((self isMarriedOrWidowedContext: context)
and:
[theFP := self frameOfMarriedContext: context.
self checkIsStillMarriedContext: context currentFP: theFP]) ifFalse:
[^nil]] repeat!

Item was changed:
----- Method: StackInterpreter>>printStackPageList (in category 'debug printing') -----
printStackPageList
+ <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"
| page |
<inline: false>
<var: #page type: #'StackPage *'>
page := stackPages mostRecentlyUsedPage.
[self printStackPage: page.
self cr.
(page := page prevPage) ~= stackPages mostRecentlyUsedPage] whileTrue!

Item was changed:
----- Method: StackInterpreter>>printStackPageListInUse (in category 'debug printing') -----
printStackPageListInUse
+ <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"
| page n |
<inline: false>
<var: #page type: #'StackPage *'>
page := stackPages mostRecentlyUsedPage.
n := 0.
[(stackPages isFree: page) ifFalse:
[self printStackPage: page useCount: (n := n + 1); cr].
(page := page prevPage) ~= stackPages mostRecentlyUsedPage] whileTrue!

Item was changed:
----- Method: StackInterpreter>>printStackPages (in category 'debug printing') -----
printStackPages
+ <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"
0 to: numStackPages - 1 do:
[:i|
self printStackPage: (stackPages stackPageAt: i).
self cr]!

Item was changed:
----- Method: StackInterpreter>>printStackPagesInUse (in category 'debug printing') -----
printStackPagesInUse
+ <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"
| n |
n := 0.
0 to: numStackPages - 1 do:
[:i|
(stackPages isFree: (stackPages stackPageAt: i)) ifFalse:
[self printStackPage: (stackPages stackPageAt: i) useCount: (n := n + 1); cr]]!

Item was changed:
----- Method: StackInterpreter>>printStackReferencesTo: (in category 'object memory support') -----
printStackReferencesTo: oop
+ <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"
- <api>
- <var: #thePage type: #'StackPage *'>
- <var: #theSP type: #'char *'>
- <var: #theFP type: #'char *'>
- <var: #callerFP type: #'char *'>
0 to: numStackPages - 1 do:
[:i| | thePage theSP theFP callerFP |
thePage := stackPages stackPageAt: i.
thePage isFree ifFalse:
[theSP := thePage headSP.
theFP := thePage headFP.
"Skip the instruction pointer on top of stack of inactive pages."
thePage = stackPage ifFalse:
[theSP := theSP + objectMemory wordSize].
[[theSP <= (self frameReceiverLocation: theFP)] whileTrue:
[oop = (stackPages longAt: theSP) ifTrue:
[self print: 'FP: '; printHexnp: theFP; print: ' @ '; printHexnp: theSP; cr].
theSP := theSP + objectMemory wordSize].
(self frameHasContext: theFP) ifTrue:
[oop = (self frameContext: theFP) ifTrue:
[self print: 'FP: '; printHexnp: theFP; print: ' CTXT'; cr]].
oop = (self frameMethod: theFP) ifTrue:
[self print: 'FP: '; printHexnp: theFP; print: ' MTHD'; cr].
(callerFP := self frameCallerFP: theFP) ~= 0]
whileTrue:
[theSP := (theFP + FoxCallerSavedIP) + objectMemory wordSize.
theFP := callerFP].
theSP := theFP + FoxCallerSavedIP. "a.k.a. FoxCallerContext"
[theSP <= thePage baseAddress] whileTrue:
[oop = (stackPages longAt: theSP) ifTrue:
[self print: 'FP: '; printHexnp: theFP; print: ' @ '; printHexnp: theSP; cr].
theSP := theSP + objectMemory wordSize]]]!

Item was changed:
----- Method: StackInterpreter>>setBreakMNUSelector: (in category 'debug support') -----
setBreakMNUSelector: aString
+ <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"
- <api>
<var: #aString type: #'char *'>
(breakSelector := aString)
ifNil: [breakSelectorLength := objectMemory minSmallInteger "nil's effective length is zero"]
ifNotNil: [breakSelectorLength := (self strlen: aString) negated]!

Item was changed:
----- Method: StackInterpreter>>setBreakSelector: (in category 'debug support') -----
setBreakSelector: aString
+ <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"
- <api>
<var: #aString type: #'char *'>
(breakSelector := aString)
ifNil: [breakSelectorLength := objectMemory minSmallInteger "nil's effective length is zero"]
ifNotNil: [breakSelectorLength := self strlen: aString]!

Item was changed:
----- Method: StackInterpreter>>shortPrintFrame:AndNCallers: (in category 'debug printing') -----
shortPrintFrame: theFP AndNCallers: n
+ <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"
- <api>
<inline: false>
<var: #theFP type: #'char *'>
(n ~= 0 and: [stackPages couldBeFramePointer: theFP]) ifTrue:
[self shortPrintFrame: theFP.
self shortPrintFrame: (self frameCallerFP: theFP) AndNCallers: n - 1]!

Item was changed:
----- Method: StackInterpreter>>whereIs: (in category 'debug printing') -----
whereIs: anOop
+ <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"
+ <returnTypeC: #'char *'>
- <api>
- <returnTypeC: 'char *'>
<inline: false>
<var: 'where' type: #'char *'>
(objectMemory whereIsMaybeHeapThing: anOop) ifNotNil: [:where| ^where].
(stackPages whereIsMaybeStackThing: anOop) ifNotNil: [:where| ^where].
^' is no where obvious'!