[Vm-dev] VM Maker: VMMaker.oscog-eem.3100.mcz

commits at source.squeak.org commits at source.squeak.org
Sun Nov 14 22:07:23 UTC 2021


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

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

Name: VMMaker.oscog-eem.3100
Author: eem
Time: 14 November 2021, 2:07:12.022797 pm
UUID: 1de6b417-f474-4df1-b60a-62c277c28e46
Ancestors: VMMaker.oscog-eem.3099

Interpreter/Simulator:
Revise and refactor frame printing to allow the simulators to prefix frame addresses with an indication of the various frame/stack pointers (variables, processor registers).  Extract the printing of the frame address to printFrameAddress: there-by eliminating quite a few simulator-specific versions of the frame field printers.

Use %p to print pointers, using extensions to the Printf package, '%P' to print with the 16r prefix, and '%WP' to print with 16r prefix in a width dependent on the word size.  This is enabled via PrintfFormatDescriptor class>>#initializeForCog.

Realise that %Ns prints a left-padded string in a width of N characters to eliminbate the torturous %.*s%s forms using spaces.

SInce %p always requires a pointer, cast the arguments to pringHex: et al to void pointers, and hence get rid of printHexPtr:.

Fix a slip in ObjectMemory>>#printNonPointerDataOf:on:.

Cogit:
print varBaseAddress as such in trampolines and as stacklimitFromMachineCode in methods (which is what the two usages of the same address are).
Slang:
Fix isActualType:compatibleWithFormalType: to allow a typeless formal to be compatible with a typed actual.  This gets rid of several assignments on inlining.
Fix maybeBreakOnInlineIn: which was breaking too often

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

Item was changed:
  ----- Method: CCodeGenerator>>cLiteralForPrintfString: (in category 'C code generator') -----
  cLiteralForPrintfString: aString
+ 	"Convert a Cog extended printf format string to C.
+ 	 In practice circa 2020 64-bit architectures provide a 56 bit virtual address space.
+ 	 So instead of going for the full 18 character width, use 56/4+2 = 16"
+ 	| expansionForWP |
+ 	expansionForWP := aString
+ 							copyReplaceAll: '%WP' "prints as <padding>16r..."
+ 							with: (BytesPerWord = 4 ifTrue: ['%10p'] ifFalse: ['%16p']). "prints as <padding>0x..."
+ 	^((('"', (PrintfFormatString new setFormat: expansionForWP) transformForVMMaker, '"')
- 	^(((('"', (PrintfFormatString new setFormat: aString) transformForVMMaker, '"')
- 		copyReplaceAll: '16r%p' with: '%p')
  			copyReplaceAll: '16r%' with: '0x%')
  				copyReplaceAll: (String with: Character cr) with: '\n')
  					copyReplaceAll: (String with: Character tab) with: '\t'!

Item was changed:
  ----- Method: CCodeGenerator>>isActualType:compatibleWithFormalType: (in category 'inlining') -----
  isActualType: actualTypeOrNil compatibleWithFormalType: formalTypeOrNil 
  	| actualType formalType |
  	actualType := actualTypeOrNil ifNil: [#sqInt].
+ 	formalType := formalTypeOrNil ifNil: [actualTypeOrNil ifNotNil: [^true]. #sqInt].
- 	formalType := formalTypeOrNil ifNil: [#sqInt].
  	((self isIntegralCType: actualType)
  	 and: [self isIntegralCType: formalType]) ifFalse:
  		[^actualType = formalType
  		 or: [formalType = #double and: [actualType = #float]]].
  	"For now, insist that the signedness agrees.  If the actual's type is unknown allow inlining.
  	 A formal defaults to #sqInt. Allowing inlining an unsigned type within a sqInt formal is wrong;
  	 snd for testing, it breaks e.g. the BitBltPlugin."
  	^(actualType first = $u) = (formalType first = $u)
  	  or: [actualTypeOrNil isNil] !

Item was changed:
  ----- Method: CCodeGenerator>>maybeBreakOnInlineIn: (in category 'inlining') -----
  maybeBreakOnInlineIn: aTMethod
  	"convenient for debugging..."
+ 	(breakOnInline == true
+ 	 and: [(breakDestInlineSelectors isEmpty or: [breakDestInlineSelectors includes: aTMethod selector])]) ifTrue:
- 	breakOnInline == true ifTrue:
  		[aTMethod halt: aTMethod selector]!

Item was changed:
  ----- Method: CoInterpreter>>frameNumArgs: (in category 'frame access') -----
  frameNumArgs: theFP
+ 	<var: #theFP type: #'char *'>
  	"See encodeFrameFieldHasContext:numArgs:"
  	<inline: true>
- 	<var: #theFP type: #'char *'>
  	^(self isMachineCodeFrame: theFP)
+ 		ifTrue: [self mframeNumArgs: theFP]
+ 		ifFalse: [self iframeNumArgs: theFP]!
- 		ifTrue: [(self mframeCogMethod: theFP) cmNumArgs]
- 		ifFalse: [stackPages byteAt: theFP + FoxIFrameFlags + 1]!

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"
- 	| theMethod theMethodEnd numArgs numTemps rcvrAddress topThing |
- 	<inline: false>
  	<var: #theFP type: #'char *'>
  	<var: #theSP type: #'char *'>
+ 	<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>
+ 	| theMethod theMethodEnd numArgs numTemps rcvrAddress topThing |
  	<var: #addr type: #'char *'>
- 	<var: #rcvrAddress type: #'char *'>
- 	<var: #cogMethod type: #'CogBlockMethod *'>
- 	<var: #homeMethod type: #'CogMethod *'>
  	self cCode: '' inSmalltalk: [transcript ensureCr].
  	(stackPages couldBeFramePointer: theFP) ifNil:
+ 		['%P is not in the stack zone?!!\n' f: transcript printf: theFP.
- 		[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.
+ 	rcvrAddress := theFP + (self frameStackedReceiverOffsetNumArgs: numArgs).
+ 	(self isBaseFrame: theFP)
+ 		ifTrue:
+ 			[self frameRange: rcvrAddress + (2 * objectMemory wordSize) to: theSP.
+ 			 self printFrameOop: '(caller ctxt'
+ 				at: rcvrAddress + (2 * objectMemory wordSize).
+ 			 self printFrameOop: '(saved ctxt'
+ 				at: rcvrAddress + (1 * objectMemory wordSize)]
+ 		ifFalse:
+ 			[self frameRange: rcvrAddress to: theSP].
+ 	self printFrameOop: 'rcvr/clsr' at: rcvrAddress.
- 	(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>>printFrameFlagsForFP: (in category 'debug printing') -----
  printFrameFlagsForFP: theFP
  	| address it |
  	<inline: false>
  	<var: #theFP type: #'char *'>
  	<var: #address type: #'char *'>
  	(self isMachineCodeFrame: theFP)
  		ifTrue:
  			[address := theFP + FoxMethod.
  			it := (stackPages longAt: address) bitAnd: 16r7]
  		ifFalse:
  			[address := theFP + FoxIFrameFlags.
  			 it := stackPages longAt: address].
+ 	self printFrameAddress: address;
- 	self printHexPtr: address;
  		print: ((self isMachineCodeFrame: theFP)
+ 				ifTrue: [' mcfrm flags: ']
+ 				ifFalse: ['intfrm flags: ']);
- 				ifTrue: [': mcfrm flags: ']
- 				ifFalse: [':intfrm flags: ']);
  		printHex: it.
  	it ~= 0 ifTrue:
  		[self printChar: $=; printNum: it].
+ 	'  numArgs: %d %sContext %sBlock\n'
+ 		f: transcript
+ 		printf: { self frameNumArgs: theFP.
+ 				(self frameHasContext: theFP) ifTrue: ['is'] ifFalse: ['no'].
+ 				(self frameIsBlockActivation: theFP) ifTrue: ['is'] ifFalse: ['not'] }!
- 	self print: '  numArgs: '; printNum: (self frameNumArgs: theFP);
- 		print: ((self frameHasContext: theFP) ifTrue: [' hasContext'] ifFalse: [' noContext']);
- 		print: ((self frameIsBlockActivation: theFP) ifTrue: [' isBlock'] ifFalse: [' notBlock']);
- 		cr!

Item was changed:
  ----- Method: CoInterpreter>>printFrameMethodFor: (in category 'debug printing') -----
  printFrameMethodFor: theFP
- 	<inline: false>
- 	| address it homeMethod obj |
  	<var: #theFP type: #'char *'>
  	<var: #address type: #'char *'>
+ 	<inline: false>
+ 	| address it homeMethod obj |
- 	<var: #homeMethod type: #'CogMethod *'>
- 
  	address := theFP + FoxMethod.
  	it := stackPages longAt: address.
+ 	self printFrameAddress: address.
+ 	(self pst: '      method: %WP\t') f: transcript printf: it asVoidPointer.
- 	self printHex: address asInteger;
- 		printChar: $:.
- 	self print: '      method: ';
- 		printHex: it.
- 	self tab.
  	((self isMachineCodeFrame: theFP)
  	 and: [self mframeIsBlockActivation: theFP]) ifTrue:
  		[homeMethod := self mframeHomeMethod: theFP.
+ 		 'hm: %P\t' f: transcript printf: homeMethod asInteger].
- 		 self print: 'hm: '; printHex: homeMethod asInteger; tab].
  	obj := self frameMethodObject: theFP.
  	self shortPrintOop: obj!

Item was changed:
  ----- Method: CoInterpreter>>printFrameThing:at:extra: (in category 'debug printing') -----
  printFrameThing: name at: address extra: extraValue
- 	| it len |
- 	<inline: false>
  	<var: #name type: #'char *'>
  	<var: #address type: #'char *'>
+ 	<inline: false>
+ 	| it |
  	it := stackPages longAt: address.
+ 	self printFrameAddress: address.
+ 	(self pst: '%12s: %WP') f: transcript printf: { name. it asVoidPointer }.
+ 	self framePrintDescription: it.
+ 	' %ld\n' f: transcript printf: extraValue!
- 	self printHexPtr: address;
- 		printChar: $:.
- 	len := self strlen: name.
- 	1 to: 12 - len do: [:i| self space].
- 	self print: name;
- 		print: ': ';
- 		printHex: it.
- 	it ~= 0 ifTrue:
- 		[self printChar: $=.
- 		 it = objectMemory nilObject
- 			ifTrue: [self print: 'nil']
- 			ifFalse:
- 				[self printNum: it]].
- 	self space; printNum: extraValue; cr!

Item was removed:
- ----- Method: CoInterpreter>>printFrameThing:at:extraString: (in category 'debug printing') -----
- printFrameThing: name at: address extraString: extraStringOrNil
- 	| it len |
- 	<inline: false>
- 	<var: #name type: #'char *'>
- 	<var: #address type: #'char *'>
- 	<var: #extraStringOrNil type: #'char *'>
- 	it := stackPages longAt: address.
- 	self printHexPtr: address;
- 		printChar: $:.
- 	len := self strlen: name.
- 	1 to: 12 - len do: [:i| self space].
- 	self print: name;
- 		print: ': ';
- 		printHex: it.
- 	it ~= 0 ifTrue:
- 		[self printChar: $=.
- 		 it = objectMemory nilObject
- 			ifTrue: [self print: 'nil']
- 			ifFalse:
- 				[self printNum: it]].
- 	extraStringOrNil ifNotNil: [self space; print: extraStringOrNil].
- 	self cr!

Item was changed:
  CoInterpreterMT subclass: #CogVMSimulator
+ 	instanceVariableNames: 'parent enableCog byteCount lastPollCount lastExtPC sendCount lookupCount printSends printFrameRange printfConversions myBitBlt displayForm fakeForm imageName pluginList mappedPluginEntries quitBlock displayView eventTransformer printFrameAtEachStep printBytecodeAtEachStep systemAttributes uniqueIndices uniqueIndex breakCount atEachStepBlock startMicroseconds lastYieldMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize debugStackDepthDictionary performFilters eventQueue effectiveCogCodeSize expectedSends expecting inputSemaphoreIndex zeroNextProfileTickCount perMethodProfile'
- 	instanceVariableNames: 'parent enableCog byteCount lastPollCount lastExtPC sendCount lookupCount printSends myBitBlt displayForm fakeForm imageName pluginList mappedPluginEntries quitBlock displayView eventTransformer printFrameAtEachStep printBytecodeAtEachStep systemAttributes uniqueIndices uniqueIndex breakCount atEachStepBlock startMicroseconds lastYieldMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize debugStackDepthDictionary performFilters eventQueue effectiveCogCodeSize expectedSends expecting inputSemaphoreIndex zeroNextProfileTickCount perMethodProfile'
  	classVariableNames: 'ByteCountsPerMicrosecond ExpectedSends NLRFailures NLRSuccesses StackAlteringPrimitives'
  	poolDictionaries: ''
  	category: 'VMMaker-JITSimulation'!
  
  !CogVMSimulator commentStamp: 'eem 9/3/2013 11:16' prior: 0!
  This class defines basic memory access and primitive simulation so that the CoInterpreter can run simulated in the Squeak environment.  It also defines a number of handy object viewing methods to facilitate pawing around in the object memory.  Remember that you can test the Cogit using its class-side in-image compilation facilities.
  
  To see the thing actually run, you could (after backing up this image and changes), execute
  
  	(CogVMSimulator new openOn: Smalltalk imageName) test
  
  and be patient both to wait for things to happen, and to accept various things that may go wrong depending on how large or unusual your image may be.  We usually do this with a small and simple benchmark image.
  
  Here's an example to launch the simulator in a window.  The bottom-right window has a menu packed with useful stuff:
  
  (CogVMSimulator newWithOptions: #(Cogit StackToRegisterMappingCogit))
  	desiredNumStackPages: 8;
  	openOn: '/Users/eliot/Cog/startreader.image';
  	openAsMorph;
  	run
  
  Here's a hairier example that I (Eliot) actually use in daily development with some of the breakpoint facilities commented out.
  
  | cos proc opts |
  CoInterpreter initializeWithOptions: (opts := Dictionary newFromPairs: #(Cogit StackToRegisterMappingCogit)).
  CogVMSimulator chooseAndInitCogitClassWithOpts: opts.
  cos := CogVMSimulator new.
  "cos initializeThreadSupport." "to test the multi-threaded VM"
  cos desiredNumStackPages: 8. "to set the size of the stack zone"
  "cos desiredCogCodeSize: 8 * 1024 * 1024." "to set the size of the Cogit's code zone"
  cos openOn: '/Users/eliot/Squeak/Squeak4.4/trunk44.image'. "choose your favourite image"
  "cos setBreakSelector: 'r:degrees:'." "set a breakpoint at a specific selector"
  proc := cos cogit processor.
  "cos cogit sendTrace: 7." "turn on tracing"
  "set a complex breakpoint at a specific point in machine code"
  "cos cogit singleStep: true; breakPC: 16r56af; breakBlock: [:cg|  cos framePointer > 16r101F3C and: [(cos longAt: cos framePointer - 4) = 16r2479A and: [(cos longAt: 16r101F30) = (cos longAt: 16r101F3C) or: [(cos longAt: 16r101F2C) = (cos longAt: 16r101F3C)]]]]; sendTrace: 1".
  "[cos cogit compilationTrace: -1] on: MessageNotUnderstood do: [:ex|]." "turn on compilation tracing in the StackToRegisterMappingCogit"
  "cos cogit setBreakMethod: 16rB38880."
  cos
  	openAsMorph;
  	"toggleTranscript;" "toggleTranscript will send output to the Transcript instead of the morph's rather small window"
  	halt;
  	run!

Item was added:
+ ----- Method: CogVMSimulator>>framePrintDescription: (in category 'debug printing') -----
+ framePrintDescription: it
+ 	it ~= 0 ifTrue:
+ 		['=%ld' f: transcript printf: it.
+ 		 (objectMemory isInMemory: it) ifFalse:
+ 			[(cogit lookupAddress: it) ifNotNil:
+ 				[:label| ' (%s)' f: transcript printf: label]]]!

Item was added:
+ ----- Method: CogVMSimulator>>frameRange:to: (in category 'debug printing') -----
+ frameRange: highAddress to: lowAddress
+ 	printFrameRange := lowAddress to: highAddress!

Item was changed:
  ----- Method: CogVMSimulator>>initialize (in category 'initialize-release') -----
  initialize
  	"Initialize the CogVMSimulator when running the interpreter inside Smalltalk.  The
  	 primary responsibility of this method is to allocate Smalltalk Arrays for variables
  	 that will be declared as statically-allocated global arrays in the translated code."
  	super initialize.
  
  	transcript := Transcript.
  
  	objectMemory ifNil:
  		[objectMemory := InitializationOptions
  								at: #ObjectMemorySimulator
  								ifPresent: [:className| (Smalltalk classNamed: className) new]
  								ifAbsent: [self class objectMemoryClass simulatorClass new]].
  	cogit ifNil:
  		[cogit := self class cogitClass new setInterpreter: self].
  	objectMemory coInterpreter: self cogit: cogit.
  
  	(cogit numRegArgs > 0
  	 and: [VMClass initializationOptions at: #CheckStackDepth ifAbsent: [true]]) ifTrue:
  		[debugStackDepthDictionary := Dictionary new].
  
  	cogThreadManager ifNotNil:
  		[super initialize].
  
  	self assert: ConstMinusOne = (objectMemory integerObjectOf: -1).
  
  	cogMethodZone := cogit methodZone. "Because Slang can't remove intermediate implicit receivers (cogit methodZone foo doesn't reduce to foo())"
  	enableCog := true.
  
  	methodCache := Array new: MethodCacheSize.
  	nsMethodCache := Array new: NSMethodCacheSize.
  	atCache := nil.
  	self flushMethodCache.
  	cogCompiledCodeCompactionCalledFor := false.
  	gcSemaphoreIndex := 0.
  	externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
  	externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
  	externalPrimitiveTableFirstFreeIndex := 0.
  	primitiveTable := self class primitiveTable copy.
  	self initializePluginEntries.
  	desiredNumStackPages := InitializationOptions at: #desiredNumStackPages ifAbsent: [0].
  	desiredEdenBytes := InitializationOptions at: #desiredEdenBytes ifAbsent: [0].
  	desiredCogCodeSize  := InitializationOptions at: #desiredCogCodeSize ifAbsent: [0].
  	"This is initialized on loading the image, but convenient for testing stack page values..."
  	numStackPages := self defaultNumStackPages. 
  	startMicroseconds := lastYieldMicroseconds := self ioUTCStartMicroseconds.
  	maxLiteralCountForCompile := MaxLiteralCountForCompile.
  	minBackwardJumpCountForCompile := MinBackwardJumpCountForCompile.
  	flagInterpretedMethods := false.
  
  	"initialize InterpreterSimulator variables used for debugging"
  	byteCount := lastPollCount := sendCount := lookupCount := 0.
  	quitBlock := [^self close].
  	printSends := printFrameAtEachStep := printBytecodeAtEachStep := false.
  	myBitBlt := BitBltSimulator new setInterpreter: self.
  	displayForm := fakeForm := 'Display has not yet been installed' asDisplayText form.
  	suppressHeartbeatFlag := deferSmash := deferredSmash := false.
  	systemAttributes := Dictionary new.
  	primTraceLog := CArrayAccessor on: (Array new: 256 withAll: 0).
  	primTraceLogIndex := 0.
  	traceLog := CArrayAccessor on: (Array new: TraceBufferSize withAll: 0).
  	traceLogIndex := 0.
  	traceSources := TraceSources.
  	statCodeCompactionCount := 0.
  	statCodeCompactionUsecs := 0.
  	extSemTabSize := 256.
+ 	zeroNextProfileTickCount := 0.
+ 	printFrameRange := 0 to: 0.
+ 	printfConversions := IdentityDictionary new!
- 	zeroNextProfileTickCount := 0!

Item was added:
+ ----- Method: CogVMSimulator>>printFrameAddress: (in category 'debug printing') -----
+ printFrameAddress: address
+ 	((printFrameRange includes: framePointer)
+ 	 or: [(printFrameRange includes: stackPointer)
+ 	 or: [(printFrameRange includes: cogit processor fp)
+ 	 or: [(printFrameRange includes: cogit smalltalkStackPointerRegisterValue)]]]) ifTrue:
+ 		['%s%s%s%s\t'
+ 			f: transcript
+ 			printf:{	address = framePointer ifTrue: ['FP:'].
+ 					address = stackPointer ifTrue: ['SP:'].
+ 					address = cogit processor fp ifTrue: ['fp:'].
+ 					address = cogit smalltalkStackPointerRegisterValue ifTrue: ['sp:'] }].
+ 	(self pst: '%WP:') f: transcript printf: address asVoidPointer!

Item was changed:
  ----- Method: CogVMSimulator>>printFrameOop:obj:at: (in category 'debug printing') -----
  printFrameOop: name obj: obj at: address
- 	| it len |
- 	<inline: false>
  	<var: #name type: #'char *'>
  	<var: #address type: #'char *'>
+ 	<inline: false>
+ 	| it |
  	it := stackPages longAt: address.
+ 	self printFrameAddress: address.
+ 	(self pst: '%12s: %WP\t') f: transcript printf: { name. it asVoidPointer }.
- 	self printHex: address;
- 		printChar: $:.
- 	len := self strlen: name.
- 	1 to: 12 - len do: [:i| self printChar: $ ].
- 	self print: name;
- 		print: ': ';
- 		printHex: it.
- 	self tab.
  	it = obj
  		ifTrue: [self tab]
  		ifFalse: [self printHex: obj; space].
  	self
  		print: (self shortPrint: obj);
  		cr!

Item was removed:
- ----- Method: CogVMSimulator>>printFrameThing:at: (in category 'debug printing') -----
- printFrameThing: name at: address
- 	| it |
- 	<inline: false>
- 	<var: #name type: #'char *'>
- 	<var: #address type: #'char *'>
- 	it := stackPages longAt: address.
- 	self printHex: address;
- 		printChar: $:.
- 	1 to: 12 - (self strlen: name) do: [:i| self printChar: $ ].
- 	self print: name;
- 		print: ': ';
- 		printHex: it.
- 	it ~= 0 ifTrue:
- 		[self printChar: $=; printNum: it.
- 		 (objectMemory isInMemory: it) ifFalse:
- 			[(cogit lookupAddress: it) ifNotNil:
- 				[:label| self space; printChar: $(; print: label; printChar: $)]]].
- 	self cr!

Item was added:
+ ----- Method: CogVMSimulator>>pst: (in category 'debug printing') -----
+ pst: aPrintfString
+ 	"Override to map %WP to substitute W for BytesPerWord * 2 + 3, so that e.g. in 64 bits, '%WP' printf: 0 prints as <15 spaces>16r1.
+ 	 Except that because circa 2020 64-bit architectures provide a 56 bit virtual address space, and in the simulator we're restricted
+ 	 to a few gigabytes, use 15 characters (a 48 bit address space with 16r prefix)."
+ 	^printfConversions
+ 		at: aPrintfString
+ 		ifAbsentPut: [aPrintfString
+ 						copyReplaceAll: '%WP'
+ 						with: (BytesPerWord = 4
+ 								ifTrue: ['%11P']
+ 								ifFalse: ['%15P'])]!

Item was changed:
  ----- Method: Cogit>>disassembleMethod:on: (in category 'disassembly') -----
  disassembleMethod: surrogateOrAddress on: aStream
  	<doNotGenerate>
  	| cogMethod mapEntries codeRanges |
  	cogMethod := surrogateOrAddress isInteger
  								ifTrue: [self cogMethodSurrogateAt: surrogateOrAddress]
  								ifFalse: [surrogateOrAddress].
  	cogMethod cmType = CMBlock ifTrue:
  		[^self disassembleMethod: cogMethod cmHomeMethod on: aStream].
+ 	disassemblingMethod ifNil:
- 	(disassemblingMethod isNil
- 	 and: [self class initializationOptions at: #relativeAddressDisassembly ifAbsent: [false]]) ifTrue:
  		[^[disassemblingMethod := cogMethod.
+ 		     self disassembleMethod: surrogateOrAddress on: aStream] ensure:
- 		    self disassembleMethod: surrogateOrAddress on: aStream] ensure:
  			[disassemblingMethod := nil]].
  	self printMethodHeader: cogMethod on: aStream.
  
  	mapEntries := Dictionary new.
  	(cogMethod cmType = CMMethod and: [cogMethod cmIsFullBlock]) ifFalse:
  		[mapEntries at: cogMethod asInteger + cmEntryOffset put: 'entry'].
  	
  	cogMethod cmType = CMMethod ifTrue:
  		[cogMethod cmIsFullBlock
  			ifTrue: [mapEntries at: cogMethod asInteger + cbNoSwitchEntryOffset put: 'noSwitchEntry']
  			ifFalse: [mapEntries at: cogMethod asInteger + cmNoCheckEntryOffset put: 'noCheckEntry']].
  
  	cogMethod cmType = CMClosedPIC
  		ifTrue: "Since Tim R's lovely work on Closed PICs, PIC cases go backwards..."
  			[mapEntries at: cogMethod asInteger + firstCPICCaseOffset put: 'ClosedPICCase', MaxCPICCases printString.
  			 1 to: MaxCPICCases - 1 do:
  				[:i|
  				mapEntries
  					at: cogMethod asInteger + firstCPICCaseOffset + (i * cPICCaseSize)
  					put: 'ClosedPICCase', (MaxCPICCases - i) printString]]
  		ifFalse:
  			[self mapFor: cogMethod
  				performUntil: #collectMapEntry:address:into:
  				arg: mapEntries].
  
  	NewspeakVM ifTrue:
  		[objectRepresentation canPinObjects ifFalse:
  			[mapEntries keys do:
  				[:a|
  				(mapEntries at: a) = #IsNSSendCall ifTrue:
  					[mapEntries
  						at: a + backEnd jumpShortByteSize
  							put: {'Class'. #disassembleCachedOop:. (objectMemory wordSize)};
  						at: a + backEnd jumpShortByteSize + objectMemory bytesPerOop
  							put: {'ImplicitReceiver'. #disassembleCachedOop:. (objectMemory wordSize)}]]]].
  
  	"This would all be far more elegant and simple if we used blocks.
  	 But there are no blocks in C and the basic enumerators here need
  	 to be used in the real VM.  Apologies."
  	(codeRanges := self codeRangesFor: cogMethod) do:
  		[:range|
  		(cogMethod cmType = CMMethod) ifTrue:
  			[mapEntries keysAndValuesDo:
  				[:mcpc :label| | bcpc selectorOrNone |
  				(((range includes: mcpc) or: [range last + 1 = mcpc])
  				 and: [(AnnotationsWithBytecodePCs includes: label)
  				 and: [range cogMethod stackCheckOffset > 0]]) ifTrue:
  					[bcpc := self bytecodePCFor: mcpc startBcpc: range startpc in: range cogMethod.
  					 bcpc ~= 0 ifTrue:
  						[label = #IsSendCall
  							ifTrue:
  								[selectorOrNone := (self selectorForSendAt: mcpc annotation: IsSendCall in: cogMethod methodObject).
  								 (selectorOrNone isInteger and: [objectMemory addressCouldBeOop: selectorOrNone]) ifTrue:
  									[selectorOrNone := objectMemory stringOf: selectorOrNone].
  								selectorOrNone := ' ', selectorOrNone]
  							ifFalse: [selectorOrNone := ''].
  						 mapEntries
  							at: mcpc
  							put: label, selectorOrNone, ' bc ', bcpc printString, '/', (bcpc + 1) printString]]]].
  		(cogMethod blockEntryOffset ~= 0
  		 and: [range first = (cogMethod blockEntryOffset + cogMethod asInteger)])
  			ifTrue:
  				[aStream nextPutAll: 'blockEntry:'; cr.
  				 self blockDispatchFor: cogMethod
  					perform: #disassemble:from:to:arg:
  					arg: aStream]
  			ifFalse:
  				[range first > (cogMethod address + cmNoCheckEntryOffset) ifTrue:
  					[self printMethodHeader: range cogMethod
  						on: aStream].
  				self maybeNoteStartpcFor: range.
  				self disassembleFrom: range first to: range last labels: mapEntries on: aStream]].
  	aStream nextPutAll: 'startpc: '; print: codeRanges first startpc; cr.
  	(cogMethod cmType = CMMethod
  	 or: [cogMethod cmType = CMOpenPIC]) ifTrue:
  		[[self mapFor: cogMethod
  			performUntil: #printMapEntry:mcpc:args:
  			arg: { aStream. codeRanges. cogMethod }]
  			on: AssertionFailure
  			do: [:ex|
  				ex primitiveChangeClassTo: ResumableVMError basicNew. ":) :) :)"
  				ex resume: nil]].
  	^cogMethod!

Item was changed:
  ----- Method: Cogit>>lookupAddress: (in category 'disassembly') -----
  lookupAddress: address
  	<doNotGenerate>
  	address < methodZone freeStart ifTrue:
  		[^address >= methodZoneBase
  			ifTrue:
  				[(methodZone methodFor: address) ifNotNil:
  					[:cogMethod|
  					 ((cogMethod selector ~= objectMemory nilObject
  					    and: [objectRepresentation couldBeObject: cogMethod selector])
  						ifTrue: [coInterpreter stringOf: cogMethod selector]
  						ifFalse: [cogMethod asInteger hex]),
  					   '@', ((address - cogMethod asInteger) hex allButFirst: 3)]]
  			ifFalse:
  				[(self trampolineRangeFor: address) ifNotNil:
  					[:range|
  					 (self codeEntryNameFor: range first) ifNotNil:
  						[:name| name, (address = range first ifTrue: [''] ifFalse: [' + ', (address - range first) hex])]]]].
  	(simulatedTrampolines includesKey: address) ifTrue:
  		[^self labelForSimulationAccessor: (simulatedTrampolines at: address)].
  	(simulatedVariableGetters includesKey: address) ifTrue:
+ 		["In methods varBaseAddress is typically stackLimitFromMachineCode, but in
+ 		  trampolines it is typically varBaseAddress..."
+ 		(varBaseAddress isInteger and: [address = varBaseAddress and: [disassemblingMethod isNil]]) ifTrue:
+ 			[^'VarBaseAddress'].
+ 		^self labelForSimulationAccessor: (simulatedVariableGetters at: address)].
- 		[^self labelForSimulationAccessor: (simulatedVariableGetters at: address)].
  	^(coInterpreter lookupAddress: address) ifNil:
  		[address = self cStackPointerAddress
  			ifTrue: [#CStackPointer]
  			ifFalse:
  				[address = self cFramePointerAddress ifTrue:
  					[#CFramePointer]]]!

Item was changed:
  ----- Method: Cogit>>printPCMapPairsFor: (in category 'method map') -----
  printPCMapPairsFor: cogMethod
  	<doNotGenerate>
  	"<api>
  	<var: 'cogMethod' type: #'CogMethod *'>
  	<var: 'mapByte' type: #'unsigned char'>"
  	| mcpc map mapByte annotation value |
  	mcpc := self firstMappedPCFor: cogMethod.
  	map := self mapStartFor: cogMethod.
  	[(mapByte := objectMemory byteAt: map) ~= MapEnd] whileTrue:
  		[annotation := mapByte >> AnnotationShift.
  		 annotation = IsAnnotationExtension
  			ifTrue:
  				[value := (mapByte bitAnd: DisplacementMask) + IsSendCall]
  			ifFalse:
  				[value := annotation.
  				 mcpc := mcpc + (backEnd codeGranularity
  									* (annotation = IsDisplacementX2N
  										ifTrue: [mapByte - DisplacementX2N << AnnotationShift]
  										ifFalse: [mapByte bitAnd: DisplacementMask]))].
  		((NewspeakVM
  		  and: [value = IsNSSendCall
  			     or: [value between: IsNSSendCall and: IsNSImplicitReceiverSend]])
  			ifTrue:
  				[value caseOf: {
  						[IsNSSendCall]				->	['NSSendCall'].
  						[IsNSSelfSend]				->	['NSSelfSend'].
  						[IsNSDynamicSuperSend]	->	['NSDynamicSuperSend'].
  						[IsNSImplicitReceiverSend]	->	['NSImplicitReceiverSend'] }
  					otherwise: [nil]]
  			ifFalse:
  				 [(BytecodeSetHasDirectedSuperSend
  				    and: [value between: IsDirectedSuperSend and: IsDirectedSuperBindingSend])
  					ifTrue:
  						[value = IsDirectedSuperSend
  							ifTrue: ['DirectedSuperSend']
  							ifFalse: ['DirectedSuperBindingSend']]
  					ifFalse:
  						 [value
  							caseOf: {
  								[IsDisplacementX2N]		->	['DisplacementX2N'].
  								[IsAnnotationExtension]	->	['AnnotationExtension'].
  								[IsObjectReference]			->	['ObjectReference'].
  								[IsAbsPCReference]			->	['AbsPCReference'].
  								[HasBytecodePC]			->	['HasBytecodePC'].
  								[IsRelativeCall]				->	['RelativeCall'].
  								[IsSendCall]				->	['SendCall'].
  								[IsSuperSend]				->	['SuperSend'] }
  							otherwise: [nil]]])
+ 				ifNil: ['%lx: %02x %ld (??? %d) 16r%x @ %P\n'
- 				ifNil: ['%lx: %02x %ld (??? %d) 16r%x @ 16r%lx\n'
  						f: coInterpreter getTranscript
  						printf: { map. mapByte. annotation. value. mapByte bitAnd: DisplacementMask. mcpc }]
  				ifNotNil:
  					[:type|
+ 					 '%lx: %02x %ld (%s) 16r%x @ %P\n'
- 					 '%lx: %02x %ld (%s) 16r%x @ 16r%lx\n'
  						f: coInterpreter getTranscript
  						printf: { map. mapByte. annotation. type. mapByte bitAnd: DisplacementMask. mcpc }].
  		 map := map - 1]!

Item was changed:
  ----- Method: Cogit>>relativeBaseForDisassemblyInto: (in category 'disassembly') -----
  relativeBaseForDisassemblyInto: aBlock
  	<doNotGenerate>
  	disassemblingMethod ifNotNil:
+ 		[(InitializationOptions at: #relativeAddressDisassembly ifAbsent: [false]) ifTrue:
+ 			[aBlock value: disassemblingMethod asInteger value: '.']]!
- 		[aBlock value: disassemblingMethod asInteger value: '.']!

Item was added:
+ ----- Method: Cogit>>smalltalkStackPointerRegisterValue (in category 'accessing') -----
+ smalltalkStackPointerRegisterValue
+ 	"Answer the effective Smalltalk stack pointer reg in the processor."
+ 	<doNotGenerate>
+ 	^NativeSPReg = SPReg
+ 		ifTrue: [processor sp]
+ 		ifFalse: [processor registerAt: SPReg]!

Item was changed:
  ----- Method: CurrentImageCoInterpreterFacade>>cr (in category 'printing') -----
  cr
+ 	coInterpreter cr!
- 	coInterpreter transcript cr; flush!

Item was changed:
  ----- Method: CurrentImageCoInterpreterFacade>>printHex: (in category 'printing') -----
  printHex: anInteger
+ 	coInterpreter printHex: anInteger!
- 	| it16 |
- 	it16 := anInteger radix: 16.
- 	coInterpreter transcript
- 		next: 8 - it16 size put: Character space;
- 		nextPutAll: (anInteger printStringBase: 16)!

Item was removed:
- ----- Method: CurrentImageCoInterpreterFacade>>printHexnp: (in category 'printing') -----
- printHexnp: anInteger
- 	coInterpreter transcript nextPutAll: (anInteger printStringBase: 16)!

Item was changed:
  ----- Method: NewObjectMemory>>printCantBeObject:on: (in category 'debug printing interpreter support') -----
  printCantBeObject: oop on: aStream
  	<var: 'aStream' type: #'FILE *'>
+ 	'%P%s\n'
- 	'16r%lx%s\n'
  		f: aStream
+ 		printf: {oop asVoidPointer.
- 		printf: {oop.
  				((oop bitAnd: self allocationUnit - 1) ~= 0
  					ifTrue: [' is misaligned']
  					ifFalse: [coInterpreter whereIs: oop])}!

Item was changed:
  ----- Method: NewObjectMemory>>printMemField:name:size: (in category 'debug printing') -----
  printMemField: memField name: name size: length
  	<var: #memField type: #usqInt>
  	<var: #name type: #'char *'>
+ 	'%s\t%P/%ld sz: %p'
+ 		f: coInterpreter transcript
+ 		printf: { name. memField asVoidPointer. memField. length }.
- 	self print: name; tab; printHexPtr: memField asVoidPointer;
- 		printChar: $/; printNum: memField;
- 		print: ' sz: '; printHex: length.
  	length ~= 0 ifTrue:
+ 		['/%ld' f: coInterpreter transcript printf: length].
+ 	coInterpreter cr!
- 		[self printChar: $/; printNum: length].
- 	self cr!

Item was changed:
  ----- Method: ObjectMemory>>printCantBeObject:on: (in category 'debug printing interpreter support') -----
  printCantBeObject: oop on: aStream
  	<var: 'aStream' type: #'FILE *'>
+ 	'%P%s\n'
- 	'16r%lx%s\n'
  		f: aStream
+ 		printf: {oop asVoidPointer.
- 		printf: {oop.
  				((oop bitAnd: self allocationUnit - 1) ~= 0
  					ifTrue: [' is misaligned']
  					ifFalse: [self whereIs: oop])}!

Item was changed:
  ----- Method: ObjectMemory>>printFreeObject:on: (in category 'debug printing') -----
  printFreeObject: oop on: aStream
  	<var: 'aStream' type: #'FILE *'>
+ 	'%P is a free chunk of size %ld\n'
- 	'16r%lx is a free chunk of size %ld\n'
  		f: aStream
+ 		printf: {oop asVoidPointer. self sizeOfFree: oop}!
- 		printf: {oop. self sizeOfFree: oop}!

Item was changed:
  ----- Method: ObjectMemory>>printImmediateObject:on: (in category 'debug printing interpreter support') -----
  printImmediateObject: oop on: aStream
  	<var: 'aStream' type: #'FILE *'>
  	self assert: (self isIntegerObject: oop).
+ 	'%P=%ld\n' f: aStream printf: {oop asVoidPointer. (self integerValueOf: oop) asInteger}!
- 	'16r%lx=%ld\n' f: aStream printf: {oop. (self integerValueOf: oop) asInteger}!

Item was changed:
  ----- Method: ObjectMemory>>printNonPointerDataOf:on: (in category 'debug printing interpreter support') -----
  printNonPointerDataOf: oop on: aStream
  	<var: 'aStream' type: #'FILE *'>
+ 	| elementsPerLine format lastIndex |
- 	| elementsPerLine format lastIndex sixteenSpaces |
  	format := self formatOf: oop.
  	self assert: (format between: self sixtyFourBitIndexableFormat and: self firstCompiledMethodFormat - 1).
  	lastIndex := self lengthOf: oop format: format.
  	lastIndex = 0 ifTrue:
  		[^self].
- 	sixteenSpaces := '                '.
  	format = self sixtyFourBitIndexableFormat ifTrue:
  		[lastIndex := 32 min: lastIndex.
  		 elementsPerLine := 4. "0x/16r0123456789ABCDEF<space|cr> x 4 = 76/80"
  		 1 to: lastIndex do:
+ 			[:index|
+ 			'%19P%c' f: aStream printf: {
+ 				self cCoerceSimple: (self fetchLong64: index - 1 ofObject: oop) to: #usqLong.
- 			[:index| | v64 |
- 			v64 := self cCoerceSimple: (self fetchLong64: index - 1 ofObject: oop) to: #usqLong.
- 			'%.*s16r%lx%c' f: aStream printf: {
- 				64 - (v64 highBit max: 1) // 4.
- 				sixteenSpaces.
- 				v64.
  				(index \\ elementsPerLine = 0 or: [index = lastIndex])
  					ifTrue: [Character cr] ifFalse: [Character space] }].
  		 ^self].
  	format < self firstByteFormat ifTrue:
  		[lastIndex := 128 min: lastIndex.
+ 		 elementsPerLine := 6. "0x/16r12345678<space|cr> x 6 = 66/72"
- 		 elementsPerLine := 10. "0x/16r1234<space|cr> x 10 = 70/80"
  		1 to: lastIndex do:
+ 			[:index|
+ 			'%11P%c' f: aStream printf: {
+ 				self fetchLong32: index - 1 ofObject: oop.
- 			[:index| | v16 |
- 			v16 := self fetchShort16: index - 1 ofObject: oop.
- 			'%.*s16r%lx%c' f: aStream printf: {
- 				16 - (v16 highBit max: 1) // 4.
- 				sixteenSpaces.
- 				v16.
  				(index \\ elementsPerLine = 0 or: [index = lastIndex])
  					ifTrue: [Character cr] ifFalse: [Character space] }].
  		 ^self].
  	lastIndex := 256 min: lastIndex.
  	elementsPerLine := 16. "0x/16r12<space|cr> x 16 = 80/96"
  	1 to: lastIndex do:
+ 		[:index|
+ 		'%5P%c' f: aStream printf: {
+ 			self fetchByte: index - 1 ofObject: oop.
- 		[:index| | v8 |
- 		v8 := self fetchByte: index - 1 ofObject: oop.
- 		'%.*s16r%lx%c' f: aStream printf: {
- 			8 - (v8 highBit max: 1) // 4.
- 			sixteenSpaces.
- 			v8.
  			(index \\ elementsPerLine = 0 or: [index = lastIndex])
  				ifTrue: [Character cr] ifFalse: [Character space] }]!

Item was added:
+ ----- Method: PrintfFormatDescriptor class>>initializeForCog (in category '*VMMaker-class initialization') -----
+ initializeForCog
+ 	"This changes the meaning of the extension %P from ``output the argument's printString'' to ``print using hex with Smalltalk radix prefix'', e.g. 16r1234"
+ 	"PrintfFormatDescriptor initializeForCog"
+ 	Operators ifNil: [self initialize].
+ 	Operators at: $P put: #PrintfNumberFormatDescriptor!

Item was changed:
  ----- Method: PrintfNumberFormatDescriptor>>transformForVMMaker (in category '*VMMaker-C code generation') -----
  transformForVMMaker
+ 	operator == $P ifTrue:
+ 		[^'%', (width = 0 ifTrue: [''] ifFalse: [(width - 1) printString]), 'p'].
  	('duxX' includes: operator) ifTrue:
+ 		[^'%',
+ 			(width = 0 ifTrue: [''] ifFalse: [(width - 1) printString]),
+ 			'" PRI',
+ 			(String with: operator),
+ 			'SQINT "'].
- 		[^'%" PRI', (String with: operator), 'SQINT "'].
  	^super transformForVMMaker!

Item was changed:
  ----- Method: SpurMemoryManager>>printCantBeObject:on: (in category 'debug printing interpreter support') -----
  printCantBeObject: oop on: aStream
  	<var: 'aStream' type: #'FILE *'>
  	((oop bitAnd: self allocationUnit - 1) = 0
  	  and: [(self isInNewSpace: oop)
  	  and: [self isForwarded: oop]]) ifTrue:
  		[^self printForwarder: oop on: aStream].
+ 	'%P%s\n'
- 	'16r%lx%s\n'
  		f: aStream
+ 		printf: {oop asVoidPointer.
- 		printf: {oop.
  				((oop bitAnd: self allocationUnit - 1) ~= 0
  					ifTrue: [' is misaligned']
  					ifFalse: [coInterpreter whereIs: oop])}!

Item was changed:
  ----- Method: SpurMemoryManager>>printForwarder:on: (in category 'debug printing interpreter support') -----
  printForwarder: oop on: aStream
  	<var: 'aStream' type: #'FILE *'>
+ 	'%P is a forwarded hdr%d slot size %ud object to %P\n'
- 	'16r%lx is a forwarded hdr%d slot size %ud object to 16r%lx\n'
  		f: aStream
+ 		printf: { oop asVoidPointer.
- 		printf: { oop.
  				(self rawNumSlotsOf: oop) = self numSlotsMask ifTrue: [16] ifFalse: [8].
  				self numSlotsOfAny: oop.
  				self objectMemory followForwarded: oop}!

Item was changed:
  ----- Method: SpurMemoryManager>>printFreeObject:on: (in category 'debug printing') -----
  printFreeObject: oop on: aStream
  	<var: 'aStream' type: #'FILE *'>
+ 	'%P is a free chunk of size %ld 0th field:%P\n'
- 	'16r%lx is a free chunk of size %ld 0th field:16r%lx\n'
  		f: aStream
+ 		printf: {oop asVoidPointer. self bytesInBody: oop. self fetchPointer: 0 ofFreeChunk: oop }!
- 		printf: {oop. self bytesInBody: oop. self fetchPointer: 0 ofFreeChunk: oop }!

Item was changed:
  ----- Method: SpurMemoryManager>>printHeaderTypeOf:on: (in category 'debug printing interpreter support') -----
  printHeaderTypeOf: obj on: aStream
  	<var: 'aStream' type: #'FILE *'>
  	<inline: true>
  	' hdr%d %c%c%c%c%c' f: aStream printf: {
+ 		(self hasOverflowHeader: obj) ifTrue: [16] ifFalse: [8].
- 		(self rawNumSlotsOf: obj) = self numSlotsMask ifTrue: [16] ifFalse: [8].
  		(self isImmutable: obj) ifTrue: [$i] ifFalse: [$.].
  		(self isRemembered: obj) ifTrue: [$r] ifFalse: [$.].
  		(self isPinned: obj) ifTrue: [$p] ifFalse: [$.].
  		(self isMarked: obj) ifTrue: [$m] ifFalse: [$.].
  		(self isGrey: obj) ifTrue: [$g] ifFalse: [$.] }!

Item was changed:
  ----- Method: SpurMemoryManager>>printImmediateObject:on: (in category 'debug printing interpreter support') -----
  printImmediateObject: oop on: aStream
  	<var: 'aStream' type: #'FILE *'>
  	self assert: (self isImmediate: oop).
  	(self isIntegerObject: oop) ifTrue:
+ 		['%P=%ld\n' f: aStream printf: {oop asVoidPointer. (self integerValueOf: oop) asInteger}].
- 		['16r%lx=%ld\n' f: aStream printf: {oop. (self integerValueOf: oop) asInteger}].
  	(self isImmediateCharacter: oop) ifTrue:
+ 		['%P=$%ld ($%lc)\n' f: aStream printf: {oop asVoidPointer.
- 		['16r%lx=$%ld ($%lc)\n' f: aStream printf: {oop.
  													(self characterValueOf: oop) asLong.
  													self cCoerce: (self characterValueOf: oop) to:  #'wint_t'}].
  	(self isImmediateFloat: oop) ifTrue:
+ 		['%P=%g\n' f: aStream printf: {oop asVoidPointer. self floatValueOf: oop}]!
- 		['16r%lx=%g\n' f: aStream printf: {oop. self floatValueOf: oop}]!

Item was changed:
  ----- Method: SpurMemoryManager>>printNonPointerDataOf:on: (in category 'debug printing interpreter support') -----
  printNonPointerDataOf: oop on: aStream
  	<var: 'aStream' type: #'FILE *'>
+ 	| elementsPerLine format lastIndex |
- 	| elementsPerLine format lastIndex sixteenSpaces |
  	format := self formatOf: oop.
  	self assert: (format between: self sixtyFourBitIndexableFormat and: self firstCompiledMethodFormat - 1).
  	lastIndex := self lengthOf: oop format: format.
  	lastIndex = 0 ifTrue:
  		[^self].
- 	sixteenSpaces := '                '.
  	format = self sixtyFourBitIndexableFormat ifTrue:
  		[lastIndex := 32 min: lastIndex.
  		 elementsPerLine := 4. "0x/16r0123456789ABCDEF<space|cr> x 4 = 76/80"
  		 1 to: lastIndex do:
+ 			[:index|
+ 			'%19P%c' f: aStream printf: {
+ 				self cCoerceSimple: (self fetchLong64: index - 1 ofObject: oop) to: #usqLong.
- 			[:index| | v64 |
- 			v64 := self cCoerceSimple: (self fetchLong64: index - 1 ofObject: oop) to: #usqLong.
- 			'%.*s16r%lx%c' f: aStream printf: {
- 				64 - (v64 highBit max: 1) // 4.
- 				sixteenSpaces.
- 				v64.
  				(index \\ elementsPerLine = 0 or: [index = lastIndex])
  					ifTrue: [Character cr] ifFalse: [Character space] }].
  		 ^self].
  	format < self firstShortFormat ifTrue:
  		[lastIndex := 64 min: lastIndex.
  		 elementsPerLine := 8. "0x/16r12345678<space|cr> x 8 = 80/88"
  		1 to: lastIndex do:
+ 			[:index|
+ 			'%11P%c' f: aStream printf: {
+ 				self cCoerceSimple: (self fetchLong32: index - 1 ofObject: oop) to: #unsigned.
- 			[:index| | v32 |
- 			v32 := self cCoerceSimple: (self fetchLong32: index - 1 ofObject: oop) to: #unsigned.
- 			'%.*s16r%lx%c' f: aStream printf: {
- 				32 - (v32 highBit max: 1) // 4.
- 				sixteenSpaces.
- 				v32.
  				(index \\ elementsPerLine = 0 or: [index = lastIndex])
  					ifTrue: [Character cr] ifFalse: [Character space] }].
  		 ^self].
  	format < self firstByteFormat ifTrue:
  		[lastIndex := 128 min: lastIndex.
  		 elementsPerLine := 10. "0x/16r1234<space|cr> x 10 = 70/80"
  		1 to: lastIndex do:
+ 			[:index|
+ 			'%7P%c' f: aStream printf: {
+ 				self fetchShort16: index - 1 ofObject: oop.
- 			[:index| | v16 |
- 			v16 := self fetchShort16: index - 1 ofObject: oop.
- 			'%.*s16r%lx%c' f: aStream printf: {
- 				16 - (v16 highBit max: 1) // 4.
- 				sixteenSpaces.
- 				v16.
  				(index \\ elementsPerLine = 0 or: [index = lastIndex])
  					ifTrue: [Character cr] ifFalse: [Character space] }].
  		 ^self].
  	lastIndex := 256 min: lastIndex.
  	elementsPerLine := 16. "0x/16r12<space|cr> x 16 = 80/96"
  	1 to: lastIndex do:
+ 		[:index|
+ 		'%5P%c' f: aStream printf: {
+ 			self fetchByte: index - 1 ofObject: oop.
- 		[:index| | v8 |
- 		v8 := self fetchByte: index - 1 ofObject: oop.
- 		'%.*s16r%lx%c' f: aStream printf: {
- 			8 - (v8 highBit max: 1) // 4.
- 			sixteenSpaces.
- 			v8.
  			(index \\ elementsPerLine = 0 or: [index = lastIndex])
  				ifTrue: [Character cr] ifFalse: [Character space] }]!

Item was changed:
  ----- Method: SpurMemoryManager>>printStringDataOf:on: (in category 'debug printing interpreter support') -----
  printStringDataOf: oop on: aStream
  	<var: 'aStream' type: #'FILE *'>
  	| i limit n |
  	<var: 'buffer' type: #'char *'>
  	<var: 'wideBuffer' type: #'unsigned int *'>
  	(self isBytesNonImm: oop)
  		ifTrue:
  			[| buffer byte |
  			 buffer := self alloca: 256 * 4.
  			 n := i := 0.
  			 limit := (self numBytesOfBytes: oop) min: 256.
  			 [n < limit] whileTrue:
  				[byte := self fetchByte: i ofObject: oop.
  				 (byte < 32 "space" and: [byte ~= 9 "tab"])
  					ifTrue:
  						[buffer at: n put: $<. n := n + 1.
  						 (byte = 10 or: [byte = 13])
  							ifTrue:
  								[byte = 10
  									ifTrue: [buffer at: n put: $L; at: n + 1 put: $F]
  									ifFalse: [buffer at: n put: $C; at: n + 1 put: $R].
  								 n := n + 2]
  							ifFalse:
  								[byte >= 10 ifTrue:
  									[buffer at: n put: byte // 10 + $0 asInteger. n := n + 1].
  								 buffer at: n put: byte \\ 10 + $0 asInteger. n := n + 1].
  						 buffer at: n put: $>. n := n + 1]
  					ifFalse: [buffer at: n put: byte. n := n + 1]].
  			 '%.*s%s\n' f: aStream printf: { n. buffer. (self numBytesOfBytes: oop) > limit ifTrue: ['...'] ifFalse: [''] }]
  		ifFalse:
  			[| wideBuffer word |
  			 self assert: (self isWordsNonImm: oop).
  			 wideBuffer := self cCoerce: (self alloca: 1024 * 4) to: 'int *'.
  			 n := i := 0.
  			 limit := (self lengthOf: oop) min: 256.
  			 [i < limit] whileTrue:
  				[word := self fetchLong32: i ofObject: oop.
  				 (word < 32 "space" and: [word ~= 9 "tab"])
  					ifTrue:
  						[wideBuffer at: n put: $<. n := n + 1.
  						 (word = 10 or: [word = 13])
  							ifTrue:
  								[word = 10
  									ifTrue: [wideBuffer at: n put: $L; at: n + 1 put: $F]
  									ifFalse: [wideBuffer at: n put: $C; at: n + 1 put: $R].
  								 n := n + 2]
  							ifFalse:
  								[word >= 10 ifTrue:
  									[wideBuffer at: n put: word // 10 + $0 asInteger. n := n + 1].
  								 wideBuffer at: n put: word \\ 10 + $0 asInteger. n := n + 1].
  						 wideBuffer at: n put: $>. n := n + 1]
  					ifFalse: [wideBuffer at: n put: word. n := n + 1]].
+ 			 '%.*ls%s\n' f: aStream wprintf: { n. wideBuffer. (self lengthOf: oop) > limit ifTrue: ['...'] ifFalse: [''] }]!
- 			 '%.*s%s\n' f: aStream wprintf: { n. wideBuffer. (self lengthOf: oop) > limit ifTrue: ['...'] ifFalse: [''] }]!

Item was added:
+ ----- Method: StackInterpreter>>framePrintDescription: (in category 'debug printing') -----
+ framePrintDescription: it
+ 	<inline: false>
+ 	it ~= 0 ifTrue:
+ 		[it = objectMemory nilObject
+ 			ifTrue: [transcript fprintf: '=nil']
+ 			ifFalse: ['=%ld' f: transcript printf: it]].!

Item was added:
+ ----- Method: StackInterpreter>>frameRange:to: (in category 'debug printing') -----
+ frameRange: ignored to: shunned
+ 	"This is a hook to be overridden in the simulators"
+ 	<inline: #always>!

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"
  	| fmt lastIndex startIP column cls |
  
  	(objectMemory isImmediate: oop) ifTrue:
  		[^objectMemory printImmediateObject: oop on: transcript].
  	(objectMemory addressCouldBeObj: oop) ifFalse:
  		[^objectMemory printCantBeObject: oop on: transcript].
  	(objectMemory isFreeObject: oop) ifTrue:
  		[^objectMemory printFreeObject: oop on: transcript].
  	 (objectMemory isForwarded: oop) ifTrue:
  		[^objectMemory printForwarder: oop on: transcript].
  	
  	(cls := objectMemory fetchClassOfNonImm: oop)
+ 		ifNil: ['%P has a nil class!!!!\n' f: transcript printf: oop asVoidPointer]
- 		ifNil: ['16r%lx has a nil class!!!!\n' f: transcript printf: oop]
  		ifNotNil:
  			[| className length |
  			className := self nameOfClass: cls lengthInto: (self addressOf: length put: [:v| length := v]).
+ 			'%P: a(n) %.*s' f: transcript printf: {oop. length. className }.
- 			'16r%lx: a(n) %.*s' f: transcript printf: {oop. length. className }.
  			objectMemory hasSpurMemoryManagerAPI ifTrue:
+ 				['(%lx=>%P)' f: transcript printf: { objectMemory compactClassIndexOf: oop. cls asVoidPointer }]].
- 				['(%lx=>16r%lx)' f: transcript printf: { objectMemory compactClassIndexOf: oop. cls }]].
  	fmt := objectMemory formatOf: oop.
  	' format %lx' f: transcript printf: fmt.
  	fmt > objectMemory lastPointerFormat
  		ifTrue: [' nbytes %ld' f: transcript printf:  (objectMemory numBytesOf: oop)]
  		ifFalse: [(objectMemory isIndexableFormat: fmt) ifTrue:
  					[| len |
  					len := objectMemory lengthOf: oop.
  					' size %ld' f: transcript printf: len - (objectMemory fixedFieldsOf: oop format: fmt length: len)]].
  	objectMemory printHeaderTypeOf: oop on: transcript.
+ 	self print: ' hash '; printHex: (objectMemory rawHashBitsOf: oop).
- 	self print: ' hash '; printHexnp: (objectMemory rawHashBitsOf: 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:
  			[^' datasize %ld %s @ %p\n' f: transcript printf:
  				{objectMemory sizeFieldOfAlien: oop.
  				  (self isIndirectAlien: oop)
  							ifTrue: ['indirect']
  							ifFalse:
  								[(self isPointerAlien: oop)
  									ifTrue: ['pointer']
  									ifFalse: ['direct']].
+ 				 self startOfAlienData: oop }].
- 				 (self startOfAlienData: oop) asUnsignedInteger }].
  		(self is: oop KindOfClass: (self superclassOf: (objectMemory splObj: ClassString))) ifTrue:
  			[^objectMemory printStringDataOf: oop on: transcript].
  		 ^objectMemory printNonPointerDataOf: oop on: transcript].
  	startIP := fmt >= objectMemory firstCompiledMethodFormat
  				ifTrue: [(self startPCOfMethod: oop) / objectMemory wordSize]
  				ifFalse: [objectMemory numSlotsOf: oop].
  	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 printOopShortInner: fieldOop].
  			self cr]].
  	(objectMemory isCompiledMethod: oop)
  		ifFalse:
  			[startIP > lastIndex ifTrue: [self print: '...'; cr]]
  		ifTrue:
  			[startIP := (self startPCOfMethod: oop) + 1.
  			 lastIndex := objectMemory lengthOf: oop.
  			 lastIndex - startIP > 256 ifTrue:
  				[lastIndex := startIP + 256].
  			 column := 1.
  			 startIP to: lastIndex do:
  				[:index| | byte |
  				column = 1 ifTrue:
+ 					['%11P' f: transcript printf: (oop+BaseHeaderSize+index-1) asVoidPointer].
- 					[(self cCode: ['%08p: '] inSmalltalk: ['16r%08x: '])
- 						f: transcript
- 						printf: (oop+BaseHeaderSize+index-1) asUnsignedIntegerPtr].
  				byte := objectMemory fetchByte: index - 1 ofObject: oop.
  				'%02x/%-3d%c'
  					f: transcript
  					printf: { byte. byte. column = 8 ifTrue: [Character cr] ifFalse: [Character space] }.
  				(column := column + 1) > 8 ifTrue: [column := 1]].
  			(objectMemory lengthOf: oop) > lastIndex ifTrue:
  				[self print: '...'].
  			(column between: 2 and: 7) ifTrue:
  				[self cr]]!

Item was changed:
  ----- Method: StackInterpreter>>printCallStackOf:currentFP: (in category 'debug printing') -----
  printCallStackOf: aContext currentFP: currFP
+ 	<var: #currFP type: #'char *'>
  	| ctxt theFP thePage |
  	<inline: false>
- 	<var: #currFP type: #'char *'>
- 	<var: #theFP type: #'char *'>
- 	<var: #thePage type: #'StackPage *'>
  	ctxt := aContext.
  	[ctxt = objectMemory nilObject] whileFalse:
  		[(self isMarriedOrWidowedContext: ctxt)
  			ifFalse:
  				[self shortPrintContext: ctxt.
  				 ctxt := objectMemory fetchPointer: SenderIndex ofObject: ctxt]
  			ifTrue:
  				[theFP := self frameOfMarriedContext: ctxt.
  				 (self checkIsStillMarriedContext: ctxt currentFP: currFP)
  					ifTrue:
  						[thePage := stackPages stackPageFor: theFP.
  						 (stackPages isFree: thePage) ifTrue:
+ 							['%P is on a free page?!!\n' f: transcript printf: theFP.
- 							[self printHexPtr: theFP; print: ' is on a free page?!!'; cr.
  							 ^nil].
  						 self shortPrintFrameAndCallers: theFP.
  						 theFP := thePage baseFP.
  						 ctxt := self frameCallerContext: theFP.
  						 (objectMemory isForwarded: ctxt) ifTrue:
  							[ctxt := objectMemory followForwarded: ctxt]]
+ 					ifFalse: ['widowed caller frame %P\n' f: transcript printf: theFP.
- 					ifFalse: [self print: 'widowed caller frame '; printHexPtr: theFP; cr.
  							^nil]]]!

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: ' (';
+ 				printHex: (self withoutSmallIntegerTags: sender); printChar: $); cr.
- 				printHexPtr: (self withoutSmallIntegerTags: sender); printChar: $); cr.
  			 self print: 'ip       '; printNum: ip; print: ' (';
+ 				printHex: (self withoutSmallIntegerTags: ip); printChar: $); cr]
- 				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>>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)].
+ 		'%P is not in the stack zone?!!\n' f: transcript printf: theFP.
- 		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:
+ 				['%P is on a free page?!!\n' f: transcript printf: theFP.
- 				[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:
+ 		[transcript fprintf: 'could not find sp; using bogus value\n'.
- 		[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
+ 	<var: #theFP type: #'char *'>
+ 	<var: #theSP type: #'char *'>
  	<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"
  	| 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:
+ 		['%P is not in the stack zone?!!\n' f: transcript printf: theFP.
- 		[self printHexPtr: theFP; print: ' is not in the stack zone?!!'; cr.
  		 ^nil].
  	theMethod := self frameMethod: theFP.
  	numArgs := self frameNumArgs: theFP.
  	self shortPrintFrame: theFP.
+ 	self frameRange: theFP + (self frameStackedReceiverOffsetNumArgs: numArgs) to: theSP.
  	self printFrameOop: 'rcvr/clsr'
+ 		at: theFP + (self frameStackedReceiverOffsetNumArgs: numArgs).
- 		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 added:
+ ----- Method: StackInterpreter>>printFrameAddress: (in category 'debug printing') -----
+ printFrameAddress: address
+ 	"N.B. overridden in the simulators to add fp/sp indications"
+ 	<inline: #always>
+ 	'%WP:' f: transcript printf: address asVoidPointer!

Item was changed:
  ----- Method: StackInterpreter>>printFrameFlagsForFP: (in category 'debug printing') -----
  printFrameFlagsForFP: theFP
  	| address it |
  	<inline: false>
  	<var: #theFP type: #'char *'>
  	<var: #address type: #'char *'>
  	address := theFP + FoxFrameFlags.
  	it := stackPages longAt: address.
+ 	self printFrameAddress: address.
+ 	'       flags: %P' f: transcript printf: it asVoidPointer.
- 	self printHexPtr: address;
- 		print: ':       flags: ';
- 		printHex: it.
  	it ~= 0 ifTrue:
  		[self printChar: $=; printNum: it].
+ 	'  numArgs: %d %sContext %sBlock\n'
+ 		f: transcript
+ 		printf: { self frameNumArgs: theFP.
+ 				(self frameHasContext: theFP) ifTrue: ['is'] ifFalse: ['no'].
+ 				(self frameIsBlockActivation: theFP) ifTrue: ['is'] ifFalse: ['not'] }!
- 	self print: '  numArgs: '; printNum: (self frameNumArgs: theFP);
- 		print: ((self frameHasContext: theFP) ifTrue: [' hasContext'] ifFalse: [' noContext']);
- 		print: ((self frameIsBlockActivation: theFP) ifTrue: [' isBlock'] ifFalse: [' notBlock']);
- 		cr!

Item was changed:
  ----- Method: StackInterpreter>>printFrameOop:at: (in category 'debug printing') -----
  printFrameOop: name at: address
- 	| it |
- 	<inline: false>
  	<var: #name type: #'char *'>
  	<var: #address type: #'char *'>
+ 	<inline: false>
+ 	| it |
  	it := stackPages longAt: address.
+ 	self printFrameAddress: address.
+ 	(self pst: '%12s: %WP\t=') f: transcript printf: { name. it asVoidPointer }.
+ 	self printOopShortInner: it; cr!
- 	self printHexPtr: address;
- 		printChar: $:.
- 	1 to: 12 - (self strlen: name) do: [:i| self printChar: $ ].
- 	self print: name;
- 		print: ': ';
- 		printHex: it;
- 		tab;
- 		printChar: $=;
- 		printOopShort: it;
- 		cr!

Item was changed:
  ----- Method: StackInterpreter>>printFrameOop:index:at: (in category 'debug printing') -----
  printFrameOop: name index: idx at: address
- 	| it |
- 	<inline: false>
  	<var: #name type: #'char *'>
  	<var: #address type: #'char *'>
+ 	<inline: false>
+ 	| it |
  	it := stackPages longAt: address.
+ 	self printFrameAddress: address.
+ 	(self pst: '%s%10s%d: %WP\t')
+ 		f: transcript
+ 		printf: { idx > 9 ifTrue: [''] ifFalse: [' ']. name. idx. it asVoidPointer }.
+ 	self printOopShortInner: it; cr!
- 	self printHexPtr: address;
- 		printChar: $:.
- 	1	to: 11 - (self strlen: name) - (self log10: (idx max: 1)) floor
- 		do: [:i| self printChar: $ ].
- 	self print: name;
- 		printNum: idx;
- 		print: ': ';
- 		printHex: it;
- 		tab;
- 		printChar: $=;
- 		printOopShort: it;
- 		cr!

Item was changed:
  ----- Method: StackInterpreter>>printFrameThing:andFrame:at: (in category 'debug printing') -----
  printFrameThing: name andFrame: theFP at: address
- 	<var: #theFP type: #'char *'>
- 	| it len |
- 	<inline: false>
  	<var: #name type: #'char *'>
+ 	<var: #theFP type: #'char *'>
  	<var: #address type: #'char *'>
+ 	<inline: false>
+ 	| it |
+ 	self frameRange: 0 to: 0. "this method is used by checkStackIntegrity, so SP/SP indications are not wanted"
  	it := stackPages longAt: address.
+ 	self printFrameAddress: address.
+ 	(self pst: '%12s: %WP') f: transcript printf: { name. it asVoidPointer }.
- 	self printHexPtr: address;
- 		printChar: $:.
- 	len := self strlen: name.
- 	1 to: 12 - len do: [:i| self space].
- 	self print: name;
- 		print: ': ';
- 		printHex: it.
  	it ~= 0 ifTrue:
+ 		[it = objectMemory nilObject
+ 			ifTrue: [transcript fprintf: '=nil']
+ 			ifFalse: ['=%ld' f: transcript printf: it]].
+ 	' frame: %P\n' f: transcript printf: theFP!
- 		[self printChar: $=.
- 		 it = objectMemory nilObject
- 			ifTrue: [self print: 'nil']
- 			ifFalse:
- 				[self printNum: it]].
- 	self print: ' frame: '; printHexPtr: theFP; cr!

Item was changed:
  ----- Method: StackInterpreter>>printFrameThing:at: (in category 'debug printing') -----
  printFrameThing: name at: address
+ 	<inline: #always>
+ 	self printFrameThing: name at: address extraString: nil!
- 	| it len |
- 	<inline: false>
- 	<var: #name type: #'char *'>
- 	<var: #address type: #'char *'>
- 	it := stackPages longAt: address.
- 	self printHexPtr: address;
- 		printChar: $:.
- 	len := self strlen: name.
- 	1 to: 12 - len do: [:i| self space].
- 	self print: name;
- 		print: ': ';
- 		printHex: it.
- 	it ~= 0 ifTrue:
- 		[self printChar: $=.
- 		 it = objectMemory nilObject
- 			ifTrue: [self print: 'nil']
- 			ifFalse:
- 				[self printNum: it]].
- 	self cr!

Item was added:
+ ----- Method: StackInterpreter>>printFrameThing:at:extraString: (in category 'debug printing') -----
+ printFrameThing: name at: address extraString: extraStringOrNil
+ 	<var: #name type: #'char *'>
+ 	<var: #address type: #'char *'>
+ 	<inline: false>
+ 	| it |
+ 	it := stackPages longAt: address.
+ 	self printFrameAddress: address.
+ 	(self pst: '%12s: %WP') f: transcript printf: {name. it }.
+ 	self framePrintDescription: it.
+ 	extraStringOrNil ifNotNil: ['%s' f: transcript printf: extraStringOrNil].
+ 	self cr!

Item was changed:
  ----- Method: StackInterpreter>>printHex: (in category 'debug printing') -----
  printHex: n
  	"Print n in hex,  in the form '    0x1234', padded to a width of 10 characters
  	 in 32-bits ('0x' + 8 nibbles) or 18 characters in 64-bits ('0x' + 16 nibbles).
  	 In the simulator use 16r as the prefix, padding to 11 characters in 32-bits
  	 or 19 characters in 64-bits."
  	<api>
  	<var: #n type: #usqInt>
  	<inline: false>
+ 	(self pst: '%WP') f: transcript printf: n asVoidPointer!
- 	'%.*s16r%lx' f: transcript printf: { BytesPerWord * 8 - (n highBit max: 1) // 4. '                '. n }!

Item was removed:
- ----- Method: StackInterpreter>>printHexPtr: (in category 'debug printing') -----
- printHexPtr: p
- 	"Print p in hex, padded to 10 characters in the form '    0x1234'"
- 	<inline: true>
- 	<var: #p type: #'void *'>
- 	self printHex: (self oopForPointer: p)!

Item was changed:
  ----- Method: StackInterpreter>>printHexPtrnp: (in category 'debug printing') -----
  printHexPtrnp: p
  	"Print p in hex, unpadded, in the form 0x1234 (C)/16r1234 (here)"
+ 	<inline: false>
- 	<inline: true>
  	<var: #p type: #'void *'>
+ 	^'%P' f: transcript printf: p!
- 	^'16r%lx' f: transcript printf: p asUnsignedInteger!

Item was changed:
  ----- Method: StackInterpreter>>printHexnp: (in category 'debug printing') -----
  printHexnp: n
  	<api>
  	<var: #n type: #usqInt>
  	"Print n in hex,  in the form '0x1234', unpadded"
+ 	^'%P' f: transcript printf: n asVoidPointer!
- 	^'16r%lx' f: transcript printf: n!

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 className length |
  	<inline: false>
  	(objectMemory isImmediate: oop) ifTrue:
  		[^objectMemory printImmediateObject: oop on: transcript].
  	(objectMemory addressCouldBeObj: oop) ifFalse:
  		[^objectMemory printCantBeObject: oop on: transcript].
  	(objectMemory isFreeObject: oop) ifTrue:
  		[^objectMemory printFreeObject: oop on: transcript].
  	 (objectMemory isForwarded: oop) ifTrue:
  		[^objectMemory printForwarder: oop on: transcript].
  	
  	(cls := objectMemory fetchClassOfNonImm: oop) ifNil:
+ 		[^'%P has a nil class!!!!\n' f: transcript printf: oop].
- 		[^'16r%lx has a nil class!!!!\n' f: transcript printf: oop].
  	className := self nameOfClass: cls lengthInto: (self addressOf: length put: [:v| length := v]).
+ 	'%P: a(n) %.*s' f: transcript printf: {oop. length. className }.
- 	'16r%lx: a(n) %.*s' f: transcript printf: {oop. length. className }.
  	cls = (objectMemory splObj: ClassFloat) ifTrue:
  		[^'\n%g\n' f: transcript printf: (objectMemory dbgFloatValueOf: oop)].
  	fmt := objectMemory formatOf: oop.
  	fmt > objectMemory lastPointerFormat ifTrue:
  		[' nbytes %ld' f: transcript printf: (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:
  			[^' datasize %ld %s @ %p\n' f: transcript printf:
  				{objectMemory sizeFieldOfAlien: oop.
  				  (self isIndirectAlien: oop)
  							ifTrue: ['indirect']
  							ifFalse:
  								[(self isPointerAlien: oop)
  									ifTrue: ['pointer']
  									ifFalse: ['direct']].
  				 (self startOfAlienData: oop) asUnsignedInteger }].
  		(self is: oop KindOfClass: (self superclassOf: (objectMemory splObj: ClassString))) ifTrue:
  			[^objectMemory printStringDataOf: oop on: transcript].
  		 ^objectMemory printNonPointerDataOf: oop on: transcript].
  	startIP := fmt >= objectMemory firstCompiledMethodFormat
  				ifTrue: [(self startPCOfMethod: oop) / objectMemory wordSize]
  				ifFalse: [objectMemory numSlotsOf: oop].
  	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 := (self startPCOfMethod: oop) + 1.
  			 lastIndex := objectMemory lengthOf: oop.
  			 lastIndex - startIP > 256 ifTrue:
  				[lastIndex := startIP + 256].
  			 bytecodesPerLine := 8.
  			 column := 1.
  			 startIP to: lastIndex do:
  				[:index| | byte |
  				column = 1 ifTrue:
+ 					['%11P' f: transcript printf: (oop+BaseHeaderSize+index-1) asVoidPointer].
- 					[(self cCode: ['%08p: '] inSmalltalk: ['16r%08x: '])
- 						f: transcript
- 						printf: (oop+BaseHeaderSize+index-1) asUnsignedIntegerPtr].
  				byte := objectMemory fetchByte: index - 1 ofObject: oop.
  				' %02x/%-3d' f: transcript printf: { self cCoerceSimple: byte to: #int. self cCoerceSimple: byte to: #int }.
  				column := column + 1.
  				column > bytecodesPerLine ifTrue:
  					[column := 1. self cr]].
  			(objectMemory lengthOf: oop) > lastIndex ifTrue:
  				[self print: '...'].
  			column = 1 ifFalse:
  				[self cr]]!

Item was changed:
  ----- Method: StackInterpreter>>printOopShortInner: (in category 'debug printing') -----
  printOopShortInner: oop
  	| classOop name nameLen |
  	<var: #name type: #'char *'>
  	<inline: false>
  	(objectMemory isImmediate: oop) ifTrue:
  		[(objectMemory isImmediateCharacter: oop) ifTrue:
  			[^'$%c(%x)' f: transcript printf: { objectMemory characterValueOf: oop. objectMemory characterValueOf: oop }].
  		 (objectMemory isIntegerObject: oop) ifTrue:
  			[^'%ld(16r%lx)' f: transcript printf: { objectMemory integerValueOf: oop. objectMemory integerValueOf: oop }].
  		 (objectMemory isImmediateFloat: oop) ifTrue:
  			[^'%g(16r%lx)' f: transcript printf: {objectMemory dbgFloatValueOf: oop. oop}].
+ 		 ^'unknown immediate %P' f: transcript printf: oop asVoidPointer].
- 		 ^'unknown immediate 16r%lx' f: transcript printf: oop].
  	(objectMemory addressCouldBeObj: oop) ifFalse:
  		[^self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
  						ifTrue: [' is misaligned']
  						ifFalse: [self whereIs: oop])].
  	(objectMemory isFreeObject: oop) ifTrue:
  		[^self print: ' is a free chunk'].
  	(objectMemory isForwarded: oop) ifTrue:
  		[| target |
  		 target := objectMemory followForwarded: oop.
+ 		 ^' is a forwarder to %P' f: transcript printf: target asVoidPointer].
- 		 ^' is a forwarder to 16r%lx' f: transcript printf: target].
  	(self isFloatObject: oop) ifTrue:
  		[^self printFloat: (objectMemory dbgFloatValueOf: oop)].
  	classOop := objectMemory fetchClassOfNonImm: oop.
  	(objectMemory addressCouldBeObj: classOop) ifFalse:
  		[^self print: 'a ??'].
  	(objectMemory numSlotsOf: classOop) = metaclassNumSlots ifTrue:
  		[^self printNameOfClass: oop count: 5].
  	oop = objectMemory nilObject ifTrue: [^self print: 'nil'].
  	oop = objectMemory trueObject ifTrue: [^self print: 'true'].
  	oop = objectMemory falseObject ifTrue: [^self print: 'false'].
  	nameLen := self lengthOfNameOfClass: classOop.
  	nameLen = 0 ifTrue: [^self print: 'a ??'].
  	name := self nameOfClass: classOop.
  	nameLen = 10 ifTrue:
  		[(self strncmp: name _: 'ByteString' _: 10) = 0 "strncmp is weird" ifTrue:
  			[^self printChar: $'; printStringOf: oop; printChar: $'].
  		 (self strncmp: name _: 'ByteSymbol' _: 10) = 0 "strncmp is weird" ifTrue:
  			[self printChar: $#; printStringOf: oop. ^self]].
  	(nameLen = 9 and: [(self strncmp: name _: 'Character' _: 9) = 0]) ifTrue:
  		[^self printChar: $$; printChar: (objectMemory integerValueOf: (objectMemory fetchPointer: 0 ofObject: oop))].
  	'a(n) %.*s' f: transcript printf: { nameLen. name }.
  	"Try to spot association-like things; they're all subclasses of LookupKey"
  	((objectMemory isPointersNonImm: oop)
  	 and: [(objectMemory instanceSizeOf: classOop) = (ValueIndex + 1)
  	 and: [(objectMemory isBytes: (objectMemory fetchPointer: KeyIndex ofObject: oop))]]) ifTrue:
  		[| classLookupKey |
  		 classLookupKey := objectMemory fetchClassOfNonImm: (objectMemory splObj: SchedulerAssociation).
  		 [classLookupKey = objectMemory nilObject ifTrue:
  			[^self].
  		  (objectMemory instanceSizeOf: classLookupKey) = (KeyIndex + 1)] whileFalse:
  			[classLookupKey := self superclassOf: classLookupKey].
  		 (self includesBehavior: classOop ThatOf: classLookupKey) ifTrue:
  			[self space;
  				printOopShortInner: (objectMemory fetchPointer: KeyIndex ofObject: oop);
  				print: ' -> ';
  				printHexnp: (objectMemory fetchPointer: ValueIndex ofObject: oop)]]!

Item was changed:
  ----- Method: StackInterpreter>>printStackPage:useCount: (in category 'debug printing') -----
  printStackPage: page useCount: n
  	<inline: false>
  	<var: #page type: #'StackPage *'>
+ 	self print: 'page '; printHex: (self cCode: [page] inSmalltalk: [page baseAddress]);
- 	self print: 'page '; printHexPtr: (self cCode: [page] inSmalltalk: [page baseAddress]);
  		print: ' ('; printNum: (stackPages pageIndexFor: page realStackLimit).
  	n >= 0 ifTrue:
  		[self print: ','; printNum: n].
  	self print: ')  (trace: '; printNum: page trace; printChar: $).
  	(stackPages isFree: page) ifTrue:
  		[self print: ' (free)'].
  	page = stackPages mostRecentlyUsedPage ifTrue:
  		[self print: ' (MRU)'].
  	page prevPage = stackPages mostRecentlyUsedPage ifTrue:
  		[self print: ' (LRU)'].
  	self cr; tab; print: 'ba: ';
+ 		printHex: page baseAddress; print: ' - sl: ';
+ 		printHex: page realStackLimit; print: ' - sl-so: ';
+ 		printHex: page realStackLimit - self stackLimitOffset; print: ' - la:';
+ 		printHex: page lastAddress.
- 		printHexPtr: page baseAddress; print: ' - sl: ';
- 		printHexPtr: page realStackLimit; print: ' - sl-so: ';
- 		printHexPtr: page realStackLimit - self stackLimitOffset; print: ' - la:';
- 		printHexPtr: page lastAddress.
  	(stackPages isFree: page) ifFalse:
+ 		[self cr; tab; print: 'baseFP '; printHex: page baseFP.
+ 		 self "cr;" tab; print: 'headFP '; printHex: page headFP.
+ 		 self "cr;" tab; print: 'headSP '; printHex: page headSP].
+ 	self cr; tab; print: 'prev '; printHex: (self cCode: 'page->prevPage' inSmalltalk: [page prevPage baseAddress]);
- 		[self cr; tab; print: 'baseFP '; printHexPtr: page baseFP.
- 		 self "cr;" tab; print: 'headFP '; printHexPtr: page headFP.
- 		 self "cr;" tab; print: 'headSP '; printHexPtr: page headSP].
- 	self cr; tab; print: 'prev '; printHexPtr: (self cCode: 'page->prevPage' inSmalltalk: [page prevPage baseAddress]);
  		print: ' ('; printNum: (stackPages pageIndexFor: page prevPage realStackLimit); printChar: $).
+ 	self tab; print: 'next '; printHex: (self cCode: 'page->nextPage' inSmalltalk: [page nextPage baseAddress]);
- 	self tab; print: 'next '; printHexPtr: (self cCode: 'page->nextPage' inSmalltalk: [page nextPage baseAddress]);
  		print: ' ('; printNum: (stackPages pageIndexFor: page nextPage realStackLimit); printChar: $).
  	self 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"
  	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:
+ 					['FP:%P @ %P\n' f: transcript printf: { theFP. theSP }].
- 					[self print: 'FP: '; printHexnp: theFP; print: ' @ '; printHexnp: theSP; cr].
  				 theSP := theSP + objectMemory wordSize].
+ 			  ((self frameHasContext: theFP)
+ 			   and: [oop = (self frameContext: theFP)]) ifTrue:
+ 					['FP:%P CTXT\n' f: transcript printf: theFP].
- 			  (self frameHasContext: theFP) ifTrue:
- 				[oop = (self frameContext: theFP) ifTrue:
- 					[self print: 'FP: '; printHexnp: theFP; print: ' CTXT'; cr]].
  			  oop = (self frameMethod: theFP) ifTrue:
+ 				['FP:%P MTHD\n' f: transcript printf: theFP].
- 				[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:
+ 					['FP:%P @ %P\n' f: transcript printf: { theFP. theSP }].
- 					[self print: 'FP: '; printHexnp: theFP; print: ' @ '; printHexnp: theSP; cr].
  				 theSP := theSP + objectMemory wordSize]]]!

Item was added:
+ ----- Method: StackInterpreter>>pst: (in category 'debug printing') -----
+ pst: aPrintfString
+ 	"This is a hook to allow the simulators to override %Wp to substitute W for BytesPerWord * 2 + 3,
+ 	 hence formatting hex values within the desired width, depending on word size. In production
+ 	 Slang translates %Wp to either %18p or %10p (because the width includes 0x).
+ 
+ 	 One would think one could use e.g.
+ 		'%.*p' printf: { PrintfPointerWidth, oop }
+ 	 but this is undefined behaviour, and in any case pads with zeros.
+ 	 And % .*p and/or %. *p are indeed undefined.  So for the time being we use
+ 	 %Wp and this translation hook."
+ 	<inline: #always>
+ 	^aPrintfString!

Item was changed:
  ----- Method: StackInterpreter>>shortPrintFrame: (in category 'debug printing') -----
  shortPrintFrame: theFP
  	<inline: false>
  	<var: #theFP type: #'char *'>
  	| rcvr |
  	(stackPages couldBeFramePointer: theFP) ifFalse:
  		[self print: 'invalid frame pointer'; cr.
  		 ^nil].
  	rcvr := self frameReceiver: theFP.
+ 	self printHex: theFP.
- 	self printHexPtr: theFP.
  	self space.
  	self printActivationNameFor: (self frameMethod: theFP)
  		receiver: rcvr
  		isBlock: (self frameIsBlockActivation: theFP)
  		firstTemporary: (self temporary: 0 in: theFP).
  	self space.
  	self shortPrintOop: rcvr "shortPrintOop: adds a cr"!

Item was changed:
  ----- Method: StackInterpreter>>shortPrintOop: (in category 'debug printing') -----
  shortPrintOop: oop
  	<inline: false>
  	| className length |
  	(objectMemory isImmediate: oop) ifTrue:
  		[^objectMemory printImmediateObject: oop on: transcript].
  	(objectMemory addressCouldBeObj: oop) ifFalse:
  		[^objectMemory printCantBeObject: oop on: transcript].
  	(objectMemory isFreeObject: oop) ifTrue:
  		[^objectMemory printFreeObject: oop on: transcript].
  	 (objectMemory isForwarded: oop) ifTrue:
  		[^objectMemory printForwarder: oop on: transcript].
  	className := self
  					nameOfClass: (objectMemory fetchClassOfNonImm: oop)
  					lengthInto: (self addressOf: length put: [:v| length := v]).
+ 	'%P: a(n) %.*s\n' f: transcript printf: {oop asVoidPointer. length. className }!
- 	'16r%lx: a(n) %.*s\n' f: transcript printf: {oop. length. className }!

Item was changed:
  ----- Method: StackInterpreter>>stackPointerForFramePointer: (in category 'frame access') -----
  stackPointerForFramePointer: theFP
  	| thePage frameAbove |
  	"c.f. the code in printFrame:"
  	<doNotGenerate>
  	frameAbove := nil.
  	^theFP = self headFramePointer
  		ifTrue: [self headStackPointer]
  		ifFalse:
  			[thePage := stackPages stackPageFor: theFP.
  			 (stackPages isFree: thePage) ifTrue:
+ 				['%P is on a free page?!!\n' f: transcript printf: theFP.
- 				[self printHexPtr: theFP; print: ' is on a free page?!!'; cr.
  				 ^nil].
  			 (thePage ~= stackPage
  			  and: [theFP = thePage headFP])
  				ifTrue: [thePage headSP]
  				ifFalse:
  					[frameAbove := self safeFindFrameAbove: theFP
  										on: thePage
  										startingFrom: ((thePage = stackPage
  														and: [self headFramePointer
  																between: thePage realStackLimit
  																and: thePage baseAddress])
  														ifTrue: [self headFramePointer]
  														ifFalse: [thePage headFP]).
  					 frameAbove ifNotNil:
  						[self frameCallerSP: frameAbove]]]
  !

Item was changed:
  StackInterpreterPrimitives subclass: #StackInterpreterSimulator
+ 	instanceVariableNames: 'parent bootstrapping byteCount breakCount sendCount lookupCount printSends printReturns printFrameRange printfConversions myBitBlt displayForm fakeForm filesOpen imageName pluginList mappedPluginEntries quitBlock displayView eventTransformer printFrameAtEachStep printBytecodeAtEachStep systemAttributes startMicroseconds lastYieldMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize atEachStepBlock disableBooleanCheat performFilters eventQueue assertVEPAES primTraceLog breakBlock inputSemaphoreIndex perMethodProfile'
- 	instanceVariableNames: 'parent bootstrapping byteCount breakCount sendCount lookupCount printSends printReturns myBitBlt displayForm fakeForm filesOpen imageName pluginList mappedPluginEntries quitBlock displayView eventTransformer printFrameAtEachStep printBytecodeAtEachStep systemAttributes startMicroseconds lastYieldMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize atEachStepBlock disableBooleanCheat performFilters eventQueue assertVEPAES primTraceLog breakBlock inputSemaphoreIndex perMethodProfile'
  	classVariableNames: 'ByteCountsPerMicrosecond'
  	poolDictionaries: ''
  	category: 'VMMaker-InterpreterSimulation'!
  
  !StackInterpreterSimulator commentStamp: 'eem 9/3/2013 11:05' prior: 0!
  This class defines basic memory access and primitive simulation so that the StackInterpreter can run simulated in the Squeak environment.  It also defines a number of handy object viewing methods to facilitate pawing around in the object memory.
  
  To see the thing actually run, you could (after backing up this image and changes), execute
  
  	(StackInterpreterSimulator new openOn: Smalltalk imageName) test
  
  	((StackInterpreterSimulator newWithOptions: #(NewspeakVM true MULTIPLEBYTECODESETS true))
  		openOn: 'ns101.image') test
  
  and be patient both to wait for things to happen, and to accept various things that may go wrong depending on how large or unusual your image may be.  We usually do this with a small and simple benchmark image.
  
  Here's an example of what Eliot uses to launch the simulator in a window.  The bottom-right window has a menu packed with useful stuff:
  
  | vm |
  vm := StackInterpreterSimulator newWithOptions: #().
  vm openOn: '/Users/eliot/Squeak/Squeak4.4/trunk44.image'.
  vm setBreakSelector: #&.
  vm openAsMorph; run!

Item was added:
+ ----- Method: StackInterpreterSimulator>>frameRange:to: (in category 'debug printing') -----
+ frameRange: highAddress to: lowAddress
+ 	printFrameRange := lowAddress to: highAddress!

Item was changed:
  ----- Method: StackInterpreterSimulator>>initialize (in category 'initialize-release') -----
  initialize
  	"Initialize the StackInterpreterSimulator when running the interpreter
  	 inside Smalltalk. The primary responsibility of this method is to allocate
  	 Smalltalk Arrays for variables that will be declared as statically-allocated
  	 global arrays in the translated code."
  	super initialize.
  
  	bootstrapping := false.
  	transcript := Transcript.
  
  	objectMemory ifNil:
  		[objectMemory := self class objectMemoryClass simulatorClass new].
  	objectMemory coInterpreter: self.
  
  	self assert: ConstMinusOne = (objectMemory integerObjectOf: -1).
  
  	methodCache := Array new: MethodCacheSize.
  	nsMethodCache := Array new: NSMethodCacheSize.
  	atCache := Array new: AtCacheTotalSize.
  	self flushMethodCache.
  	gcSemaphoreIndex := 0.
  	externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
  	externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
  	externalPrimitiveTableFirstFreeIndex := 0.
  	primitiveTable := self class primitiveTable copy.
  	self initializePluginEntries.
  	desiredNumStackPages := desiredEdenBytes := 0.
  	"This is initialized on loading the image, but convenient for testing stack page values..."
  	numStackPages := self defaultNumStackPages. 
  	startMicroseconds := lastYieldMicroseconds := self ioUTCStartMicroseconds.
  
  	"initialize InterpreterSimulator variables used for debugging"
  	byteCount := sendCount := lookupCount := 0.
  	quitBlock := [^self close].
  	printSends := printReturns := printFrameAtEachStep := printBytecodeAtEachStep := false.
  	myBitBlt := BitBltSimulator new setInterpreter: self.
  	displayForm := fakeForm := 'Display has not yet been installed' asDisplayText form.
  	suppressHeartbeatFlag := false.
  	systemAttributes := Dictionary new.
  	extSemTabSize := 256.
  	disableBooleanCheat := false.
+ 	assertVEPAES := false. "a flag so the assertValidExecutionPointers can be disabled for simulation speed and enabled when necessary.".
+ 	printFrameRange := 0 to: 0.
+ 	printfConversions := IdentityDictionary new!
- 	assertVEPAES := false. "a flag so the assertValidExecutionPointers can be disabled for simulation speed and enabled when necessary."!

Item was added:
+ ----- Method: StackInterpreterSimulator>>printFrameAddress: (in category 'debug printing') -----
+ printFrameAddress: address
+ 	"N.B. overridden in the simulators to add fp/sp indications"
+ 	((printFrameRange includes: framePointer)
+ 	 or: [(printFrameRange includes: stackPointer)
+ 	 or: [(printFrameRange includes: localFP)
+ 	 or: [(printFrameRange includes: localFP)]]]) ifTrue:
+ 		['%s%s%s%s\t'
+ 			f: transcript
+ 			printf:{	address = framePointer ifTrue: ['FP:'].
+ 					address = stackPointer ifTrue: ['SP:'].
+ 					address = localFP ifTrue: ['fp:'].
+ 					address = localSP ifTrue: ['sp:'] }].
+ 	self assert: address < 0.
+ 	'%8P/%d:'
+ 		f: transcript
+ 		printf: { address. stackPages memIndexFor: address }!

Item was removed:
- ----- Method: StackInterpreterSimulator>>printFrameFlagsForFP: (in category 'debug printing') -----
- printFrameFlagsForFP: theFP
- 	| address it |
- 	<inline: false>
- 	<var: #theFP type: #'char *'>
- 	<var: #address type: #'char *'>
- 	address := theFP + FoxFrameFlags.
- 	it := stackPages longAt: address.
- 	self printHex: address;
- 		printChar: $/;
- 		printNum: (stackPages memIndexFor: address);
- 		print: ':       flags: ';
- 		printHex: it.
- 	it ~= 0 ifTrue:
- 		[self printChar: $=; printNum: it].
- 	self print: '  numArgs: '; printNum: (self frameNumArgs: theFP);
- 		print: '  hasContext: '; printNum: (self frameHasContext: theFP);
- 		print: '  isBlock: '; printNum: (self frameIsBlockActivation: theFP);
- 		cr!

Item was removed:
- ----- Method: StackInterpreterSimulator>>printFrameOop:at: (in category 'debug printing') -----
- printFrameOop: name at: address
- 	| it |
- 	<inline: false>
- 	<var: #name type: #'char *'>
- 	<var: #address type: #'char *'>
- 	it := stackPages longAt: address.
- 	self printHex: address;
- 		printChar: $/;
- 		printNum: (stackPages memIndexFor: address);
- 		printChar: $:.
- 	1 to: 12 - (self strlen: name) do: [:i| self printChar: $ ].
- 	self print: name;
- 		print: ': ';
- 		printHex: it.
- 	self tab;
- 		print: (self shortPrint: it);
- 		cr!

Item was removed:
- ----- Method: StackInterpreterSimulator>>printFrameThing:andFrame:at: (in category 'debug printing') -----
- printFrameThing: name andFrame: theFP at: address
- 	<var: #theFP type: #'char *'>
- 	| it |
- 	<inline: false>
- 	<var: #name type: #'char *'>
- 	<var: #address type: #'char *'>
- 	it := stackPages longAt: address.
- 	self printHex: address;
- 		printChar: $/;
- 		printNum: (stackPages memIndexFor: address);
- 		printChar: $:.
- 	1 to: 12 - (self strlen: name) do: [:i| self printChar: $ ].
- 	self print: name;
- 		print: ': ';
- 		printHex: it.
- 	it ~= 0 ifTrue:
- 		[self printChar: $=; printNum: it].
- 	self print: ' frame: '; printHex: theFP; cr!

Item was removed:
- ----- Method: StackInterpreterSimulator>>printFrameThing:at: (in category 'debug printing') -----
- printFrameThing: name at: address
- 	| it |
- 	<inline: false>
- 	<var: #name type: #'char *'>
- 	<var: #address type: #'char *'>
- 	it := stackPages longAt: address.
- 	self printHex: address;
- 		printChar: $/;
- 		printNum: (stackPages memIndexFor: address);
- 		printChar: $:.
- 	1 to: 12 - (self strlen: name) do: [:i| self printChar: $ ].
- 	self print: name;
- 		print: ': ';
- 		printHex: it.
- 	it ~= 0 ifTrue:
- 		[self printChar: $=; printNum: it].
- 	self cr!

Item was added:
+ ----- Method: StackInterpreterSimulator>>pst: (in category 'debug printing') -----
+ pst: aPrintfString
+ 	"Override to map %WP to substitute W for BytesPerWord * 2 + 3, so that e.g. in 64 bits, '%WP' printf: 0 prints as <15 spaces>16r1.
+ 	 Except that because circa 2020 64-bit architectures provide a 56 bit virtual address space, and in the simulator we're restricted
+ 	 to a few gigabytes, use 15 characters (a 48 bit address space with 16r prefix)."
+ 	^printfConversions
+ 		at: aPrintfString
+ 		ifAbsentPut: [aPrintfString
+ 						copyReplaceAll: '%WP'
+ 						with: (BytesPerWord = 4
+ 								ifTrue: ['%11P']
+ 								ifFalse: ['%15P'])]!

Item was changed:
  ----- Method: TMethod>>isNode:substitutableFor:inMethod:in: (in category 'inlining') -----
  isNode: aNode substitutableFor: argName inMethod: targetMeth in: aCodeGen
  	"Answer if the given parameter node may be substituted directly into the body of
  	 the method during inlining, instead of being bound to the actual parameter variable.
  	 We allow a constant, a local variable, or a formal parameter, or simple expressions
  	 involving only these to to be directly substituted. Note that global variables cannot
  	 be subsituted into methods with possible side effects (i.e., methods that may assign
  	 to global variables) because the inlined method might depend on having the value of
  	 the global variable captured when it is passed in as an argument."
  
  	| theNode madeNonTrivialCall count constantExpression usageCount |
  	aNode isConstant ifTrue: [^true].
  
  	theNode := (aNode isSend and: [aNode isCast]) ifTrue: [aNode targetOfCast] ifFalse: [aNode].
  	theNode isVariable ifTrue:
  		[((locals includes: theNode name)
  		 or: [(args includes: theNode name)
  		 or: [#('self' 'true' 'false' 'nil') includes: theNode name]]) ifTrue: [^true].
  		"We can substitute any variable provided it is only read in the method being inlined,
  		 and if it is not read after any non-trivial call (which may update the variable)."
  		madeNonTrivialCall := false.
  		(targetMeth isComplete
  		 and: [targetMeth parseTree
  				noneSatisfy:
  					[:node|
  					 (node isSend
  					  and: [(aCodeGen isBuiltinSelector: node selector) not]) ifTrue:
  						[madeNonTrivialCall := true].
  					 (madeNonTrivialCall and: [node isVariable and: [node name = argName]])
  					 or: [node isAssignment
  						  and: [node variable name = argName]]]
  				unless:
  					[:node|
  					node isSend and: [aCodeGen isAssertSelector: node selector]]]) ifTrue:
  			[^true].
  		^targetMeth maySubstituteGlobal: theNode name in: aCodeGen].
  
+ 	"don't muck up asserts with complex expansions"
- 	"don't much up asserts with complex expansions"
  	(targetMeth usesVariableUninlinably: argName in: aCodeGen) ifTrue:
  		[^false].
  
  	"For now allow literal blocks to be substituted.  They better be accessed only
  	 with value[:value:*] messages though!!"
  	aNode isLiteralBlock ifTrue: [^true].
  
  	"Don't inline expressions unless type-compatible,"
  	aNode isSend ifTrue:
  		[(aCodeGen
  				isActualType: (aCodeGen returnTypeForSend: aNode in: self ifNil: #incompatible)
  				compatibleWithFormalType: (self typeFor: argName in: aCodeGen)) ifFalse:
  			[^false]].
  
  	count := 0.
  	constantExpression := true.
  	"scan expression tree; must contain only constants, builtin ops, and inlineable vars"
  	aNode nodesDo:
  		[:node|
  		node isConstant
  			ifTrue: [] ifFalse:
  		[node isSend
  			ifTrue:
  				[((VMBasicConstants mostBasicConstantSelectors includes: node selector)
  				  or: [node isBuiltinOperator]) ifFalse: [^false].
  				 count := count + 1] ifFalse:
  		[node isVariable ifTrue:
  			[(aCodeGen isNonArgumentImplicitReceiverVariableName: node name) ifFalse:
  				[constantExpression := false.
  				((locals includes: node name)
  				 or: [(args includes: node name)
  				 or: [(#('self' 'true' 'false' 'nil') includes: node name)
  				 or: [targetMeth maySubstituteGlobal: node name in: aCodeGen]]]) ifFalse: [^false]]] ifFalse:
  		[^false]]]].
  	"inline constant expressions"
  	constantExpression ifNil: [^true].
  
  	"scan target to find usage count"
  	usageCount := 0.
  	targetMeth parseTree nodesDo:
  		[:node|
  		(node isVariable and: [node name = argName]) ifTrue:
  			[usageCount := usageCount + 1]].
  	"(usageCount > 1 and: [count <= usageCount]) ifTrue:
  		[[UsageCounts := Dictionary new.
  		  self removeClassVarName: #UsageCounts].
  		 (UsageCounts at: usageCount ifAbsentPut: [Set new]) add: ({targetMeth. argName. aNode})]."
  	"Now only inline expressions if they are used only once or are simple
  	 w.r.t. the usage count, and the usage count is not large; a heuristic that seems to work well enough."
  	^usageCount = 1 or: [usageCount <= 7 and: [count <= usageCount]]!

Item was changed:
  ----- Method: TMethod>>prepareMethodIn: (in category 'transformations') -----
  prepareMethodIn: aCodeGen
  	"Record sends of builtin operators, map sends of the special selector dispatchOn:in:
  	 with case statement nodes, and map sends of caseOf:[otherwise:] to switch statements.
  	 Declare limit variables for to:[by:]do: loops with limits that potentially have side-effects.
  	 As a hack also update the types of variables introduced to implement cascades correctly.
  	 This has to be done at the same time as this is done, so why not piggy back here?"
+ 	aCodeGen maybeBreakForTestToInline: selector in: self.
  	extraVariableNumber ifNotNil:
  		[declarations keysAndValuesDo:
  			[:varName :decl|
  			decl isBlock ifTrue:
  				[self assert: ((varName beginsWith: 'cascade') and: [varName last isDigit]).
  				 locals add: varName.
  				 self declarationAt: varName
  					put: (decl value: self value: aCodeGen), ' ', varName]]].
  	aCodeGen
  		pushScope: declarations
  		while:"N.B.  nodesWithParentsDo: is bottom-up, hence replacement is destructive and conserved."
  			[parseTree nodesWithParentsDo:
  				[:node :parent|
  				 node isSend ifTrue:
  					[aCodeGen ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn: node.
  					 (aCodeGen isBuiltinSelector: node selector)
  						ifTrue:
  							[node isBuiltinOperator: true.
  							"If a to:by:do:'s limit has side-effects, declare the limit variable, otherwise delete it from the args"
  							 node selector = #to:by:do: ifTrue:
  								[self ensureToByDoLoopLimitIsSafeAndEfficient: node in: aCodeGen]]
  						ifFalse:
  							[(StackInterpreter isStackAccessor: node selector)
  								ifTrue: "compute and cache the accessor depth early, before inlining destroys the accessor chains"
  									[self export ifTrue:
  										[aCodeGen accessorDepthForMethod: self]]
  								ifFalse:
  									[(CaseStatements includes: node selector) ifTrue:
  										[parent replaceNodesIn: (Dictionary newFromPairs: { node. self buildCaseStmt: node in: aCodeGen})].
  									 (#(caseOf: #caseOf:otherwise:) includes: node selector) ifTrue:
  										[parent replaceNodesIn: (Dictionary newFromPairs: { node. self buildSwitchStmt: node parent: parent })].
  									 (#(printf: fprintf: f:printf: f:wprintf:) includes: node selector) ifTrue:
+ 										[self transformPrintf: node in: aCodeGen].
- 										[self transformPrintf: node].
  									(node receiver isVariable
  									 and: [node receiver name = #Character
  									 and: [node selector isUnary]]) ifTrue:
  										[parent replaceNodesIn: (Dictionary newFromPairs: { node. TConstantNode new setValue: (Character perform: node selector) })]]]]]]!

Item was removed:
- ----- Method: TMethod>>transformPrintf: (in category 'transformations') -----
- transformPrintf: sendNode
- 	"Handle forms of f:printf: & printf:. f:printf: is either
- 		logFile f: formatLiteral printf: args
- 	 or
- 		formatLiteral f: streamName printf: args
- 	 printf is
- 		formatLiteral printf: args"
- 	| map newArgs |
- 	newArgs := OrderedCollection new.
- 	sendNode changeClassTo: TVarArgsSendNode.
- 	sendNode args do:
- 		[:arg|
- 		arg isBrace
- 			ifTrue: [newArgs addAllLast: arg elements]
- 			ifFalse: [newArgs addLast: arg]].
- 	(sendNode receiver isConstant
- 	 and: [sendNode receiver value isString]) ifTrue:
- 		[| format |
-  		 format := sendNode receiver asPrintfFormatStringNode.
- 		 sendNode selector first == $f ifTrue: "fprintf et al..."
- 			[sendNode receiver: (TVariableNode new setName: 'self').
- 			 sendNode arguments: {sendNode args first. format}, newArgs allButFirst.
- 			 ^sendNode].
- 		sendNode receiver: format.
- 		sendNode arguments: newArgs.
- 		^sendNode].
- 	map := Dictionary new.
- 	sendNode nodesDo:
- 		[:subNode|
- 		 (subNode isConstant and: [subNode value isString and: [subNode value includes: $%]]) ifTrue:
- 			[map at: subNode put: subNode asPrintfFormatStringNode]].
- 	sendNode arguments: newArgs.
- 	sendNode replaceNodesIn: map.
- 	^sendNode!

Item was added:
+ ----- Method: TMethod>>transformPrintf:in: (in category 'transformations') -----
+ transformPrintf: sendNode in: aCodeGen
+ 	"Handle forms of f:printf: & printf:. f:printf: is either
+ 		logFile f: formatLiteral printf: args
+ 	 or
+ 		formatLiteral f: streamName printf: args
+ 	 printf is
+ 		formatLiteral printf: args"
+ 	sendNode
+ 		changeClassTo: TVarArgsSendNode;
+ 		transformPrintfFor: self in: aCodeGen!

Item was added:
+ ----- Method: TVarArgsSendNode>>bindVariablesIn: (in category 'transformations') -----
+ bindVariablesIn: aDictionary
+ 	"reduce ... printf: { ... '%s'. 'foo' } to printf: { ... 'foo' }, largely to minimise changes in generated slang on implementing %WP"
+ 	| size lastArg penultimateArg |
+ 	super bindVariablesIn: aDictionary.
+ 	(((size := arguments size) between: 2 and: 3)
+ 	and: [(penultimateArg := arguments at: size - 1) isConstant
+ 	and: [penultimateArg value = '%s'
+ 	and: [(lastArg := arguments at: size) isConstant
+ 	and: [lastArg value isString
+ 	and: [(lastArg value includes: $%) not]]]]]) ifTrue:
+ 		[arguments := arguments copyReplaceFrom: size - 1 to: size - 1 with: #()]!

Item was added:
+ ----- Method: TVarArgsSendNode>>isFileParameter:for:in: (in category 'transformations') -----
+ isFileParameter: node for: aTMethod in: aCodeGen
+ 	"Answer if node is a FILE * parameter."
+ 
+ 	^(node isConstant and: [#(stdin stdout stderr) identityIncludes: node value])
+ 	  or: [(aCodeGen typeFor: node in: aTMethod) = #'FILE *']!

Item was added:
+ ----- Method: TVarArgsSendNode>>transformPrintfFor:in: (in category 'transformations') -----
+ transformPrintfFor: aTMethod in: aCodeGen
+ 	"Handle forms of f:printf: & printf:. f:printf: is either
+ 		logFile f: formatLiteral printf: args
+ 	 or
+ 		formatLiteral f: streamName printf: args
+ 	 printf is
+ 		formatLiteral printf: args"
+ 	| map newArgs |
+ 	"precicely one of the arguments will be the format string. nodesDo: is top-down,
+ 	 left-to-right, so it will encounter the format string first."
+ 	map := Dictionary new.
+ 	self nodesDo:
+ 		[:subNode|
+ 		 (map isEmpty
+ 		  and: [subNode isConstant
+ 		  and: [subNode value isString and: [subNode value includes: $%]]]) ifTrue:
+ 			[map at: subNode put: subNode asPrintfFormatStringNode]].
+ 	self replaceNodesIn: map.
+ 
+ 	"inline any brace of arguments..."
+ 	newArgs := OrderedCollection new.
+ 	arguments do:
+ 		[:arg|
+ 		arg isBrace
+ 			ifTrue: [newArgs addAllLast: arg elements]
+ 			ifFalse: [newArgs addLast: arg]].
+ 
+ 	"ensure that the FILE * arg is first"
+ 	selector first == $f ifTrue:
+ 		[| originalReceiver |
+ 		 "format string will either be receiver or first argument. Use type of FILE * argument
+ 		   to determine which. This is because of the pst: hook in frame printing."
+ 		 self assert: ((self isFileParameter: receiver for: aTMethod in: aCodeGen)
+ 					or: [self isFileParameter: arguments first for: aTMethod in: aCodeGen]).
+ 		 originalReceiver := receiver.
+ 		 receiver := TVariableNode new setName: 'self'.
+ 		(self isFileParameter: originalReceiver for: aTMethod in: aCodeGen)
+ 			ifTrue: "transcript f: fmt printf: args => self f: transcript printf: fmt _: args"
+ 				[newArgs addFirst: originalReceiver]
+ 			ifFalse: "fmt f: transcript printf: args => self f: transcript printf: fmt _: args"
+ 				[newArgs add: originalReceiver afterIndex: 1]].
+ 	arguments := newArgs!

Item was changed:
  ----- Method: VMClass class>>initializeWithOptions: (in category 'initialization') -----
  initializeWithOptions: optionsDictionaryOrArray
  	"Initialize the receiver, typically initializing class variables. Initialize any class variables
  	 whose names occur in optionsDictionary with the corresponding values there-in."
  	InitializationOptions := optionsDictionaryOrArray isArray
  								ifTrue: [Dictionary newFromPairs: optionsDictionaryOrArray]
  								ifFalse: [optionsDictionaryOrArray].
  
  	ExpensiveAsserts := InitializationOptions at: #ExpensiveAsserts ifAbsent: [false].
  	self optionClassNames do:
  		[:optionClassName|
+ 		InitializationOptions at: optionClassName ifAbsentPut: false].
+ 
+ 	PrintfFormatDescriptor initializeForCog!
- 		InitializationOptions at: optionClassName ifAbsentPut: false]!



More information about the Vm-dev mailing list