[Vm-dev] VM Maker: VMMaker-dtl.359.mcz

commits at source.squeak.org commits at source.squeak.org
Sun Mar 29 00:27:01 UTC 2015


David T. Lewis uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker-dtl.359.mcz

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

Name: VMMaker-dtl.359
Author: dtl
Time: 28 March 2015, 8:14:27.879 pm
UUID: 3d5b8023-e045-437f-a85a-02036bc57e00
Ancestors: VMMaker-dtl.358

VMMaker 4.13.12
Implement primitiveIsBigEnder. Platform endianness can be deduced from the image, but some images may find this awkward, so provide the primitive as an assist.
Additional simulation support from oscog.
Code generation updates from oscog (excluding type inferencer because of translation time dependencies).
Various refactoring cleanups.
Fix undeclareds.
Object memory is responsible for #bytesPerWord and #baseHeaderSize, make it so in StackInterpreter.

=============== Diff against VMMaker-dtl.358 ===============

Item was changed:
  SystemOrganization addCategory: #'VMMaker-Building'!
  SystemOrganization addCategory: #'VMMaker-Interpreter'!
  SystemOrganization addCategory: #'VMMaker-InterpreterSimulation'!
  SystemOrganization addCategory: #'VMMaker-Plugins'!
  SystemOrganization addCategory: #'VMMaker-SmartSyntaxPlugins'!
  SystemOrganization addCategory: #'VMMaker-Translation to C'!
  SystemOrganization addCategory: #'VMMaker-Tests'!
  SystemOrganization addCategory: #'VMMaker-Support'!
  SystemOrganization addCategory: #'VMMaker-JIT'!
+ SystemOrganization addCategory: #'VMMaker-JITSimulation'!

Item was changed:
  Object subclass: #CCodeGenerator
+ 	instanceVariableNames: 'translationDict inlineList constants variables variableDeclarations scopeStack methods macros apiMethods preparedMethodList variablesSetCache headerFiles globalVariableUsage useSymbolicConstants generateDeadCode doNotRemoveMethodList asArgumentTranslationDict receiverDict vmClass currentMethod logger declareMethodsStatic permitMethodPruning pools abstractDeclarations uncheckedAbstractMethods selectorTranslations breakSrcInlineSelector breakDestInlineSelector inlineReturnTypes'
- 	instanceVariableNames: 'translationDict inlineList constants variables variableDeclarations scopeStack methods macros preparedMethodList variablesSetCache headerFiles globalVariableUsage useSymbolicConstants generateDeadCode doNotRemoveMethodList asArgumentTranslationDict receiverDict vmClass currentMethod logger declareMethodsStatic permitMethodPruning pools abstractDeclarations uncheckedAbstractMethods selectorTranslations breakSrcInlineSelector breakDestInlineSelector inlineReturnTypes'
  	classVariableNames: 'UseRightShiftForDivide'
  	poolDictionaries: ''
  	category: 'VMMaker-Translation to C'!
  
  !CCodeGenerator commentStamp: 'tpr 5/2/2003 14:30' prior: 0!
  This class oversees the translation of a subset of Smalltalk to C, allowing the comforts of Smalltalk during development and the efficiency and portability of C for the resulting interpreter.  
  See VMMaker for more useful info!

Item was added:
+ ReadStream subclass: #FakeStdinStream
+ 	instanceVariableNames: 'atEnd simulator'
+ 	classVariableNames: ''
+ 	poolDictionaries: 'VMBasicConstants'
+ 	category: 'VMMaker-JITSimulation'!
+ 
+ !FakeStdinStream commentStamp: '<historical>' prior: 0!
+ Fake Standard input using a dialog to prompt for a line of input at a time.!

Item was added:
+ ----- Method: FakeStdinStream class>>for: (in category 'instance creation') -----
+ for: aCogVMSimulator
+ 	^(self basicNew simulator: aCogVMSimulator)
+ 		on: (String new: 80) from: 1 to: 0
+ 
+ 	"self new next"!

Item was added:
+ ----- Method: FakeStdinStream class>>new (in category 'instance creation') -----
+ new
+ 	^super on: (String new: 80) from: 1 to: 0
+ 
+ 	"self new next"!

Item was added:
+ ----- Method: FakeStdinStream>>atEnd (in category 'testing') -----
+ atEnd
+ 	^atEnd ifNil: [atEnd := false]!

Item was added:
+ ----- Method: FakeStdinStream>>atEnd: (in category 'accessing') -----
+ atEnd: aBoolean
+ 	atEnd := aBoolean!

Item was added:
+ ----- Method: FakeStdinStream>>close (in category 'accessing') -----
+ close
+ 	atEnd := true!

Item was added:
+ ----- Method: FakeStdinStream>>next (in category 'accessing') -----
+ next
+ 	"Answer the next object in the Stream represented by the receiver.
+ 	 If there are no more elements in the stream fill up the buffer by prompting for input"
+ 	| sem inputLine next |
+ 	position >= readLimit ifTrue:
+ 		[simulator isThreadedVM
+ 			ifTrue:
+ 				["(simulator cogit singleStep not
+ 				  and: [UIManager confirm: 'Single step?']) ifTrue:
+ 					[simulator cogit singleStep: true]."
+ 				 "threadIndex := simulator disownVM: DisownVMLockOutFullGC." self flag: #FIXME. "oscog"
+ 				 simulator forceInterruptCheckFromHeartbeat.
+ 				 sem := Semaphore new.
+ 				 WorldState addDeferredUIMessage:
+ 					[inputLine := UIManager default request: 'Input please!!'.
+ 					 sem signal].
+ 				 sem wait]
+ 			ifFalse:
+ 				[inputLine := UIManager default request: 'Input please!!'].
+ 		 collection size <= inputLine size ifTrue:
+ 			[collection := collection species new: inputLine size + 1].
+ 		 collection
+ 			replaceFrom: 1 to: inputLine size with: inputLine startingAt: 1;
+ 		 	at: (readLimit := inputLine size + 1) put: Character lf.
+ 		 position := 0.
+ 		 "simulator isThreadedVM ifTrue:
+ 			[simulator ownVM: threadIndex]" self flag: #FiXME "oscog"].
+ 	next := collection at: (position := position + 1).
+ 	"This is set temporarily to allow (FilePluginSimulator>>#sqFile:Read:Into:At:
+ 	 to brwak out of its loop.  sqFile:Read:Into:At: resets it on the way out."
+ 	atEnd := position >= readLimit.
+ 	^next
+ 	
+ 
+ " This does it with workspaces:
+ | ws r s |
+ s := Semaphore new.
+ ws := Workspace new contents: ''.
+ ws acceptAction: [:t| r := t asString. s signal].
+ [ws openLabel: 'Yo!!'; shouldStyle: false.
+ (ws dependents detect: [:dep | dep isKindOf: PluggableTextMorph] ifNone: [nil]) ifNotNil:
+ 	[:textMorph| textMorph acceptOnCR: true; hasUnacceptedEdits: true]] fork.
+ Processor activeProcess ==  Project uiProcess
+ 	ifTrue: [[r isNil] whileTrue: [World doOneCycle]]
+ 	ifFalse: [s wait].
+ ws topView delete.
+ s wait. s signal.
+ r"!

Item was added:
+ ----- Method: FakeStdinStream>>simulator: (in category 'initialize-release') -----
+ simulator: aCogVMSimulator
+ 	simulator := aCogVMSimulator.
+ 	atEnd := false!

Item was changed:
  FilePlugin subclass: #FilePluginSimulator
+ 	instanceVariableNames: 'openFiles states'
- 	instanceVariableNames: 'openFiles'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-InterpreterSimulation'!
  
  !FilePluginSimulator commentStamp: 'tpr 5/5/2003 12:02' prior: 0!
  File plugin simulation for the VM simulator!

Item was added:
+ ----- Method: FilePluginSimulator>>createDirectory: (in category 'simulation') -----
+ createDirectory: aString
+ 	^[FileDirectory default primCreateDirectory: aString.
+ 	   true]
+ 		on: Error
+ 		do: [:ex| false]
+ 	!

Item was changed:
  ----- Method: FilePluginSimulator>>fileValueOf: (in category 'simulation') -----
  fileValueOf: objectPointer
+ 	| index file |
- 	| index |
  	index := (interpreterProxy isIntegerObject: objectPointer)
  				ifTrue: [interpreterProxy integerValueOf: objectPointer]
  				ifFalse:
  					[((interpreterProxy isBytes: objectPointer)
+ 					  and: [(interpreterProxy byteSizeOf: objectPointer) = (self sizeof: #SQFile)]) ifFalse:
- 					  and: [(interpreterProxy byteSizeOf: objectPointer) = self bytesPerWord]) ifFalse:
  						[interpreterProxy primitiveFail.
  						 ^nil].
+ 					interpreterProxy longAt: objectPointer + interpreterProxy baseHeaderSize].
+ 	file := openFiles at: index.
+ 	"this attempts to preserve file positions across snapshots when debugging the VM
+ 	 requires saving an image in full flight and pushing it over the cliff time after time..."
+ 	(file closed and: [states includesKey: file]) ifTrue:
+ 		[[:pos :isBinary|
+ 		  file reopen; position: pos.
+ 		  isBinary ifTrue:
+ 			[file binary]] valueWithArguments: (states at: file)].
+ 	^file!
- 					interpreterProxy longAt: objectPointer + self baseHeaderSize].
- 	^openFiles at: index!

Item was changed:
  ----- Method: FilePluginSimulator>>initialiseModule (in category 'initialize-release') -----
  initialiseModule
  	"See FilePluginSimulator>>sqFileStdioHandlesInto:"
  	(openFiles := Dictionary new)
  		at: 0 put: (FakeStdinStream for: interpreterProxy interpreter); "stdin"
  		at: 1 put: Transcript; "stdout"
  		at: 2 put: Transcript. "stderr"
+ 	states := IdentityDictionary new.
  	^super initialiseModule!

Item was added:
+ ----- Method: FilePluginSimulator>>recordStateOf: (in category 'simulation') -----
+ recordStateOf: file
+ 	([file position]
+ 			on: Error
+ 			do: [:ex| nil]) ifNotNil:
+ 		[:position|
+ 		states at: file put: {position. file isBinary}]!

Item was changed:
  ----- Method: FilePluginSimulator>>sqFile:Read:Into:At: (in category 'simulation') -----
  sqFile: file Read: count Into: byteArrayIndex At: startIndex
  	| interpreter |
  	interpreter := interpreterProxy interpreter.
+ 	[[startIndex to: startIndex + count - 1 do:
- 	startIndex to: startIndex + count - 1 do:
  		[ :i |
+ 		file atEnd ifTrue:
+ 			[(file isKindOf: FakeStdinStream) ifTrue: [file atEnd: false].
+ 			 ^i - startIndex].
+ 		interpreter
+ 			byteAt: byteArrayIndex + i
+ 			put: file next asInteger]]
+ 			on: Error
+ 			do: [:ex|
+ 				(file isKindOf: TranscriptStream) ifFalse: [ex pass].
+ 				^0]]
+ 		ensure: [self recordStateOf: file].
- 		file atEnd ifTrue: [^i - startIndex].
- 		interpreter byteAt: byteArrayIndex + i put: file next asInteger].
  	^count!

Item was changed:
  ----- Method: FilePluginSimulator>>sqFile:SetPosition: (in category 'simulation') -----
  sqFile: file SetPosition: newPosition
+ 	file position: newPosition.
+ 	self recordStateOf: file!
- 	file position: newPosition!

Item was changed:
  ----- Method: FilePluginSimulator>>sqFile:Truncate: (in category 'simulation') -----
  sqFile: file Truncate: truncatePosition
+ 	file truncate: truncatePosition.
+ 	self recordStateOf: file!
- 	file truncate: truncatePosition!

Item was changed:
  ----- Method: FilePluginSimulator>>sqFile:Write:From:At: (in category 'simulation') -----
  sqFile: file Write: count From: byteArrayIndex At: startIndex
  	| interpreter |
  	interpreter := interpreterProxy interpreter.
  	file isBinary
  		ifTrue:
  			[startIndex to: startIndex + count - 1 do:
  				[ :i | file nextPut: (interpreter byteAt: byteArrayIndex + i)]]
  		ifFalse:
  			[startIndex to: startIndex + count - 1 do:
  				[ :i | | byte |
  				byte := interpreter byteAt: byteArrayIndex + i.
  				file nextPut: (Character value: (byte == 12 "lf" ifTrue: [15"cr"] ifFalse: [byte]))]].
+ 	self recordStateOf: file.
  	^count!

Item was changed:
  ----- Method: FilePluginSimulator>>sqFileClose: (in category 'simulation') -----
  sqFileClose: file
+ 	file close.
+ 	self recordStateOf: file!
- 	file close!

Item was removed:
- ----- Method: Interpreter>>isBigEnder (in category 'plugin support') -----
- isBigEnder
- 	"Answer true (non-zero) if running on a big endian machine."
- 	| endianness anInt cString len i |
- 	<var: 'cString' type: 'char *'>
- 	<var: 'endianness' declareC: 'static sqInt endianness = -1'>
- 	(endianness == -1) ifFalse: [^ endianness]. "answer cached value"
- 	len := self cCode: 'sizeof(anInt)'
- 			inSmalltalk: [^ (Smalltalk endianness == #little) not].
- 	cString := self cCode: '(char *) &anInt' inSmalltalk: [].
- 	i := 0.
- 	[i < len] whileTrue:
- 		[cString at: i put: i.
- 		i := i + 1].
- 	endianness :=  anInt bitAnd: 255.
- 	^ endianness
- !

Item was added:
+ ----- Method: InterpreterPlugin class>>newFor: (in category 'simulation') -----
+ newFor: anUnsimulatedInterpreterPluginClass
+ 	"Overridden by SmartSyntaxPluginSimulator to wrap a specific plugin class."
+ 	^self new!

Item was changed:
+ ----- Method: InterpreterPlugin class>>simulatorClass (in category 'simulation') -----
- ----- Method: InterpreterPlugin class>>simulatorClass (in category 'accessing') -----
  simulatorClass
  	"For running from Smalltalk - answer a class that can be used to simulate the receiver, or nil if you want the primitives in this module to always fail, causing simulation to fall through to the Smalltalk code.  By default every non-TestInterpreterPlugin can simulate itself."
  
  	^ self!

Item was changed:
  ----- Method: InterpreterPrimitives class>>requiredMethodNames (in category 'translation') -----
  requiredMethodNames
+ 	"Return the list of method names that should be retained for export or other support reasons.
+ 	Include all of the selectors for primitives to ensure translation in slang browser."
- 	"return the list of method names that should be retained for export or other support reasons"
  
+ 	^super requiredMethodNames,
+ 		#(floatArg: integerArg: methodArg: methodReturnValue: objectArg: primitiveMethod),
+ 		(self selectors select: [:e | 'primitive*' match: e])!
- 	^super requiredMethodNames, #(floatArg: integerArg: methodArg: methodReturnValue: objectArg: primitiveMethod)!

Item was added:
+ ----- Method: InterpreterPrimitives>>isBigEnder (in category 'primitive support') -----
+ isBigEnder
+ 	"Answer true (non-zero) if running on a big endian machine."
+ 	| endianness anInt cString len i |
+ 	<var: 'cString' type: 'char *'>
+ 	<var: 'endianness' declareC: 'static sqInt endianness = -1'>
+ 	(endianness == -1) ifFalse: [^ endianness]. "answer cached value"
+ 	len := self cCode: 'sizeof(anInt)'
+ 			inSmalltalk: [^ (Smalltalk endianness == #little) not].
+ 	cString := self cCode: '(char *) &anInt' inSmalltalk: [].
+ 	i := 0.
+ 	[i < len] whileTrue:
+ 		[cString at: i put: i.
+ 		i := i + 1].
+ 	endianness :=  anInt bitAnd: 255.
+ 	^ endianness
+ !

Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveIsBigEnder (in category 'other primitives') -----
+ primitiveIsBigEnder
+ 	"Answer true if running on a big endian machine."
+ 	<export: true>
+ 	self isBigEnder
+ 		ifTrue: [self pop: 1 thenPush: objectMemory trueObject]
+ 		ifFalse: [self pop: 1 thenPush: objectMemory falseObject]
+ 	!

Item was changed:
  ----- Method: InterpreterPrimitives>>success: (in category 'primitive support') -----
  success: successBoolean
  	"Set the state of the primitive failure code/success flag, iff successBoolean
  	 is false. If primFailCode is non-zero a primitive has failed.  If primFailCode
  	 is greater than one then its value indicates the reason for failure."
  
  	"Use returnTypeC: #sqInt because that's the way it is defined in sq.h.
+ 	 Use no explicit return so that Slang doesn't fail an inlining type-check when
- 	 Use no explicit return so that Slang doesn't fail an inlin ingtype-check when
  	 a primitive with return type void uses ^self success: false to exit."
  	<returnTypeC: #sqInt>
  	<inline: true>
  	successBoolean ifFalse:
  		["Don't overwrite an error code that has already been set."
  		 self successful ifTrue:
  			[primFailCode := 1]]!

Item was changed:
  ----- Method: InterpreterProxy>>initialize (in category 'initialize') -----
  initialize
- 	successFlag := true.
  	remapBuffer := OrderedCollection new.
  	stack := OrderedCollection new.
  	primFailCode := 0.
  !

Item was added:
+ ----- Method: InterpreterSimulator>>interpreter (in category 'interpreter shell') -----
+ interpreter
+ 	^self!

Item was added:
+ ----- Method: InterpreterSimulator>>isIntegerObject: (in category 'interpreter access') -----
+ isIntegerObject: objectPointer
+ 	"In simulation, an interpreter simulator serves as the interpreter proxy"
+ 	^ objectMemory isIntegerObject: objectPointer!

Item was changed:
  ----- Method: InterpreterSimulator>>loadNewPlugin: (in category 'plugin support') -----
  loadNewPlugin: pluginString
+ 	| plugin plugins simulatorClasses |
+ 	transcript cr; show: 'Looking for module ', pluginString.
+ 	"but *why*??"
+ 	(#('FloatArrayPlugin' 'Matrix2x3Plugin') includes: pluginString) ifTrue:
+ 		[transcript show: ' ... defeated'. ^nil].
+ 	plugins := InterpreterPlugin allSubclasses select: [:psc| psc moduleName asString = pluginString asString].
+ 	simulatorClasses := (plugins
+ 							select: [:psc| psc simulatorClass notNil]
+ 							thenCollect: [:psc| psc simulatorClass]) asSet.
+ 	simulatorClasses isEmpty ifTrue: [transcript show: ' ... not found'. ^nil].
+ 	simulatorClasses size > 1 ifTrue: [^self error: 'This won''t work...'].
+ 	plugins size > 1 ifTrue:
+ 		[transcript show: '...multiple plugin classes; choosing ', plugins last name].
+ 	plugin := simulatorClasses anyOne newFor: plugins last. "hopefully lowest in the hierarchy..."
- 	| plugin simClass |
- 	transcript cr; show:'Looking for module ', pluginString.
- 	(#('FloatArrayPlugin' 'Matrix2x3Plugin')
- 		includes: pluginString) ifTrue:
- 		[transcript show: ' ... defeated'. ^ nil].
- 	plugin := simClass := nil.
- 	InterpreterPlugin allSubclassesDo:[:plg|
- 		plg moduleName asString = pluginString asString ifTrue:[
- 			simClass := plg simulatorClass.
- 			plugin ifNil:[plugin := simClass]
- 				ifNotNil:[plugin == simClass ifFalse:[^self error:'This won''t work...']].
- 		].
- 	].
- 	plugin ifNil:[transcript show: ' ... not found'. ^nil].
- 	plugin := plugin new.
  	plugin setInterpreter: self. "Ignore return value from setInterpreter"
+ 	(plugin respondsTo: #initialiseModule) ifTrue:
+ 		[plugin initialiseModule ifFalse:
+ 			[transcript show: ' ... initialiser failed'. ^nil]]. "module initialiser failed"
- 	(plugin respondsTo: #initialiseModule) ifTrue:[
- 		plugin initialiseModule ifFalse:[transcript show: ' ... initialiser failed'.^nil]. "module initialiser failed"
- 	].
  	pluginList := pluginList copyWith: (pluginString asString -> plugin).
+ 	transcript show: ' ... loaded'.
- 	transcript show:' ... loaded'.
  	^pluginList last!

Item was changed:
  ----- Method: InterpreterSimulator>>makeDirEntryName:size:createDate:modDate:isDir:fileSize: (in category 'file primitives') -----
  makeDirEntryName: entryName size: entryNameSize
  	createDate: createDate modDate: modifiedDate
  	isDir: dirFlag fileSize: fileSize
  
  	| modDateOop createDateOop nameString results |
+ 	<var: 'entryName' type: 'char *'>
- 	self var: 'entryName' type: 'char *'.
  
  	"allocate storage for results, remapping newly allocated
  	 oops in case GC happens during allocation"
+ 	self pushRemappableOop:
+ 		(self instantiateClass: (self splObj: ClassArray) indexableSize: 5).
+ 	self pushRemappableOop:
+ 		(self instantiateClass: (self splObj: ClassByteString) indexableSize: entryNameSize).
+ 	self pushRemappableOop: (self positive32BitIntegerFor: createDate).
+ 	self pushRemappableOop: (self positive32BitIntegerFor: modifiedDate).
- 	objectMemory pushRemappableOop:
- 		(objectMemory instantiateClass: (objectMemory splObj: ClassArray) indexableSize: 5).
- 	objectMemory pushRemappableOop:
- 		(objectMemory instantiateClass: (objectMemory splObj: ClassString) indexableSize: entryNameSize)..
- 	objectMemory pushRemappableOop: (self positive32BitIntegerFor: createDate).
- 	objectMemory pushRemappableOop: (self positive32BitIntegerFor: modifiedDate).
  
+ 	modDateOop   := self popRemappableOop.
+ 	createDateOop := self popRemappableOop.
+ 	nameString    := self popRemappableOop.
+ 	results         := self popRemappableOop.
- 	modDateOop   := objectMemory popRemappableOop.
- 	createDateOop := objectMemory popRemappableOop.
- 	nameString    := objectMemory popRemappableOop.
- 	results         := objectMemory popRemappableOop.
  
  	1 to: entryNameSize do: [ :i |
+ 		self storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue.
- 		objectMemory storeByte: i-1 ofObject: nameString withValue: (entryName at: i) asciiValue.
  	].
  
+ 	self storePointer: 0 ofObject: results withValue: nameString.
+ 	self storePointer: 1 ofObject: results withValue: createDateOop.
+ 	self storePointer: 2 ofObject: results withValue: modDateOop.
- 	objectMemory storePointer: 0 ofObject: results withValue: nameString.
- 	objectMemory storePointer: 1 ofObject: results withValue: createDateOop.
- 	objectMemory storePointer: 2 ofObject: results withValue: modDateOop.
  	dirFlag
+ 		ifTrue: [ self storePointer: 3 ofObject: results withValue: objectMemory trueObject ]
+ 		ifFalse: [ self storePointer: 3 ofObject: results withValue: objectMemory falseObject ].
+ 	self storePointer: 4 ofObject: results
+ 		withValue: (self integerObjectOf: fileSize).
- 		ifTrue: [ objectMemory storePointer: 3 ofObject: results withValue: objectMemory getTrueObj ]
- 		ifFalse: [ objectMemory storePointer: 3 ofObject: results withValue: objectMemory getFalseObj ].
- 	objectMemory storePointer: 4 ofObject: results
- 		withValue: (objectMemory integerObjectOf: fileSize).
  	^ results
  !

Item was added:
+ ----- Method: InterpreterSimulator>>primitiveDirectoryEntry (in category 'file primitives') -----
+ primitiveDirectoryEntry
+ 	| name pathName array result |
+ 	name := self stringOf: self stackTop.
+ 	pathName := self stringOf: (self stackValue: 1).
+ 	
+ 	self successful ifFalse:
+ 		[^self primitiveFail].
+ 
+ 	array := FileDirectory default primLookupEntryIn: pathName name: name.
+ 	array == nil ifTrue:
+ 		[self pop: 3 thenPush: objectMemory nilObj.
+ 		^array].
+ 	array == #badDirectoryPath ifTrue:
+ 		[self halt.
+ 		^self primitiveFail].
+ 	array == #primFailed ifTrue:
+ 		[self halt.
+ 		^self primitiveFail].
+ 
+ 	result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
+ 				createDate: (array at: 2) modDate: (array at: 3)
+ 				isDir: (array at: 4)  fileSize: (array at: 5).
+ 	self pop: 3.
+ 	self push: result!

Item was changed:
  ----- Method: InterpreterSimulator>>primitiveDirectoryLookup (in category 'file primitives') -----
  primitiveDirectoryLookup
  	| index pathName array result |
  	index := self stackIntegerValue: 0.
  	pathName := (self stringOf: (self stackValue: 1)).
  	
  	self successful ifFalse: [
  		^self primitiveFail.
  	].
  
  	array := FileDirectory default primLookupEntryIn: pathName index: index.
  
  	array == nil ifTrue: [
  		self pop: 3.
+ 		self push: objectMemory nilObj.
- 		self push: objectMemory getNilObj.
  		^array.
  	].
  	array == #badDirectoryPath ifTrue: [self halt.
  		^self primitiveFail.
  	].
  
  	result := self makeDirEntryName: (array at: 1) size: (array at: 1) size
  				createDate: (array at: 2) modDate: (array at: 3)
  				isDir: (array at: 4)  fileSize: (array at: 5).
  	self pop: 3.
  	self push: result.
  !

Item was changed:
  ----- Method: InterpreterSimulator>>writeImageFile:size:screenSize: (in category 'image save/restore') -----
  writeImageFile: file size: numberOfBytesToWrite screenSize: screenSize
  	"Actually emit the first numberOfBytesToWrite object memory bytes onto the snapshot."
  
  	| headerSize |
  	objectMemory bytesPerWord = 4 ifFalse: [self error: 'Not rewritten for 64 bits yet'].
+ 	headerSize := 16 * objectMemory bytesPerWord.
- 	headerSize := 16 * self bytesPerWord.
  
  	{
  		self imageFormatVersion.
  		headerSize.
  		numberOfBytesToWrite.
  		objectMemory startOfMemory.
  		objectMemory getSpecialObjectsOop.
  		objectMemory getLastHash.
  		screenSize.
  		fullScreenFlag.
  		extraVMMemory
  	}
  		do: [:long | self putLong: long toFile: file].
  	
  	"Pad the rest of the header."
  	7 timesRepeat: [self putLong: 0 toFile: file].
  	
  	"Position the file after the header."
  	file position: headerSize.
  
  	"Write the object memory."
  	1 to: numberOfBytesToWrite // 4
  		do: [:index |
  			self
  				putLong: (objectMemory getMemory at: index)
  				toFile: file].
  
  	self success: true
  !

Item was changed:
  ----- Method: InterpreterStackPages>>extraStackBytes (in category 'initialization') -----
  extraStackBytes
  	"See initializeStack:numSlots:pageSize:stackLimitOffset:stackPageHeadroom:
  	``Because stack pages grow down...''"
+ 	^self cCode: 'BYTES_PER_WORD' inSmalltalk: [0]!
- 	^self cCode: 'BytesPerWord' inSmalltalk: [0]!

Item was removed:
- ----- Method: NewObjectMemory>>objectRepresentationClass (in category 'cog jit support') -----
- objectRepresentationClass
- 	<doNotGenerate>
- 	^CogObjectRepresentationForSqueakV3!

Item was changed:
  InterpreterPlugin subclass: #SmartSyntaxInterpreterPlugin
+ 	instanceVariableNames: 'simulator'
- 	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-SmartSyntaxPlugins'!
  
  !SmartSyntaxInterpreterPlugin commentStamp: '<historical>' prior: 0!
  Subclass of InterpreterPlugin, used in connection with TestCodeGenerator for named primitives with type coercion specifications!

Item was changed:
+ ----- Method: SmartSyntaxInterpreterPlugin class>>simulatorClass (in category 'simulation') -----
- ----- Method: SmartSyntaxInterpreterPlugin class>>simulatorClass (in category 'instance creation') -----
  simulatorClass
  	"For running from Smalltalk - answer a class that can be used to simulate the receiver, or nil if you want the primitives in this module to always fail, causing simulation to fall through to the Smalltalk code.
  	By default SmartSyntaxInterpreterPlugin answers nil because methods in these plugins are intended to be embedded in code that pushes and pops from the stack and therefore cannot be run independently.  This wrapper code is generated when translated to C.  But, unfortunately, this code is missing during simulation.  There was an attempt to simulate this, but only the prologue code (getting arg from the stack) is simulated (see simulatePrologInContext:). The epologue code (popping args and pushing result) is not.  So I am making this nil until this can be fixed.
  	Also, beware that primitive methods that take no args exactly match their primitive name (faking out InterpreterSimulator>>callExternalPrimitive:).  They should only be called from within wrapper code that simulates the prologue and epilogue.  Primitive method that take args don't have this accidental matching problem since their names contain colons while their primitive names do not. - ajh 8/21/2002"
  
  	^ nil!

Item was added:
+ ----- Method: SmartSyntaxInterpreterPlugin>>simulator (in category 'accessing') -----
+ simulator
+ 	<doNotGenerate>
+ 	^simulator!

Item was added:
+ ----- Method: SmartSyntaxInterpreterPlugin>>simulator: (in category 'accessing') -----
+ simulator: aSmartSyntaxPluginSimulator
+ 	<doNotGenerate>
+ 	simulator := aSmartSyntaxPluginSimulator!

Item was changed:
  ----- Method: SmartSyntaxPluginSimulator>>setInterpreter: (in category 'initialize') -----
  setInterpreter: anInterpreterProxy
  	interpreterProxy := anInterpreterProxy.
  	actualPlugin setInterpreter: anInterpreterProxy.
+ 	"self computeSignatureMap" self flag: #FIXME "part of the oscog type inferencing"!
- 	self computeSignatureMap!

Item was changed:
  ----- Method: StackInterpreter>>activateNewClosureMethod:numArgs:mayContextSwitch: (in category 'control primitives') -----
  activateNewClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: mayContextSwitch
  	"Similar to activateNewMethod but for Closure and newMethod."
  	| numCopied outerContext theMethod closureIP |
  	<inline: true>
  	outerContext := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: blockClosure.
  	numCopied := self copiedValueCountOfClosure: blockClosure.
  
  	theMethod := objectMemory fetchPointer: MethodIndex ofObject: outerContext.
  	self push: instructionPointer.
  	self push: framePointer.
  	framePointer := stackPointer.
  	self push: theMethod.
  	self push: (self encodeFrameFieldHasContext: false isBlock: true numArgs: numArgs).
  	self push: objectMemory nilObject. "FxThisContext field"
  	self push: (objectMemory fetchPointer: ReceiverIndex ofObject: outerContext).
  
  	"Copy the copied values..."
  	0 to: numCopied - 1 do:
  		[:i|
  		self push: (objectMemory
  					fetchPointer: i + ClosureFirstCopiedValueIndex
  					ofObject: blockClosure)].
  
  	self assert: (self frameIsBlockActivation: framePointer).
  	self assert: (self frameHasContext: framePointer) not.
  
  	"The initial instructions in the block nil-out remaining temps."
  
  	"the instruction pointer is a pointer variable equal to 
+ 	method oop + ip + objectMemory baseHeaderSize 
- 	method oop + ip + BaseHeaderSize 
  	-1 for 0-based addressing of fetchByte 
  	-1 because it gets incremented BEFORE fetching currentByte"
  	closureIP := self quickFetchInteger: ClosureStartPCIndex ofObject: blockClosure.
+ 	instructionPointer := theMethod + closureIP + objectMemory baseHeaderSize - 2.
- 	instructionPointer := theMethod + closureIP + self baseHeaderSize - 2.
  	self setMethod: theMethod.
  
  	"Now check for stack overflow or an event (interrupt, must scavenge, etc)"
  	stackPointer < stackLimit ifTrue:
  		[self handleStackOverflowOrEventAllowContextSwitch: mayContextSwitch]!

Item was changed:
  ----- Method: StackInterpreter>>arrayValueOf: (in category 'utilities') -----
  arrayValueOf: arrayOop
  	"Return the address of first indexable field of resulting array object, or fail if
  	 the instance variable does not contain an indexable bytes or words object."
  	"Note: May be called by translated primitive code."
  
  	<returnTypeC: #'void *'>
  	((objectMemory isNonIntegerObject: arrayOop)
  	 and: [objectMemory isWordsOrBytes: arrayOop]) ifTrue:
+ 		[^self cCoerceSimple: (self pointerForOop: arrayOop + objectMemory baseHeaderSize) to: #'void *'].
- 		[^self cCoerceSimple: (self pointerForOop: arrayOop + self baseHeaderSize) to: #'void *'].
  	self primitiveFail!

Item was changed:
  ----- Method: StackInterpreter>>checkStackIntegrity (in category 'object memory support') -----
  checkStackIntegrity
  	"Perform an integrity/leak check using the heapMap.  Assume
  	 clearLeakMapAndMapAccesibleObjects has set a bit at each
  	 object's header.  Scan all objects accessible from the stack
  	 checking that every pointer points to a header.  Answer if no
  	 dangling pointers were detected."
  	| ok |
  	<inline: false>
  	<var: #thePage type: #'StackPage *'>
  	<var: #theSP type: #'char *'>
  	<var: #theFP type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	ok := true.
  	0 to: numStackPages - 1 do:
  		[:i| | thePage theSP theFP callerFP oop |
  		thePage := stackPages stackPageAt: i.
  		(stackPages isFree: thePage) ifFalse:
  			[thePage = stackPage
  				ifTrue:
  					[theSP := stackPointer.
  					 theFP := framePointer]
  				ifFalse:
  					[theSP := thePage headSP.
  					 theFP := thePage  headFP].
  			 "Skip the instruction pointer on top of stack of inactive pages."
  			 thePage = stackPage ifFalse:
+ 				[theSP := theSP + objectMemory bytesPerWord].
- 				[theSP := theSP + self bytesPerWord].
  			 [[theSP <= (theFP + FoxReceiver)] whileTrue:
  				[oop := stackPages longAt: theSP.
  				 ((objectMemory isNonIntegerObject: oop) 
  				   and: [(self heapMapAtWord: (self pointerForOop: oop)) = 0]) ifTrue:
  					[self printFrameThing: 'object leak in frame temp' at: theSP; cr.
  					 ok := false].
+ 				 theSP := theSP + objectMemory bytesPerWord].
- 				 theSP := theSP + self bytesPerWord].
  			 (self frameHasContext: theFP) ifTrue:
  				[oop := self frameContext: theFP.
  				 ((objectMemory isIntegerObject: oop) 
  				   or: [(self heapMapAtWord: (self pointerForOop: oop)) = 0]) ifTrue:
  					[self printFrameThing: 'object leak in frame ctxt' at: theFP + FoxThisContext; cr.
  					 ok := false].
  				 (self isContext: oop) ifFalse:
  					[self printFrameThing: 'frame ctxt should be context' at: theFP + FoxThisContext; cr.
  					 ok := false]].
  			 oop := self frameMethod: theFP.
  			 ((objectMemory isIntegerObject: oop) 
  			   or: [(self heapMapAtWord: (self pointerForOop: oop)) = 0]) ifTrue:
  				[self printFrameThing: 'object leak in frame mthd' at: theFP + FoxMethod; cr.
  				 ok := false].
  			 (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
+ 				[theSP := theFP + FoxCallerSavedIP + objectMemory bytesPerWord.
- 				[theSP := theFP + FoxCallerSavedIP + self bytesPerWord.
  				 theFP := callerFP].
  			 theSP := theFP + FoxCallerContext "a.k.a. FoxCallerSavedIP".
  			 [theSP <= thePage baseAddress] whileTrue:
  				[oop := stackPages longAt: theSP.
  				 ((objectMemory isNonIntegerObject: oop) 
  				   and: [(self heapMapAtWord: (self pointerForOop: oop)) = 0]) ifTrue:
  					[self printFrameThing: 'object leak in frame arg' at: theSP; cr.
  					 ok := false].
+ 				 theSP := theSP + objectMemory bytesPerWord]]].
- 				 theSP := theSP + self bytesPerWord]]].
  	^ok!

Item was changed:
  ----- Method: StackInterpreter>>closureIn:numArgs:instructionPointer:copiedValues: (in category 'control primitives') -----
  closureIn: context numArgs: numArgs instructionPointer: initialIP copiedValues: copiedValues
  	| newClosure numCopied |
  	<inline: true>
  	"numCopied should be zero for nil"
  	numCopied := objectMemory fetchWordLengthOf: copiedValues.
  	newClosure := objectMemory
  					eeInstantiateSmallClass: (objectMemory splObj: ClassBlockClosure)
+ 					sizeInBytes: (objectMemory bytesPerWord * (ClosureFirstCopiedValueIndex + numCopied)) + objectMemory baseHeaderSize.
- 					sizeInBytes: (self bytesPerWord * (ClosureFirstCopiedValueIndex + numCopied)) + self baseHeaderSize.
  	"Assume: have just allocated a new closure; it must be young. Thus, can use unchecked stores."
  	objectMemory storePointerUnchecked: ClosureOuterContextIndex ofObject: newClosure withValue: context.
  	objectMemory storePointerUnchecked: ClosureStartPCIndex ofObject: newClosure withValue: (objectMemory integerObjectOf: initialIP).
  	objectMemory storePointerUnchecked: ClosureNumArgsIndex ofObject: newClosure withValue: (objectMemory integerObjectOf: numArgs).
  	0 to: numCopied - 1 do:
  		[:i|
  		objectMemory storePointerUnchecked: i + ClosureFirstCopiedValueIndex
  			ofObject: newClosure
  			withValue: (objectMemory fetchPointer: i ofObject: copiedValues)].
  	^newClosure!

Item was changed:
  ----- Method: StackInterpreter>>closureIn:numArgs:instructionPointer:numCopiedValues: (in category 'control primitives') -----
  closureIn: context numArgs: numArgs instructionPointer: initialIP numCopiedValues: numCopied
  	| newClosure |
  	<inline: true>
+ 	self assert: (objectMemory bytesPerWord * (ClosureFirstCopiedValueIndex + numCopied)) + objectMemory baseHeaderSize <= 252.
- 	self assert: (self bytesPerWord * (ClosureFirstCopiedValueIndex + numCopied)) + self baseHeaderSize <= 252.
  	newClosure := objectMemory
  					eeInstantiateSmallClass: (objectMemory splObj: ClassBlockClosure)
+ 					sizeInBytes: (objectMemory bytesPerWord * (ClosureFirstCopiedValueIndex + numCopied)) + objectMemory baseHeaderSize.
- 					sizeInBytes: (self bytesPerWord * (ClosureFirstCopiedValueIndex + numCopied)) + self baseHeaderSize.
  	"Assume: have just allocated a new closure; it must be young. Thus, can use unchecked stores."
  	objectMemory storePointerUnchecked: ClosureOuterContextIndex ofObject: newClosure withValue: context.
  	objectMemory storePointerUnchecked: ClosureStartPCIndex ofObject: newClosure withValue: (objectMemory integerObjectOf: initialIP).
  	objectMemory storePointerUnchecked: ClosureNumArgsIndex ofObject: newClosure withValue: (objectMemory integerObjectOf: numArgs).
  	^newClosure!

Item was changed:
  ----- Method: StackInterpreter>>commonReturn (in category 'return bytecodes') -----
  commonReturn
  	"Note: Assumed to be inlined into the dispatch loop."
  
  	| closure home unwindContextOrNilOrZero frameToReturnTo contextToReturnTo theFP callerFP newPage |
  	<var: #frameToReturnTo type: #'char *'>
  	<var: #theFP type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	<var: #newPage type: #'StackPage *'>
  	<var: #thePage type: #'StackPage *'>
  	<sharedCodeNamed: 'commonReturn' inCase: 120>
  
  	"If this is a method simply return to the  sender/caller."
  	(self frameIsBlockActivation: localFP) ifFalse:
  		[^self commonCallerReturn].
  
  	"Since this is a block activation the closure is on the stack above any args and the frame."
  	closure := self pushedReceiverOrClosureOfFrame: localFP.
  
  	home := nil.
  	"Walk the closure's lexical chain to find the context or frame to return from (home)."
  	[closure ~~ objectMemory nilObject] whileTrue:
  		[home := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: closure.
  		 closure := objectMemory fetchPointer: ClosureIndex ofObject: home].
  	"home is to be returned from provided there is no unwind-protect activation between
  	 this frame and home's sender.  Search for an unwind.  findUnwindThroughContext:
  	 will answer either the context for an unwind-protect activation or nilObj if the sender
  	 cannot be found or 0 if no unwind is found but the sender is.  We must update the
  	 current page's headFrame pointers to enable the search to identify widowed contexts
  	 correctly."
  	self writeBackHeadFramePointers.
  	unwindContextOrNilOrZero := self internalFindUnwindThroughContext: home.
  	unwindContextOrNilOrZero = objectMemory nilObject ifTrue:
  		["error: can't find home on chain; cannot return"
  		 ^self internalCannotReturn: localReturnValue].
  	unwindContextOrNilOrZero ~~ 0 ifTrue:
  		[^self internalAboutToReturn: localReturnValue through: unwindContextOrNilOrZero].
  
  	"Now we know home is on the sender chain.
  	 We could be returning to either a context or a frame.  Find out which."
  	contextToReturnTo := nil.
  	(self isMarriedOrWidowedContext: home)
  		ifTrue:
  			[self assert: (self checkIsStillMarriedContext: home currentFP: localFP).
  			 theFP := self frameOfMarriedContext: home.
  			 (self isBaseFrame: theFP)
  				ifTrue:
  					[contextToReturnTo := self frameCallerContext: theFP]
  				ifFalse:
  					[frameToReturnTo := self frameCallerFP: theFP]]
  		ifFalse:
  			[contextToReturnTo := objectMemory fetchPointer: SenderIndex ofObject: home.
  			 ((self isContext: contextToReturnTo)
  			  and: [self isMarriedOrWidowedContext: contextToReturnTo]) ifTrue:
  				[self assert: (self checkIsStillMarriedContext: contextToReturnTo currentFP: localFP).
  			 	 frameToReturnTo := self frameOfMarriedContext: contextToReturnTo.
  				 contextToReturnTo := nil]].
  
  	"If returning to a context we must make a frame for it unless it is dead."
  	contextToReturnTo ~= nil ifTrue:
  		[frameToReturnTo := self establishFrameForContextToReturnTo: contextToReturnTo.
  		 frameToReturnTo == 0 ifTrue:
  			["error: home's sender is dead; cannot return"
  			 ^self internalCannotReturn: localReturnValue]].
  
  	"Now we have a frame to return to.  If it is on a different page we must free intervening pages and
  	 nil out intervening contexts.  We must free intervening stack pages because if we leave the pages
  	 to be divorced then their contexts will be divorced with intact senders and instruction pointers.  This
  	 code is similar to primitiveTerminateTo.  We must move any frames on itervening pages above the
  	 frame linked to because these may be in use, e.g. via co-routining (see baseFrameReturn)."
  	self assert: stackPages pageListIsWellFormed.
  	newPage := stackPages stackPageFor: frameToReturnTo.
  	newPage ~~ stackPage ifTrue:
  		[| currentCtx thePage nextCntx |
  		 currentCtx := self frameCallerContext: stackPage baseFP.
  		 self assert: (self isContext: currentCtx).
  		 stackPages freeStackPage: stackPage.
  		 [self assert: (self isContext: currentCtx).
  		  (self isMarriedOrWidowedContext: currentCtx)
  		   and: [(stackPages stackPageFor: (theFP := self frameOfMarriedContext: currentCtx)) = newPage]] whileFalse:
  			[(self isMarriedOrWidowedContext: currentCtx)
  				ifTrue:
  					[thePage := stackPages stackPageFor: theFP.
  					 theFP ~= thePage headFP ifTrue:
  						["Since we've just deallocated a page we know that newStackPage won't deallocate an existing one."
  						 self moveFramesIn: thePage through: (self findFrameAbove: theFP inPage: thePage) toPage: self newStackPage].
  					 currentCtx := self frameCallerContext: thePage baseFP.
  					 self freeStackPage: thePage]
  				ifFalse:
  					[nextCntx := objectMemory fetchPointer: SenderIndex ofObject: currentCtx.
  					 self markContextAsDead: currentCtx.
  					 currentCtx := nextCntx]].
  		 self setStackPageAndLimit: newPage.
  		 localSP := stackPage headSP.
  		 localFP := stackPage headFP].
  
  	"Two cases.  Returning to the top frame on a new page or an interior frame on the current page.
  	 The top frame has its instruction pointer on top of stack. An interior frame has its instruction pointer
  	 in the caller frame. We need to peel back any frames on the page until we get to the correct frame."
  
  	localFP = frameToReturnTo
  		ifTrue: "pop the saved IP, push the return value and continue."
  			[localIP := self pointerForOop: self internalStackTop]
  		ifFalse:
  			[[callerFP := localFP.
  			  localFP := self frameCallerFP: localFP.
  			  localFP ~~ frameToReturnTo] whileTrue.
  			localIP := self frameCallerSavedIP: callerFP.
+ 			localSP := (self frameCallerSP: callerFP) - objectMemory bytesPerWord].
- 			localSP := (self frameCallerSP: callerFP) - self bytesPerWord].
  	self internalStackTopPut: localReturnValue.
  	self setMethod: (self frameMethod: localFP).
  	^self fetchNextBytecode!

Item was changed:
  ----- Method: StackInterpreter>>commonSend (in category 'message sending') -----
  commonSend
  	"Send a message, starting lookup with the receiver's class."
  	"Assume: messageSelector and argumentCount have been set, and that 
  	the receiver and arguments have been pushed onto the stack,"
  	"Note: This method is inlined into the interpreter dispatch loop."
  	<sharedCodeNamed: 'commonSend' inCase: 131>
+ 	self sendBreak: messageSelector + objectMemory baseHeaderSize
- 	self sendBreak: messageSelector + self baseHeaderSize
  		point: (objectMemory lengthOf: messageSelector)
  		receiver: (self internalStackValue: argumentCount).
  	self internalFindNewMethod.
  	self internalExecuteNewMethod.
  	self fetchNextBytecode!

Item was changed:
  ----- Method: StackInterpreter>>contextInstructionPointer:frame: (in category 'frame access') -----
  contextInstructionPointer: theIP frame: theFP
  	<var: #theFP type: #'char *'>
  	self assert: (self validInstructionPointer: theIP inFrame: theFP).
+ 	^objectMemory integerObjectOf: theIP - (self iframeMethod: theFP) - objectMemory baseHeaderSize + 2!
- 	^objectMemory integerObjectOf: theIP - (self iframeMethod: theFP) - self baseHeaderSize + 2!

Item was changed:
  ----- Method: StackInterpreter>>convertFloatsToPlatformOrderFrom:to: (in category 'image save/restore') -----
  convertFloatsToPlatformOrderFrom: startOop to: stopAddr 
  	"Byte-swap the words of all bytes objects in a range of the 
  	 image, including Strings, ByteArrays, and CompiledMethods.
  	 This returns these objects to their original byte ordering 
  	 after blindly byte-swapping the entire image. For compiled 
  	 methods, byte-swap only their bytecodes part.
  	 Ensure floats are in platform-order."
  	| oop temp |
  	objectMemory vmEndianness = imageFloatsBigEndian ifTrue:
  		[^self].
  	self assert: ClassFloatCompactIndex ~= 0.
  	oop := startOop.
  	[self oop: oop isLessThan: stopAddr] whileTrue:
  		[(objectMemory isFreeObject: oop) ifFalse:
  			[(objectMemory compactClassIndexOf: oop) = ClassFloatCompactIndex ifTrue:
+ 				[temp := self longAt: oop + objectMemory baseHeaderSize.
+ 				 self longAt: oop + objectMemory baseHeaderSize put: (self longAt: oop + objectMemory baseHeaderSize + 4).
+ 				 self longAt: oop + objectMemory baseHeaderSize + 4 put: temp]].
- 				[temp := self longAt: oop + self baseHeaderSize.
- 				 self longAt: oop + self baseHeaderSize put: (self longAt: oop + self baseHeaderSize + 4).
- 				 self longAt: oop + self baseHeaderSize + 4 put: temp]].
  		 oop := objectMemory objectAfter: oop]!

Item was changed:
  ----- Method: StackInterpreter>>createActualMessageTo: (in category 'message sending') -----
  createActualMessageTo: lookupClass 
  	"Bundle up the selector, arguments and lookupClass into a Message object. 
  	 In the process it pops the arguments off the stack, and pushes the message object. 
  	 This can then be presented as the argument of e.g. #doesNotUnderstand:"
  	| argumentArray message |
  	<inline: false> "This is a useful break-point"
  	self assert: ((objectMemory isIntegerObject: messageSelector) or: [objectMemory addressCouldBeObj: messageSelector]).
  	argumentArray := objectMemory eeInstantiateClass: (objectMemory splObj: ClassArray) indexableSize: argumentCount.
  	message := objectMemory eeInstantiateClass: (objectMemory splObj: ClassMessage) indexableSize: 0.
  
  	"Since the array is new can use unchecked stores."
+ 	(argumentCount - 1) * objectMemory bytesPerWord to: 0 by: objectMemory bytesPerWord negated do:
- 	(argumentCount - 1) * self bytesPerWord to: 0 by: self bytesPerWord negated do:
  		[:i|
+ 		self longAt:  argumentArray + objectMemory baseHeaderSize + i put: self popStack].
- 		self longAt:  argumentArray + self baseHeaderSize + i put: self popStack].
  	"Since message is new can use unchecked stores."
  	objectMemory storePointerUnchecked: MessageSelectorIndex ofObject: message withValue: messageSelector.
  	objectMemory storePointerUnchecked: MessageArgumentsIndex ofObject: message withValue: argumentArray.
  	objectMemory storePointerUnchecked: MessageLookupClassIndex ofObject: message withValue: lookupClass.
  
  	self push: message.
  
  	argumentCount := 1.!

Item was changed:
  ----- Method: StackInterpreter>>dbgFloatValueOf: (in category 'utilities') -----
  dbgFloatValueOf: oop
  	"This version answers the value of a float or nil if not a flat *WITHOUT* setting successFlag or any other such nonsense.  It is hence safe for use in debug printing.  Sheesh."
  
  	| result |
  	<returnTypeC: #double>
  	<var: #result type: #double>
  	self flag: #Dan.  "None of the float stuff has been converted for 64 bits"
  	((objectMemory isNonIntegerObject: oop)
  	and: [(objectMemory fetchClassOfNonInt: oop) = (objectMemory splObj: ClassFloat)]) ifTrue:
  		[self cCode: '' inSmalltalk: [result := Float new: 2].
+ 		 objectMemory fetchFloatAt: oop + objectMemory baseHeaderSize into: result.
- 		 objectMemory fetchFloatAt: oop + self baseHeaderSize into: result.
  		 ^result].
  	^nil!

Item was changed:
  ----- Method: StackInterpreter>>displayBitsOf:Left:Top:Right:Bottom: (in category 'I/O primitives') -----
  displayBitsOf: aForm Left: l Top: t Right: r Bottom: b
  	"Repaint the portion of the Smalltalk screen bounded by the affected rectangle. Used to synchronize the screen after a Bitblt to the Smalltalk Display object."
  
  	| displayObj dispBits w h dispBitsIndex d left right top bottom surfaceHandle |
  	displayObj := objectMemory splObj: TheDisplay.
  	aForm = displayObj ifFalse: [^ nil].
  	self success: ((objectMemory isPointers: displayObj) and: [(objectMemory lengthOf: displayObj) >= 4]).
  	self successful ifTrue: [
  		dispBits := objectMemory fetchPointer: 0 ofObject: displayObj.
  		w := self fetchInteger: 1 ofObject: displayObj.
  		h := self fetchInteger: 2 ofObject: displayObj.
  		d := self fetchInteger: 3 ofObject: displayObj.
  	].
  	l < 0 ifTrue:[left := 0] ifFalse: [left := l].
  	r > w ifTrue: [right := w] ifFalse: [right := r].
  	t < 0 ifTrue: [top := 0] ifFalse: [top := t].
  	b > h ifTrue: [bottom := h] ifFalse: [bottom := b].
  	((left <= right) and: [top <= bottom]) ifFalse: [^nil].
  	self successful ifTrue: [
  		(objectMemory isIntegerObject: dispBits) ifTrue: [
  			surfaceHandle := objectMemory integerValueOf: dispBits.
  			showSurfaceFn = 0 ifTrue: [
  				showSurfaceFn := self ioLoadFunction: 'ioShowSurface' From: 'SurfacePlugin'.
  				showSurfaceFn = 0 ifTrue: [^self success: false]].
  			self cCode:'((sqInt (*)(sqInt, sqInt, sqInt, sqInt, sqInt))showSurfaceFn)(surfaceHandle, left, top, right-left, bottom-top)'.
  		] ifFalse: [
+ 			dispBitsIndex := dispBits + objectMemory baseHeaderSize.  "index in memory byte array"
- 			dispBitsIndex := dispBits + self baseHeaderSize.  "index in memory byte array"
  			self cCode: 'ioShowDisplay(dispBitsIndex, w, h, d, left, right, top, bottom)'
  				inSmalltalk: [self showDisplayBits: dispBitsIndex 
  								w: w h: h d: d
  								left: left right: right top: top bottom: bottom]
  		].
  	]!

Item was changed:
  ----- Method: StackInterpreter>>divorceFramesIn: (in category 'frame access') -----
  divorceFramesIn: aStackPage
  	| theFP calleeFP theSP theIP calleeContext theContext |
  	<inline: false>
  	<var: #aStackPage type: #'StackPage *'>
  	<var: #theFP type: #'char *'>
  	<var: #calleeFP type: #'char *'>
  	<var: #theSP type: #'char *'>
  
  	statStackPageDivorce := statStackPageDivorce + 1.
  
  	theFP := aStackPage headFP.
  	theSP := aStackPage headSP.
  	theIP := stackPages longAt: theSP.
+ 	theSP := theSP + objectMemory bytesPerWord. "theSP points at hottest item on frame's stack"
- 	theSP := theSP + self bytesPerWord. "theSP points at hottest item on frame's stack"
  	calleeContext := nil.
  
  	[theContext := self ensureFrameIsMarried: theFP SP: theSP.
  	 self updateStateOfSpouseContextForFrame: theFP WithSP: theSP.
  	 objectMemory storePointerUnchecked: InstructionPointerIndex
  		ofObject: theContext
  		withValue: (self contextInstructionPointer: theIP frame: theFP).
  	 self assert: (self frameReceiver: theFP)
  				= (objectMemory fetchPointer: ReceiverIndex ofObject: theContext).
  	 calleeContext ~~ nil ifTrue:
  		[objectMemory storePointer: SenderIndex
  			ofObject: calleeContext
  			withValue: theContext].
  	 calleeContext := theContext.
  	 calleeFP := theFP.
  	 theIP := (self frameCallerSavedIP: theFP) asInteger.
  	 theFP := self frameCallerFP: theFP.
  	 theFP ~= 0] whileTrue:
  		["theSP points at stacked hottest item on frame's stack"
  		 theSP := self frameCallerSP: calleeFP].
  
  	objectMemory storePointer: SenderIndex
  		ofObject: theContext
  		withValue: (self frameCallerContext: calleeFP).
  
  	"The page is now free; mark it so."
  	aStackPage baseFP: 0!

Item was changed:
  ----- Method: StackInterpreter>>encodeFrameFieldHasContext:isBlock:numArgs: (in category 'frame access') -----
  encodeFrameFieldHasContext: hasContext "<Boolean>" isBlock: isBlock "<Boolean>" numArgs: numArgs
  	"For ``fast'' temporary access (ok, to mitigate slower temp access) we need
  	 fast access to a method's numArgs.  Could have a variable set on save and return.
  	 We'll investigate this.  For the moment we just use a byte in the frameFlags
  	 field.  This is endian dependent.  Store numArgs in byte at FoxFrameFields + 1.
  	 Store hasContext flag in top bit (allows for 64-bit tags) of byte at FoxFrameFields.
  	 Make frameFields look like a SmallInteger for the benefit of gc (dubious)."
  	"bitsPerWord := BytesPerWord * 8"
  	<inline: true>
  	^VMBIGENDIAN
  		ifTrue: [1
+ 				+ (numArgs << ((objectMemory bytesPerWord * 8) - 8))
+ 				+ (hasContext ifTrue: [1 << ((objectMemory bytesPerWord * 8) - 16)] ifFalse: [0])
+ 				+  (isBlock ifTrue: [1 << ((objectMemory bytesPerWord * 8) - 24)] ifFalse: [0])]
- 				+ (numArgs << ((self bytesPerWord * 8) - 8))
- 				+ (hasContext ifTrue: [1 << ((self bytesPerWord * 8) - 16)] ifFalse: [0])
- 				+  (isBlock ifTrue: [1 << ((self bytesPerWord * 8) - 24)] ifFalse: [0])]
  		ifFalse: [1
  				+ (numArgs << 8)
  				+  (hasContext ifTrue: [1 << 16] ifFalse: [0])
  				+  (isBlock ifTrue: [1 << 24] ifFalse: [0])]!

Item was changed:
  ----- Method: StackInterpreter>>externalDivorceFrame:andContext: (in category 'frame access') -----
  externalDivorceFrame: theFP andContext: ctxt
  	"Divorce a single frame and its context.  If it is not the top frame of a stack this means splitting its stack."
  	| thePage onCurrent theSP callerCtx newPage frameAbove callerFP callerSP callerIP theIP |
  	<inline: false>
  	<var: #theFP type: #'char *'>
  	<var: #thePage type: #'StackPage *'>
  	<var: #theSP type: #'char *'>
  	<var: #newPage type: #'StackPage *'>
  	<var: #frameAbove type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	<var: #callerSP type: #'char *'>
  	"stackPage needs to have current head pointers to avoid confusion."
  	self assert: theFP ~= framePointer.
  	self assert: (stackPage = 0 or: [stackPage = stackPages mostRecentlyUsedPage]).
  	thePage := stackPages stackPageFor: theFP.
  	(onCurrent := thePage = stackPage) ifFalse:
  		[stackPages markStackPageNextMostRecentlyUsed: thePage].
  	theSP := self findSPOf: theFP on: thePage.
  	self updateStateOfSpouseContextForFrame: theFP WithSP: theSP.
  	callerCtx := self ensureCallerContext: theFP.
  	(frameAbove := self findFrameAbove: theFP inPage: thePage) == 0
  		ifTrue: "If we're divorcing the top frame we can simply peel it off."
  			[theIP := stackPages longAt: thePage headSP]
  		ifFalse: "othewise move all frames above to a new stack and then peel the frame off."
  			[newPage := self newStackPage.
  			 theIP := self oopForPointer: (self frameCallerSavedIP: frameAbove).
  			 frameAbove := self moveFramesIn: thePage through: frameAbove toPage: newPage.
  			 onCurrent
  				ifTrue:
  					[self setStackPageAndLimit: newPage.
  					 framePointer := stackPage headFP.
  					 stackPointer := stackPage headSP]
  				ifFalse:
  					[stackPages markStackPageMostRecentlyUsed: newPage].
  			 self assert: (self frameCallerContext: frameAbove) = ctxt].
  	objectMemory storePointerUnchecked: InstructionPointerIndex
  		ofObject: ctxt
  		withValue: (self contextInstructionPointer: theIP frame: theFP).
  	objectMemory storePointer: SenderIndex
  		ofObject: ctxt
  		withValue: callerCtx.
  	callerFP := self frameCallerFP: theFP.
  	callerFP == 0 "theFP is a base frame; it is now alone; free the entire page"
  		ifTrue: [stackPages freeStackPage: thePage]
  		ifFalse:
  			[callerIP := self oopForPointer: (self frameCallerSavedIP: theFP).
+ 			 callerSP := (self frameCallerSP: theFP) - objectMemory bytesPerWord.
- 			 callerSP := (self frameCallerSP: theFP) - self bytesPerWord.
  			 stackPages longAt: callerSP put: callerIP.
  			 self setHeadFP: callerFP andSP: callerSP inPage: thePage]
  	!

Item was changed:
  ----- Method: StackInterpreter>>findSPOrNilOf:on:startingFrom: (in category 'frame access') -----
  findSPOrNilOf: theFP on: thePage startingFrom: startFrame
  	"Search for the stack pointer for theFP.  This points to the hottest item on the frame's stack.
  	 DO NOT CALL THIS WITH theFP == localFP OR theFP == framePointer!!"
  	<var: #aFrame type: #'char *'>
  	<var: #theFP type: #'char *'>
  	<var: #thePage type: #'StackPage *'>
  	<returnTypeC: #'char *'>
  	| aFrame theSP |
  	<inline: true>
  	<asmLabel: false>
  	<var: #startFrame type: #'char *'>
  	<var: #theSP type: #'char *'>
  	self assert: (stackPages isFree: thePage) not.
  	aFrame := startFrame.
  	theSP := thePage headSP.
  	aFrame = theFP ifTrue:
  		[theSP >= aFrame ifTrue:
  			["If the SP is invalid return the pointer to the receiver field."
  			 ^self frameReceiverOffset: aFrame].
  		 "Skip the instruction pointer on top of stack of inactive pages."
  		^thePage = stackPage
  			ifTrue: [theSP]
+ 			ifFalse: [theSP + objectMemory bytesPerWord]].
- 			ifFalse: [theSP + self bytesPerWord]].
  	[theSP := self frameCallerSP: aFrame.
  	 aFrame := self frameCallerFP: aFrame.
  	 aFrame ~= 0] whileTrue:
  		[theFP = aFrame ifTrue:
  			[^theSP]].
  	^nil!

Item was changed:
  ----- Method: StackInterpreter>>floatObjectOf: (in category 'object format') -----
  floatObjectOf: aFloat
  	| newFloatObj |
  	<inline: false>
  	<var: #aFloat type: #double>
  	self flag: #Dan.
+ 	newFloatObj := objectMemory eeInstantiateSmallClass: (objectMemory splObj: ClassFloat) sizeInBytes: 8 + objectMemory baseHeaderSize.
+ 	objectMemory storeFloatAt: newFloatObj + objectMemory baseHeaderSize from: aFloat.
- 	newFloatObj := objectMemory eeInstantiateSmallClass: (objectMemory splObj: ClassFloat) sizeInBytes: 8 + self baseHeaderSize.
- 	objectMemory storeFloatAt: newFloatObj + self baseHeaderSize from: aFloat.
  	^ newFloatObj.
  !

Item was changed:
  ----- Method: StackInterpreter>>floatValueOf: (in category 'utilities') -----
  floatValueOf: oop
  	"Fetch the instance variable at the given index of the given object. Return the C double precision floating point value of that instance variable, or fail if it is not a Float."
  	"Note: May be called by translated primitive code."
  
  	| result |
  	<returnTypeC: #double>
  	<var: #result type: #double>
  	self flag: #Dan.  "None of the float stuff has been converted for 64 bits"
  	"N.B.  Because Slang always inlines assertClassOf:is:compactClassIndex:
  	 (because assertClassOf:is:compactClassIndex: has an inline: pragma) the
  	 phrase (self splObj: ClassArray) is expanded in-place and is _not_
  	 evaluated if ClassArrayCompactIndex is non-zero."
  	self assertClassOf: oop
  		is: (objectMemory splObj: ClassFloat)
  		compactClassIndex: ClassFloatCompactIndex.
  	self successful ifTrue:
  		[self cCode: '' inSmalltalk: [result := Float new: 2].
+ 		objectMemory fetchFloatAt: oop + objectMemory baseHeaderSize into: result.
- 		objectMemory fetchFloatAt: oop + self baseHeaderSize into: result.
  		^result].
  	^0.0!

Item was changed:
  ----- Method: StackInterpreter>>frameCallerSP: (in category 'frame access') -----
  frameCallerSP: theFP
  	"Answer the SP of the caller provided theFP is not a base frame.
  	 This points to the hottest item on the caller frame's stack."
  	<var: #theFP type: #'char *'>
  	<returnTypeC: 'char *'>
  	<asmLabel: false>
  	self assert: (self isBaseFrame: theFP) not.
+ 	^theFP + (self frameStackedReceiverOffset: theFP) + objectMemory bytesPerWord!
- 	^theFP + (self frameStackedReceiverOffset: theFP) + self bytesPerWord!

Item was changed:
  ----- Method: StackInterpreter>>frameCallerStackPointer: (in category 'frame access') -----
  frameCallerStackPointer: theFP
  	"Answer the stack pointer of the caller frame."
  	<var: #theFP type: #'char *'>
  	<returnTypeC: #'char *'>
  	<inline: true>
  	<asmLabel: false>
  	self assert: (self isBaseFrame: theFP) not.
+ 	^theFP + (self frameStackedReceiverOffset: theFP) + objectMemory bytesPerWord!
- 	^theFP + (self frameStackedReceiverOffset: theFP) + self bytesPerWord!

Item was changed:
  ----- Method: StackInterpreter>>frameInstructionPointerForContext:method: (in category 'frame access') -----
  frameInstructionPointerForContext: aContext method: aMethod
  	"Answer the instruction pointer for usage in a frame (a pointer to a bytecode)
  	 from the index instructionPointer in the given context."
  	^aMethod
  	+ (self quickFetchInteger: InstructionPointerIndex ofObject: aContext)
+ 	+ objectMemory baseHeaderSize
- 	+ self baseHeaderSize
  	- 2!

Item was changed:
  ----- Method: StackInterpreter>>frameStackedReceiver:numArgs: (in category 'frame access') -----
  frameStackedReceiver: theFP numArgs: numArgs
  	"Answer the stacked receiver given the frame's argument count.
  	 The receiver of a message send or the closure of a block activation is
  	 always on the stack above any arguments and the frame itself.  See the
  	 diagram in StackInterpreter class>>initializeFrameIndices."
  	<inline: true>
  	<var: #theFP type: #'char *'>
+ 	^stackPages longAt: theFP + FoxCallerSavedIP + objectMemory bytesPerWord + (numArgs << self shiftForWord)!
- 	^stackPages longAt: theFP + FoxCallerSavedIP + self bytesPerWord + (numArgs << self shiftForWord)!

Item was changed:
  ----- Method: StackInterpreter>>frameStackedReceiverOffset: (in category 'frame access') -----
  frameStackedReceiverOffset: theFP
  	"Answer the offset in bytes from the a frame pointer to its stacked receiver.
  	 The receiver of a message send or the closure of a block activation is
  	 always on the stack above any arguments and the frame itself.  See the
  	 diagram in StackInterpreter class>>initializeFrameIndices."
  	<inline: true>
  	<var: #theFP type: #'char *'>
+ 	^FoxCallerSavedIP + objectMemory bytesPerWord + ((self frameNumArgs: theFP) << self shiftForWord)!
- 	^FoxCallerSavedIP + self bytesPerWord + ((self frameNumArgs: theFP) << self shiftForWord)!

Item was changed:
  ----- Method: StackInterpreter>>frameStackedReceiverOffset:numArgs: (in category 'frame access') -----
  frameStackedReceiverOffset: theFP numArgs: numArgs
  	"Answer the offset in bytes from the a frame pointer to its stacked receiver.
  	 The receiver of a message send or the closure of a block activation is
  	 always on the stack above any arguments and the frame itself.  See the
  	 diagram in StackInterpreter class>>initializeFrameIndices."
  	<inline: true>
  	<var: #theFP type: #'char *'>
+ 	^FoxCallerSavedIP + objectMemory bytesPerWord + (numArgs << self shiftForWord)!
- 	^FoxCallerSavedIP + self bytesPerWord + (numArgs << self shiftForWord)!

Item was changed:
  ----- Method: StackInterpreter>>getErrorObjectFromPrimFailCode (in category 'message sending') -----
  getErrorObjectFromPrimFailCode
  	"Answer the errorCode object to supply to a failing primitive method that accepts one.
  	 If there is a primitive error table and the primFailCode is a valid index there-in answer
  	 the coprresponding entry in the table, otherwise simply answer the code as an integer."
  	| table |
  	primFailCode > 0 ifTrue:
  		[table := objectMemory splObj: PrimErrTableIndex.
+ 		 primFailCode <= ((objectMemory lastPointerOf: table) // objectMemory bytesPerWord) ifTrue:
- 		 primFailCode <= ((objectMemory lastPointerOf: table) // self bytesPerWord) ifTrue:
  			[^objectMemory fetchPointer: primFailCode - 1 ofObject: table]].
  	^objectMemory integerObjectOf: primFailCode!

Item was changed:
  ----- Method: StackInterpreter>>highBit: (in category 'stack pages') -----
  highBit: anUnsignedValue 
  	"This is a C implementation needed by stackPageByteSize when translated."
  	| shifted bitNo |
  	<var: #anUnsignedValue type: #usqInt>
  	<var: #shifted type: #usqInt>
  	shifted := anUnsignedValue.
  	bitNo := 0.
+ 	self cppIf: [objectMemory bytesPerWord > 4]
- 	self cppIf: [self bytesPerWord > 4]
  		ifTrue:
  			[shifted < (1 << 32) ifFalse:
  				[shifted := shifted >> 32.
  				 bitNo := bitNo + 32]].
  	shifted < (1 << 16) ifFalse:
  		[shifted := shifted >> 16.
  		 bitNo := bitNo + 16].
  	shifted < (1 << 8) ifFalse:
  		[shifted := shifted >> 8.
  		 bitNo := bitNo + 8].
  	shifted < (1 << 4) ifFalse:
  		[shifted := shifted >> 4.
  		 bitNo := bitNo + 4].
  	shifted < (1 << 2) ifFalse:
  		[shifted := shifted >> 2.
  		 bitNo := bitNo + 2].
  	shifted < (1 << 1) ifFalse:
  		[shifted := shifted >> 1.
  		 bitNo := bitNo + 1].
  	"shifted 0 or 1 now"
  	^bitNo + shifted!

Item was changed:
  ----- Method: StackInterpreter>>imageFormatCompatibilityVersion (in category 'image save/restore') -----
  imageFormatCompatibilityVersion
  	"This VM is backward-compatible with the immediately preceeding version."
  
+ 	^objectMemory bytesPerWord == 4 ifTrue: [6504] ifFalse: [68002]!
- 	^self bytesPerWord == 4 ifTrue: [6504] ifFalse: [68002]!

Item was changed:
  ----- Method: StackInterpreter>>imageFormatVersion (in category 'image save/restore') -----
  imageFormatVersion
  	"Return a magic constant that changes when the image format changes. Since the image reading code uses this to detect byte ordering, one must avoid version numbers that are invariant under byte reversal."
  
+ 	^objectMemory bytesPerWord == 4 ifTrue: [6505] ifFalse: [68003]!
- 	^self bytesPerWord == 4 ifTrue: [6505] ifFalse: [68003]!

Item was changed:
  ----- Method: StackInterpreter>>initStackPages (in category 'initialization') -----
  initStackPages
  	"Initialize the stackPages.  This version is only for simulation
  	 because Slang refuses to inline it, which makes the alloca invalid."
  	| stackPageBytes stackPagesBytes theStackMemory |
  	stackPageBytes := self stackPageByteSize.
  	stackPagesBytes := self computeStackZoneSize.
  	theStackMemory := self
  						cCode: 'alloca(stackPagesBytes)'
  						inSmalltalk:
  							[stackPages := self stackPagesClass new.
  							 stackPages initializeWithByteSize: stackPagesBytes for: self].
  	stackPages
  		initializeStack: theStackMemory
+ 		numSlots: stackPagesBytes / objectMemory bytesPerWord
+ 		pageSize: stackPageBytes / objectMemory bytesPerWord
- 		numSlots: stackPagesBytes / self bytesPerWord
- 		pageSize: stackPageBytes / self bytesPerWord
  		stackLimitOffset: self stackLimitOffset
  		stackPageHeadroom: self stackPageHeadroom!

Item was changed:
  ----- Method: StackInterpreter>>initStackPagesAndInterpret (in category 'initialization') -----
  initStackPagesAndInterpret
  	"Initialize the stack pages and enter interpret. Use alloca'ed memory so that when
  	 we have a JIT its stack pointer will be on the native stack since alloca allocates
  	 memory on the stack. Certain thread systems use the native stack pointer as the
  	 frame ID so putting the stack anywhere else can confuse the thread system."
  
  	"This should be in its own initStackPages method but Slang can't inline
  	 C code strings."
  	| stackPageBytes stackPagesBytes theStackMemory |
  	<var: #theStackMemory type: #'void *'>
  	stackPageBytes := self stackPageByteSize.
  	stackPagesBytes := self computeStackZoneSize.
  	theStackMemory := self
  						cCode: 'alloca(stackPagesBytes)'
  						inSmalltalk:
  							[stackPages := self stackPagesClass new.
  							 stackPages initializeWithByteSize: stackPagesBytes for: self].
  	stackPages
  		initializeStack: theStackMemory
+ 		numSlots: stackPagesBytes / objectMemory bytesPerWord
+ 		pageSize: stackPageBytes / objectMemory bytesPerWord
- 		numSlots: stackPagesBytes / self bytesPerWord
- 		pageSize: stackPageBytes / self bytesPerWord
  		stackLimitOffset: self stackLimitOffset
  		stackPageHeadroom: self stackPageHeadroom.
  
  	"Once the stack pages are initialized we can continue to bootstrap the system."
  	self loadInitialContext.
  	"We're ready for the heartbeat (poll interrupt)"
  	self ioInitHeartbeat.
  	self interpret.
  	^nil!

Item was changed:
  ----- Method: StackInterpreter>>initialPCForHeader:method: (in category 'compiled methods') -----
  initialPCForHeader: methodHeader method: theMethod
+ 	^theMethod + ((LiteralStart + (self literalCountOfHeader: methodHeader)) * objectMemory bytesPerWord) + objectMemory baseHeaderSize!
- 	^theMethod + ((LiteralStart + (self literalCountOfHeader: methodHeader)) * self bytesPerWord) + self baseHeaderSize!

Item was changed:
  ----- Method: StackInterpreter>>internalPop: (in category 'internal interpreter access') -----
  internalPop: nItems
  	"In the StackInterpreter stacks grow down."
+ 	localSP := localSP + (nItems * objectMemory bytesPerWord)!
- 	localSP := localSP + (nItems * self bytesPerWord)!

Item was changed:
  ----- Method: StackInterpreter>>internalPop:thenPush: (in category 'internal interpreter access') -----
  internalPop: nItems thenPush: oop
  	"In the StackInterpreter stacks grow down."
+ 	stackPages longAtPointer: (localSP := localSP + ((nItems - 1) * objectMemory bytesPerWord)) put: oop!
- 	stackPages longAtPointer: (localSP := localSP + ((nItems - 1) * self bytesPerWord)) put: oop!

Item was changed:
  ----- Method: StackInterpreter>>internalPopStack (in category 'internal interpreter access') -----
  internalPopStack
  	"In the StackInterpreter stacks grow down."
  	| top |
  	top := stackPages longAt: localSP.
+ 	localSP := localSP + objectMemory bytesPerWord.
- 	localSP := localSP + self bytesPerWord.
  	^top!

Item was changed:
  ----- Method: StackInterpreter>>internalPush: (in category 'internal interpreter access') -----
  internalPush: object
  	"In the StackInterpreter stacks grow down."
+ 	stackPages longAtPointer: (localSP := localSP - objectMemory bytesPerWord) put: object!
- 	stackPages longAtPointer: (localSP := localSP - self bytesPerWord) put: object!

Item was changed:
  ----- Method: StackInterpreter>>internalStackValue: (in category 'internal interpreter access') -----
  internalStackValue: offset
  	"In the StackInterpreter stacks grow down."
+ 	^stackPages longAtPointer: localSP + (offset * objectMemory bytesPerWord)!
- 	^stackPages longAtPointer: localSP + (offset * self bytesPerWord)!

Item was changed:
  ----- Method: StackInterpreter>>interpreterAllocationReserveBytes (in category 'stack pages') -----
  interpreterAllocationReserveBytes
  	"At a rough approximation we may need to allocate up to a couple
  	 of page's worth of contexts when switching stack pages, assigning
  	 to senders, etc.  But the snapshot primitive voids all stack pages.
  	 So a safe margin is the size of a large context times the maximum
  	 number of frames per page times the number of pages."
  	| availableBytesPerPage maxFramesPerPage |
  	availableBytesPerPage := self stackPageByteSize - self stackLimitOffset - self stackPageHeadroom.
+ 	maxFramesPerPage := availableBytesPerPage / objectMemory bytesPerWord // FrameSlots.
- 	maxFramesPerPage := availableBytesPerPage / self bytesPerWord // FrameSlots.
  	^2 raisedTo: (maxFramesPerPage * LargeContextSize * numStackPages) highBit!

Item was changed:
  ----- Method: StackInterpreter>>loadFloatOrIntFrom: (in category 'utilities') -----
  loadFloatOrIntFrom: floatOrInt
  	"If floatOrInt is an integer, then convert it to a C double float and return it.
  	If it is a Float, then load its value and return it.
  	Otherwise fail -- ie return with primErrorCode non-zero."
  
  	| result |
  	<inline: true>
  	<asmLabel: false>
  	<returnTypeC: #double>
  	<var: #result type: #double>
  
  	(objectMemory isIntegerObject: floatOrInt) ifTrue:
  		[^(objectMemory integerValueOf: floatOrInt) asFloat].
  	self assertClassOf: floatOrInt
  		is: (objectMemory splObj: ClassFloat)
  		compactClassIndex: ClassFloatCompactIndex.
  	self cCode: '' inSmalltalk: [result := Float new: 2].
  	self successful ifTrue:
+ 		[objectMemory fetchFloatAt: floatOrInt + objectMemory baseHeaderSize into: result].
- 		[objectMemory fetchFloatAt: floatOrInt + self baseHeaderSize into: result].
  	^result!

Item was changed:
  ----- Method: StackInterpreter>>lookupMethodInClass: (in category 'message sending') -----
  lookupMethodInClass: class
  	| currentClass dictionary found |
  	<inline: false>
  	self assert: class ~~ objectMemory nilObject.
  	currentClass := class.
  	[currentClass ~= objectMemory nilObject]
  		whileTrue:
  		[dictionary := objectMemory fetchPointer: MethodDictionaryIndex ofObject: currentClass.
  		dictionary = objectMemory nilObject ifTrue:
  			["MethodDict pointer is nil (hopefully due a swapped out stub)
  				-- raise exception #cannotInterpret:."
  			self createActualMessageTo: class.
  			messageSelector := objectMemory splObj: SelectorCannotInterpret.
+ 			self sendBreak: messageSelector + objectMemory baseHeaderSize
- 			self sendBreak: messageSelector + self baseHeaderSize
  				point: (objectMemory lengthOf: messageSelector)
  				receiver: nil.
  			^self lookupMethodInClass: (self superclassOf: currentClass)].
  		found := self lookupMethodInDictionary: dictionary.
  		found ifTrue: [^currentClass].
  		currentClass := self superclassOf: currentClass].
  
  	"Could not find #doesNotUnderstand: -- unrecoverable error."
  	messageSelector = (objectMemory splObj: SelectorDoesNotUnderstand) ifTrue:
  		[self error: 'Recursive not understood error encountered'].
  
  	"Cound not find a normal message -- raise exception #doesNotUnderstand:"
  	self createActualMessageTo: class.
  	messageSelector := objectMemory splObj: SelectorDoesNotUnderstand.
+ 	self sendBreak: messageSelector + objectMemory baseHeaderSize
- 	self sendBreak: messageSelector + self baseHeaderSize
  		point: (objectMemory lengthOf: messageSelector)
  		receiver: nil.
  	^self lookupMethodInClass: class!

Item was changed:
  ----- Method: StackInterpreter>>makeBaseFrameFor: (in category 'frame access') -----
  makeBaseFrameFor: aContext "<Integer>"
  	"Marry aContext with the base frame of a new stack page.  Build
  	 the base frame to reflect the context's state.  Answer the new page."
  	| page pointer theMethod numArgs stackPtrIndex maybeClosure |
  	<inline: false>
  	<var: #page type: #'StackPage *'>
  	<var: #pointer type: #'char *'>
  	<returnTypeC: 'StackPage *'>
  	self assert: (self isSingleContext: aContext).
  	page := self newStackPage.
  	pointer := page baseAddress.
  	theMethod := objectMemory fetchPointer: MethodIndex ofObject: aContext.
  	"If the frame is a closure activation then the closure should be on the stack in
  	 the pushed receiver position (closures receiver the value[:value:] messages).
  	 Otherwise it should be the receiver proper."
  	maybeClosure := (objectMemory fetchPointer: ClosureIndex ofObject: aContext).
  	maybeClosure ~= objectMemory nilObject
  		ifTrue: [numArgs := self argumentCountOfClosure: maybeClosure.
  			 stackPages longAt: pointer put: maybeClosure]
  		ifFalse:
  			[numArgs := self argumentCountOf: theMethod.
  			 stackPages longAt: pointer put: (objectMemory fetchPointer: ReceiverIndex ofObject: aContext)].
  	"Put the arguments on the stack"
  	1 to: numArgs do:
  		[:i|
  		stackPages
+ 			longAt: (pointer := pointer - objectMemory bytesPerWord)
- 			longAt: (pointer := pointer - self bytesPerWord)
  			put: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)].
  	"saved caller ip is sender context in base frame"
  	stackPages
+ 		longAt: (pointer := pointer - objectMemory bytesPerWord)
- 		longAt: (pointer := pointer - self bytesPerWord)
  		put: (objectMemory fetchPointer: SenderIndex ofObject: aContext).
  	"base frame's saved fp is null"
  	stackPages
+ 		longAt: (pointer := pointer - objectMemory bytesPerWord)
- 		longAt: (pointer := pointer - self bytesPerWord)
  		put: 0.
  	page baseFP: pointer; headFP: pointer.
  	stackPages
+ 		longAt: (pointer := pointer - objectMemory bytesPerWord)
- 		longAt: (pointer := pointer - self bytesPerWord)
  		put: theMethod.
  	stackPages
+ 		longAt: (pointer := pointer - objectMemory bytesPerWord)
- 		longAt: (pointer := pointer - self bytesPerWord)
  		put: (self encodeFrameFieldHasContext: true isBlock: maybeClosure ~= objectMemory nilObject numArgs: numArgs).
  	self assert: (self frameHasContext: page baseFP).
  	self assert: (self frameNumArgs: page baseFP) == numArgs.
  	stackPages
+ 		longAt: (pointer := pointer - objectMemory bytesPerWord)
- 		longAt: (pointer := pointer - self bytesPerWord)
  		put: aContext.
  	stackPages
+ 		longAt: (pointer := pointer - objectMemory bytesPerWord)
- 		longAt: (pointer := pointer - self bytesPerWord)
  		put: (objectMemory fetchPointer: ReceiverIndex ofObject: aContext).
  	stackPtrIndex := self quickFetchInteger: StackPointerIndex ofObject: aContext.
  	self assert: ReceiverIndex + stackPtrIndex < (objectMemory lengthOf: aContext).
  	numArgs + 1 to: stackPtrIndex do:
  		[:i|
  		stackPages
+ 			longAt: (pointer := pointer - objectMemory bytesPerWord)
- 			longAt: (pointer := pointer - self bytesPerWord)
  			put: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)].
  	"last thing on stack is the instruction pointer"
  	(objectMemory isIntegerObject: (objectMemory fetchPointer: InstructionPointerIndex ofObject: aContext)) ifFalse:
  		[self error: 'context is not resumable'].
  	stackPages
+ 		longAt: (pointer := pointer - objectMemory bytesPerWord)
- 		longAt: (pointer := pointer - self bytesPerWord)
  		put: (self frameInstructionPointerForContext: aContext method: theMethod).
  	self assert: (objectMemory fetchPointer: InstructionPointerIndex ofObject: aContext)
  			= (self contextInstructionPointer: (stackPages longAt: pointer) frame: page baseFP).
  	page headSP: pointer.
  
  	"Mark context as married by setting its sender to the frame pointer plus SmallInteger
  	 tags and the InstructionPointer to the saved fp (which ensures correct alignment
  	 w.r.t. the frame when we check for validity)"
  	objectMemory storePointerUnchecked: SenderIndex
  		ofObject: aContext
  		withValue: (self withSmallIntegerTags: page baseFP).
  	objectMemory storePointerUnchecked: InstructionPointerIndex
  		ofObject: aContext
  		withValue: (self withSmallIntegerTags: 0).
  	self assert: (objectMemory isIntegerObject: (objectMemory fetchPointer: SenderIndex ofObject: aContext)).
  	self assert: (self frameOfMarriedContext: aContext) = page baseFP.
  
  	^page!

Item was changed:
  ----- Method: StackInterpreter>>makePointwithxValue:yValue: (in category 'utilities') -----
  makePointwithxValue: xValue yValue: yValue
  "make a Point xValue at yValue.
  We know both will be integers so no value nor root checking is needed"
  	| pointResult |
+ 	pointResult := objectMemory eeInstantiateSmallClass: (objectMemory splObj: ClassPoint) sizeInBytes: 3 * objectMemory bytesPerWord.
- 	pointResult := objectMemory eeInstantiateSmallClass: (objectMemory splObj: ClassPoint) sizeInBytes: 3 * self bytesPerWord.
  	objectMemory storePointerUnchecked: XIndex ofObject: pointResult withValue: (objectMemory integerObjectOf: xValue).
  	objectMemory storePointerUnchecked: YIndex ofObject: pointResult withValue: (objectMemory integerObjectOf: yValue).
  	^ pointResult!

Item was changed:
  ----- Method: StackInterpreter>>mapStackPages (in category 'object memory support') -----
  mapStackPages
  	<inline: false>
  	<var: #thePage type: #'StackPage *'>
  	<var: #theSP type: #'char *'>
  	<var: #theFP type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	<var: #theIPPtr type: #'char *'>
  	"Need to write back the frame pointers unless all pages are free (as in snapshot)"
  	stackPage ~= 0 ifTrue:
  		[self externalWriteBackHeadFramePointers].
  	0 to: numStackPages - 1 do:
  		[:i| | thePage theSP theFP callerFP theIPPtr theIP oop |
  		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
  				ifTrue: [theIPPtr := 0]
  				ifFalse:
  					[theIPPtr := theSP.
+ 					 theSP := theSP + objectMemory bytesPerWord].
- 					 theSP := theSP + self bytesPerWord].
  			[self assert: (thePage addressIsInPage: theFP).
  			 self assert: (thePage addressIsInPage: theSP).
  			 self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theFP]).
  			 [theSP <= (theFP + FoxReceiver)] whileTrue:
  				[oop := stackPages longAt: theSP.
  				 (objectMemory isIntegerObject: oop) ifFalse:
  					[stackPages longAt: theSP put: (objectMemory remap: oop)].
+ 				 theSP := theSP + objectMemory bytesPerWord].
- 				 theSP := theSP + self bytesPerWord].
  			 (self frameHasContext: theFP) ifTrue:
  				[stackPages
  					longAt: theFP + FoxThisContext
  					put: (objectMemory remap: (self frameContext: theFP))].
  			 theIPPtr ~= 0 ifTrue:
  				[self assert: (stackPages longAt: theIPPtr) > (self frameMethod: theFP).
  				 theIP := (stackPages longAt: theIPPtr) - (self frameMethod: theFP)].
  			 stackPages
  				longAt: theFP + FoxMethod
  				put: (objectMemory remap: (self frameMethod: theFP)).
  			 theIPPtr ~= 0 ifTrue:
  				[stackPages longAt: theIPPtr put: theIP + (self frameMethod: theFP)].
  			 (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
+ 				[theSP := (theIPPtr := theFP + FoxCallerSavedIP) + objectMemory bytesPerWord.
- 				[theSP := (theIPPtr := theFP + FoxCallerSavedIP) + self bytesPerWord.
  				 theFP := callerFP].
  			 theSP := theFP + FoxCallerContext. "a.k.a. FoxCallerSavedIP"
  			 [theSP <= thePage baseAddress] whileTrue:
  				[oop := stackPages longAt: theSP.
  				 (objectMemory isIntegerObject: oop) ifFalse:
  					[stackPages longAt: theSP put: (objectMemory remap: oop)].
+ 				 theSP := theSP + objectMemory bytesPerWord]]]!
- 				 theSP := theSP + self bytesPerWord]]]!

Item was changed:
  ----- Method: StackInterpreter>>markAndTraceStackPage: (in category 'object memory support') -----
  markAndTraceStackPage: thePage
  	| theSP theFP frameRcvrOffset callerFP oop |
  	<var: #thePage type: #'StackPage *'>
  	<var: #theSP type: #'char *'>
  	<var: #theFP type: #'char *'>
  	<var: #frameRcvrOffset type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	<inline: false>
  	self assert: (stackPages isFree: thePage) not.
  	theSP := thePage headSP.
  	theFP := thePage  headFP.
  	"Skip the instruction pointer on top of stack of inactive pages."
  	thePage = stackPage ifFalse:
+ 		[theSP := theSP + objectMemory bytesPerWord].
- 		[theSP := theSP + self bytesPerWord].
  	[frameRcvrOffset := self frameReceiverOffset: theFP.
  	 [theSP <= frameRcvrOffset] whileTrue:
  		[oop := stackPages longAt: theSP.
  		 (objectMemory isIntegerObject: oop) ifFalse:
  			[objectMemory markAndTrace: oop].
+ 		 theSP := theSP + objectMemory bytesPerWord].
- 		 theSP := theSP + self bytesPerWord].
  	(self frameHasContext: theFP) ifTrue:
  		[self assert: (self isContext: (self frameContext: theFP)).
  		 objectMemory markAndTrace: (self frameContext: theFP)].
  	objectMemory markAndTrace: (self iframeMethod: theFP).
  	(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
+ 		[theSP := theFP + FoxCallerSavedIP + objectMemory bytesPerWord.
- 		[theSP := theFP + FoxCallerSavedIP + self bytesPerWord.
  		 theFP := callerFP].
  	theSP := self isCog
+ 				ifTrue: [theFP + FoxCallerSavedIP + objectMemory bytesPerWord] "caller ip is ceBaseReturnPC"
- 				ifTrue: [theFP + FoxCallerSavedIP + self bytesPerWord] "caller ip is ceBaseReturnPC"
  				ifFalse: [theFP + FoxCallerSavedIP]. "caller ip is frameCallerContext in a base frame"
  	[theSP <= thePage baseAddress] whileTrue:
  		[oop := stackPages longAt: theSP.
  		 (objectMemory isIntegerObject: oop) ifFalse:
  			[objectMemory markAndTrace: oop].
+ 		 theSP := theSP + objectMemory bytesPerWord]!
- 		 theSP := theSP + self bytesPerWord]!

Item was changed:
  ----- Method: StackInterpreter>>marriedContext:pointsTo:stackDeltaForCurrentFrame: (in category 'frame access') -----
  marriedContext: spouseContext pointsTo: anOop stackDeltaForCurrentFrame: stackDeltaForCurrentFrame
  	"This is a helper for primitiveObjectPointsTo so it *does not* check the frameContext field because that is an implicit self-reference not present in the stale ."
  	| theFP thePage theSP rcvrOffset |
  	<inline: false>
  	<var: #theFP type: #'char *'>
  	<var: #thePage type: #'StackPage *'>
  	<var: #theSP type: #'char *'>
  	<var: #rcvrOffset type: #'char *'>
  	theFP := self frameOfMarriedContext: spouseContext.
  	theFP = framePointer
+ 		ifTrue: [theSP := stackPointer + (stackDeltaForCurrentFrame * objectMemory bytesPerWord)]
- 		ifTrue: [theSP := stackPointer + (stackDeltaForCurrentFrame * self bytesPerWord)]
  		ifFalse:
  			[thePage := stackPages stackPageFor: theFP.
  			theSP := self findSPOf: theFP on: thePage].
  	(objectMemory isIntegerObject: anOop)
  		ifTrue: "Check stack and instruction pointer fields."
  			[(anOop = (objectMemory integerObjectOf: (self stackPointerIndexForFrame: theFP WithSP: theSP))
  			or: [anOop = (self externalInstVar: InstructionPointerIndex ofContext: spouseContext)]) ifTrue:
  				[^true]]
  		ifFalse: "Check method and sender fields, avoiding unnecessarily reifying sender context."
  			[anOop = (self frameMethodObject: theFP) ifTrue:
  				[^true].
  			 (self isBaseFrame: theFP)
  				ifTrue: [anOop = (self frameCallerContext: theFP) ifTrue:
  							[^true]]
  				ifFalse: [((self frameHasContext: (self frameCallerFP: theFP))
  						and: [anOop = (self frameContext: (self frameCallerFP: theFP))]) ifTrue:
  							[^true]]].
  	"Now check receiver, temps and stack contents"
  	rcvrOffset := self frameReceiverOffset: theFP.
  	 [theSP <= rcvrOffset] whileTrue:
  		[anOop = (stackPages longAt: theSP) ifTrue:
  			[^true].
+ 		 theSP := theSP + objectMemory bytesPerWord].
- 		 theSP := theSP + self bytesPerWord].
  	"Finally check stacked receiver (closure field or duplicate of receiver) and arguments"
+ 	theSP := theFP + FoxCallerSavedIP + objectMemory bytesPerWord.
- 	theSP := theFP + FoxCallerSavedIP + self bytesPerWord.
  	rcvrOffset := theFP + (self frameStackedReceiverOffset: theFP).
  	 [theSP <= rcvrOffset] whileTrue:
  		[anOop = (stackPages longAt: theSP) ifTrue:
  			[^true].
+ 		 theSP := theSP + objectMemory bytesPerWord].
- 		 theSP := theSP + self bytesPerWord].
  	^false!

Item was changed:
  ----- Method: StackInterpreter>>marryFrame:SP: (in category 'frame access') -----
  marryFrame: theFP SP: theSP
  	"Marry an unmarried frame.  This means creating a spouse context
  	 initialized with a subset of the frame's state (state through the last argument)
  	 that references the frame."
  	| theContext methodHeader byteSize numArgs numStack closureOrNil |
  	<inline: false>
  	<var: #theFP type: #'char *'>
  	<var: #theSP type: #'char *'>
  	self assert: (self frameHasContext: theFP) not.
  
  	methodHeader := self headerOf: (self frameMethod: theFP).
  	"Decide how much of the stack to preserve in widowed contexts.  Preserving too much
  	 state will potentially hold onto garbage.  Holding onto too little may mean that a dead
  	 context isn't informative enough in a debugging situation.  We compromise, retaining
  	 only the arguments with no temporaries.  Note that we still set the stack pointer to its
  	 current value, but stack contents other than the arguments are nil."
  	numArgs := self frameNumArgs: theFP.
  	numStack := self stackPointerIndexForFrame: theFP WithSP: theSP.
  
  	closureOrNil := (self frameIsBlockActivation: theFP)
  						ifTrue: [self pushedReceiverOrClosureOfFrame: theFP]
  						ifFalse: [objectMemory nilObject].
  
  	byteSize := (methodHeader bitAnd: LargeContextBit) ~= 0
  					ifTrue: [LargeContextSize]
  					ifFalse: [SmallContextSize].
  	theContext := objectMemory eeInstantiateMethodContextByteSize: byteSize.
+ 	self assert: numStack + ReceiverIndex << self shiftForWord + objectMemory baseHeaderSize <= byteSize. 
- 	self assert: numStack + ReceiverIndex << self shiftForWord + self baseHeaderSize <= byteSize. 
  	"Mark context as married by setting its sender to the frame pointer plus SmallInteger
  	 tags and the InstructionPointer to the saved fp (which ensures correct alignment
  	 w.r.t. the frame when we check for validity)"
  	objectMemory storePointerUnchecked: SenderIndex
  		ofObject: theContext
  		withValue: (self withSmallIntegerTags: theFP).
  	objectMemory storePointerUnchecked: InstructionPointerIndex
  		ofObject: theContext
  		withValue: (self withSmallIntegerTags: (self frameCallerFP: theFP)).
  	objectMemory storePointerUnchecked: StackPointerIndex
  		ofObject: theContext
  		withValue: (objectMemory integerObjectOf: numStack).
  	objectMemory storePointerUnchecked: MethodIndex
  		ofObject: theContext
  		withValue: (self frameMethod: theFP).
  	objectMemory storePointerUnchecked: ClosureIndex ofObject: theContext withValue: closureOrNil.
  	objectMemory storePointerUnchecked: ReceiverIndex
  		ofObject: theContext
  		withValue: (self frameReceiver: theFP).
  	"Store just the arguments.  If the frame is divorced the context
  	 will have valid arguments but all temporaries will be nil."
  	1 to: numArgs do:
  		[:i|
  		objectMemory storePointerUnchecked: ReceiverIndex + i
  			ofObject: theContext "inline self temporary: i - 1 in:theFP" 
  			withValue: (stackPages longAt: theFP
  										+ FoxCallerSavedIP
+ 										+ ((numArgs - i + 1) * objectMemory bytesPerWord))].
- 										+ ((numArgs - i + 1) * self bytesPerWord))].
  	numArgs + 1 to: numStack do:
  		[:i|
  		objectMemory storePointerUnchecked: ReceiverIndex + i
  			ofObject: theContext
  			withValue: objectMemory nilObject].
  
  	stackPages longAt: theFP + FoxThisContext put: theContext.
  	stackPages byteAt: theFP + FoxFrameFlags + 2 put: 1.
  
  	self assert: (self frameHasContext: theFP).
  	self assert: (self frameOfMarriedContext: theContext) = theFP.
  	self assert: numStack + ReceiverIndex < (objectMemory lengthOf: theContext).
  
  	^theContext
  !

Item was changed:
  ----- Method: StackInterpreter>>moveFramesIn:through:toPage: (in category 'frame access') -----
  moveFramesIn: oldPage through: theFP toPage: newPage
  	"Move frames from the hot end of oldPage through to theFP to newPage.
  	 This has the effect of making theFP a base frame which can be stored into.
  	 Answer theFP's new location."
  	| newSP newFP stackedReceiverOffset delta callerFP callerIP fpInNewPage offsetCallerFP theContext |
  	<inline: false>
  	<var: #oldPage type: #'StackPage *'>
  	<var: #theFP type: #'char *'>
  	<var: #newPage type: #'StackPage *'>
  	<var: #newSP type: #'char *'>
  	<var: #newFP type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	<var: #fpInNewPage type: #'char *'>
  	<var: #offsetCallerFP type: #'char *'>
  	<var: #source type: #'char *'>
  	<returnTypeC: 'char *'>
+ 	newSP := newPage baseAddress + objectMemory bytesPerWord.
- 	newSP := newPage baseAddress + self bytesPerWord.
  	stackedReceiverOffset := self frameStackedReceiverOffset: theFP.
  	"First move the data.  We will fix up frame pointers later."
  	theFP + stackedReceiverOffset
  		to: oldPage headSP
+ 		by: objectMemory bytesPerWord negated
- 		by: self bytesPerWord negated
  		do: [:source|
+ 			newSP := newSP - objectMemory bytesPerWord.
- 			newSP := newSP - self bytesPerWord.
  			stackPages longAt: newSP put: (stackPages longAt: source)].
  	"newSP = oldSP + delta => delta = newSP - oldSP"
  	delta := newSP - oldPage headSP.
  	newFP := newPage baseAddress - stackedReceiverOffset.
  	self setHeadFP: oldPage headFP + delta andSP: newSP inPage: newPage.
  	newPage baseFP: newFP.
  	callerFP := self frameCallerFP: theFP.
  	self assert: (self isBaseFrame: theFP) not.
  	self assert: (self frameHasContext: callerFP).
  	callerIP := self oopForPointer: (self frameCallerSavedIP: theFP).
  	stackPages longAt: theFP + stackedReceiverOffset put: callerIP.
  	oldPage
  		headFP: callerFP;
  		headSP: theFP + stackedReceiverOffset.
  	"Mark the new base frame in the new page (FoxCallerContext a.k.a. FoxCallerSavedIP)"
  	stackPages longAt: newFP + FoxCallerContext put:  (self frameContext: callerFP).
  	stackPages longAt: newFP + FoxSavedFP put: 0.
  	"Now relocate frame pointers, updating married contexts to refer to their moved spouse frames."
  	fpInNewPage := newPage headFP.
  	[offsetCallerFP := self frameCallerFP: fpInNewPage.
  	 offsetCallerFP ~= 0 ifTrue:
  		[offsetCallerFP := offsetCallerFP + delta].
  	 stackPages longAt: fpInNewPage + FoxSavedFP put: (self oopForPointer: offsetCallerFP).
  	 (self frameHasContext: fpInNewPage) ifTrue:
  		[theContext := self frameContext: fpInNewPage.
  		 objectMemory storePointerUnchecked: SenderIndex
  			ofObject: theContext
  			withValue: (self withSmallIntegerTags: fpInNewPage).
  		 objectMemory storePointerUnchecked: InstructionPointerIndex
  			ofObject: theContext
  			withValue: (self withSmallIntegerTags: offsetCallerFP)].
  	 fpInNewPage := offsetCallerFP.
  	 fpInNewPage ~= 0] whileTrue.
  	^newFP!

Item was changed:
  ----- Method: StackInterpreter>>pop: (in category 'internal interpreter access') -----
  pop: nItems
  	<inline: true>
  	"In the StackInterpreter stacks grow down."
+ 	stackPointer := stackPointer + (nItems * objectMemory bytesPerWord).
- 	stackPointer := stackPointer + (nItems * self bytesPerWord).
  	^nil!

Item was changed:
  ----- Method: StackInterpreter>>pop:thenPush: (in category 'internal interpreter access') -----
  pop: nItems thenPush: oop
  	"In the StackInterpreter stacks grow down."
  	| sp |
  	<inline: true>
  	<var: #sp type: #'char *'>
+ 	stackPages longAt: (sp := stackPointer + ((nItems - 1) * objectMemory bytesPerWord)) put: oop.
- 	stackPages longAt: (sp := stackPointer + ((nItems - 1) * self bytesPerWord)) put: oop.
  	stackPointer := sp!

Item was changed:
  ----- Method: StackInterpreter>>pop:thenPushBool: (in category 'internal interpreter access') -----
  pop: nItems thenPushBool: trueOrFalse
  	"In the StackInterpreter stacks grow down."
  	| sp |
  	<inline: true>
  	<var: #sp type: #'char *'>
  	stackPages
+ 		longAt: (sp := stackPointer + ((nItems - 1) * objectMemory bytesPerWord))
- 		longAt: (sp := stackPointer + ((nItems - 1) * self bytesPerWord))
  		put: (trueOrFalse ifTrue: [objectMemory trueObject] ifFalse: [objectMemory falseObject]).
  	stackPointer := sp!

Item was changed:
  ----- Method: StackInterpreter>>pop:thenPushFloat: (in category 'internal interpreter access') -----
  pop: nItems thenPushFloat: f
  	"In the StackInterpreter stacks grow down."
  	| sp |
  	<inline: true>
  	<var: #f type: #double>
  	<var: #sp type: #'char *'>
  	stackPages
+ 		longAt: (sp := stackPointer + ((nItems - 1) * objectMemory bytesPerWord))
- 		longAt: (sp := stackPointer + ((nItems - 1) * self bytesPerWord))
  		put: (self floatObjectOf: f).
  	stackPointer := sp!

Item was changed:
  ----- Method: StackInterpreter>>pop:thenPushInteger: (in category 'internal interpreter access') -----
  pop: nItems thenPushInteger: integerVal
  	"lots of places pop a few items off the stack and then push an integer. Make it convenient.
  	 In the StackInterpreter stacks grow down."
  	| sp |
  	<var: #sp type: #'char *'>
  	stackPages
+ 		longAt: (sp := stackPointer + ((nItems - 1) * objectMemory bytesPerWord))
- 		longAt: (sp := stackPointer + ((nItems - 1) * self bytesPerWord))
  		put: (objectMemory integerObjectOf: integerVal).
  	stackPointer := sp!

Item was changed:
  ----- Method: StackInterpreter>>popFloat (in category 'stack bytecodes') -----
  popFloat
  	"Note: May be called by translated primitive code."
  
  	| top result |
  	<returnTypeC: #double>
  	<var: #result type: #double>
  	top := self popStack.
  	"N.B.  Because Slang always inlines assertClassOf:is:compactClassIndex:
  	 (because assertClassOf:is:compactClassIndex: has an inline: pragma) the
  	 phrase (self splObj: ClassArray) is expanded in-place and is _not_
  	 evaluated if ClassArrayCompactIndex is non-zero."
  	self assertClassOf: top
  		is: (objectMemory splObj: ClassFloat)
  		compactClassIndex: ClassFloatCompactIndex.
  	self successful ifTrue:
  		[self cCode: '' inSmalltalk: [result := Float new: 2].
+ 		objectMemory fetchFloatAt: top + objectMemory baseHeaderSize into: result].
- 		objectMemory fetchFloatAt: top + self baseHeaderSize into: result].
  	^ result!

Item was changed:
  ----- Method: StackInterpreter>>popStack (in category 'internal interpreter access') -----
  popStack
  	"In the StackInterpreter stacks grow down."
  	| top |
  	<inline: true>
  	top := stackPages longAt: stackPointer.
+ 	stackPointer := stackPointer + objectMemory bytesPerWord.
- 	stackPointer := stackPointer + self bytesPerWord.
  	^top!

Item was changed:
  ----- Method: StackInterpreter>>positive32BitIntegerFor: (in category 'primitive support') -----
  positive32BitIntegerFor: integerValue
  
  	| newLargeInteger |
  	"Note - integerValue is interpreted as POSITIVE, eg, as the result of
  		Bitmap>at:, or integer>bitAnd:."
  	integerValue >= 0
  		ifTrue: [(objectMemory isIntegerValue: integerValue)
  					ifTrue: [^ objectMemory integerObjectOf: integerValue]].
  
+ 	self cppIf: objectMemory bytesPerWord = 4
- 	self cppIf: self bytesPerWord = 4
  		ifTrue: "Faster instantiateSmallClass: currently only works with integral word size."
  			[newLargeInteger := objectMemory
  									eeInstantiateSmallClass: (objectMemory splObj: ClassLargePositiveInteger)
+ 									sizeInBytes: objectMemory baseHeaderSize + 4]
- 									sizeInBytes: self baseHeaderSize + 4]
  		ifFalse: "Cant use instantiateSmallClass: due to integral word requirement."
  			[newLargeInteger := objectMemory
  									eeInstantiateClass: (objectMemory splObj: ClassLargePositiveInteger)
  									indexableSize: 4].
  	objectMemory storeByte: 3 ofObject: newLargeInteger withValue: ((integerValue >> 24) bitAnd: 16rFF).
  	objectMemory storeByte: 2 ofObject: newLargeInteger withValue: ((integerValue >> 16) bitAnd: 16rFF).
  	objectMemory storeByte: 1 ofObject: newLargeInteger withValue: ((integerValue >> 8) bitAnd: 16rFF).
  	objectMemory storeByte: 0 ofObject: newLargeInteger withValue: (integerValue bitAnd: 16rFF).
  	^newLargeInteger!

Item was changed:
  ----- Method: StackInterpreter>>primitiveObject:perform:withArguments:lookedUpIn: (in category 'control primitives') -----
  primitiveObject: actualReceiver perform: selector withArguments: argumentArray lookedUpIn: lookupClass
  	"Common routine used by perform:withArgs:, perform:withArgs:inSuperclass:,
  	 object:perform:withArgs:inClass: et al.  Answer nil on success.
  
  	 NOTE:  The case of doesNotUnderstand: is not a failure to perform.
  	 The only failures are arg types and consistency of argumentCount.
  
  	 Since we're in the stack VM we can assume there is space to push the arguments
  	 provided they are within limits (max argument count is 15).  We can therefore deal
  	 with the arbitrary amount of state to remove from the stack (lookup class, selector,
  	 mirror receiver) and arbitrary argument orders by deferring popping anything until
  	 we know whether the send has succeeded.  So on failure we merely have to remove
  	 the actual receiver and arguments pushed, and on success we have to slide the actual
  	 receiver and arguments down to replace the original ones."
  
  	| arraySize performArgCount delta |
  	(objectMemory isArray: argumentArray) ifFalse:
  		[^self primitiveFailFor: PrimErrBadArgument].
  
  	"Check if number of arguments is reasonable; MaxNumArgs isn't available
  	 so just use LargeContextSize"
  	arraySize := objectMemory fetchWordLengthOf: argumentArray.
+ 	arraySize > (LargeContextSize / objectMemory bytesPerWord) ifTrue:
- 	arraySize > (LargeContextSize / self bytesPerWord) ifTrue:
  		[^self primitiveFailFor: PrimErrBadNumArgs].
  
  	performArgCount := argumentCount.
  	"Push newMethod to save it in case of failure,
  	 then push the actual receiver and args out of the array."
  	self push: newMethod.
  	self push: actualReceiver.
  	"Copy the arguments to the stack, and execute"
  	1 to: arraySize do:
  		[:index| self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray)].
  	argumentCount := arraySize.
  	messageSelector := selector.
+ 	self sendBreak: messageSelector + objectMemory baseHeaderSize
- 	self sendBreak: messageSelector + self baseHeaderSize
  		point: (objectMemory lengthOf: messageSelector)
  		receiver: actualReceiver.
  	self findNewMethodInClass: lookupClass.
  
  	"Only test CompiledMethods for argument count - any other objects playacting as CMs will have to take their chances"
  	((objectMemory isOopCompiledMethod: newMethod)
  	  and: [(self argumentCountOf: newMethod) ~= argumentCount]) ifTrue:
  		["Restore the state by popping all those array entries and pushing back the selector and array, and fail"
  		 self pop: arraySize + 1.
  		 newMethod := self popStack.
  		 ^self primitiveFailFor: PrimErrBadNumArgs].
  
  	"Cannot fail this primitive from here-on.  Slide the actual receiver and arguments down
  	 to replace the perform arguments and saved newMethod and then execute the new
  	 method. Use argumentCount not arraySize because an MNU may have changed it."
+ 	delta := objectMemory bytesPerWord * (performArgCount + 2). "+2 = receiver + saved newMethod"
+ 	argumentCount * objectMemory bytesPerWord to: 0 by: objectMemory bytesPerWord negated do:
- 	delta := self bytesPerWord * (performArgCount + 2). "+2 = receiver + saved newMethod"
- 	argumentCount * self bytesPerWord to: 0 by: self bytesPerWord negated do:
  		[:offset|
  		stackPages
  			longAt: stackPointer + offset + delta
  			put: (stackPages longAt: stackPointer + offset)].
  	self pop: performArgCount + 2.
  	self executeNewMethod.
  	self initPrimCall.  "Recursive xeq affects primErrorCode"
  	^nil!

Item was changed:
  ----- Method: StackInterpreter>>printFrame:WithSP: (in category 'debug printing') -----
  printFrame: theFP WithSP: theSP
  	| theMethod numArgs topThing |
  	<inline: false>
  	<var: #theFP type: #'char *'>
  	<var: #theSP type: #'char *'>
  	<var: #addr type: #'char *'>
  	self cCode: '' inSmalltalk: [self transcript ensureCr].
  	theMethod := self frameMethod: theFP.
  	numArgs := self frameNumArgs: theFP.
  	self shortPrintFrame: theFP.
  	self printFrameOop: 'rcvr/clsr'
+ 		at: theFP + FoxCallerSavedIP + ((numArgs + 1) * objectMemory bytesPerWord).
- 		at: theFP + FoxCallerSavedIP + ((numArgs + 1) * self bytesPerWord).
  	numArgs to: 1 by: -1 do:
+ 		[:i| self printFrameOop: 'arg' at: theFP + FoxCallerSavedIP + (i * objectMemory bytesPerWord)].
- 		[:i| self printFrameOop: 'arg' at: theFP + FoxCallerSavedIP + (i * self bytesPerWord)].
  	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 bytesPerWord to: theSP + objectMemory bytesPerWord by: objectMemory bytesPerWord negated do:
- 			[theFP + FoxReceiver - self bytesPerWord to: theSP + self bytesPerWord by: self bytesPerWord negated do:
  				[:addr|
  				self printFrameOop: 'temp/stck' at: addr].
  			self printFrameThing: 'frame ip' at: theSP]
  		ifFalse:
+ 			[theFP + FoxReceiver - objectMemory bytesPerWord to: theSP by: objectMemory bytesPerWord negated do:
- 			[theFP + FoxReceiver - self bytesPerWord to: theSP by: self bytesPerWord negated do:
  				[:addr|
  				self printFrameOop: 'temp/stck' at: addr]]!

Item was changed:
  ----- Method: StackInterpreter>>printNameOfClass:count: (in category 'debug printing') -----
  printNameOfClass: classOop count: cnt
  	"Details: The count argument is used to avoid a possible infinite recursion if classOop is a corrupted object."
  	<inline: false>
  	(classOop = 0 or: [cnt <= 0]) ifTrue: [^self print: 'bad class'].
  	((objectMemory sizeBitsOf: classOop) = metaclassSizeBytes
+ 	  and: [metaclassSizeBytes > (thisClassIndex * objectMemory bytesPerWord)])	"(Metaclass instSize * 4)"
- 	  and: [metaclassSizeBytes > (thisClassIndex * self bytesPerWord)])	"(Metaclass instSize * 4)"
  		ifTrue: [self printNameOfClass: (objectMemory fetchPointer: thisClassIndex ofObject: classOop) count: cnt - 1.
  				self print: ' class']
  		ifFalse: [self printStringOf: (objectMemory fetchPointer: classNameIndex ofObject: classOop)]!

Item was changed:
  ----- Method: StackInterpreter>>printOop: (in category 'debug printing') -----
  printOop: oop
  	| cls fmt lastIndex startIP bytecodesPerLine |
  	<inline: false>
  	self printHex: oop.
  	(objectMemory isIntegerObject: oop) ifTrue:
  		[^self
  			cCode: 'printf("=%ld\n", integerValueOf(oop))'
  			inSmalltalk: [self print: (self shortPrint: oop); cr]].
  	(oop between: objectMemory startOfMemory and: objectMemory freeStart) ifFalse:
  		[self printHex: oop; print: ' is not on the heap'; cr.
  		 ^nil].
+ 	(oop bitAnd: (objectMemory bytesPerWord - 1)) ~= 0 ifTrue:
- 	(oop bitAnd: (self bytesPerWord - 1)) ~= 0 ifTrue:
  		[self printHex: oop; print: ' is misaligned'; cr.
  		 ^nil].
  	(objectMemory isFreeObject: oop) ifTrue:
  		[self print: ' free chunk of size '; printNum: (objectMemory sizeOfFree: oop); cr.
  		 ^nil].
  	self print: ': a(n) '.
  	self printNameOfClass: (cls := objectMemory fetchClassOfNonInt: oop) count: 5.
  	cls = (objectMemory splObj: ClassFloat) ifTrue:
  		[self cr; printFloat: (self dbgFloatValueOf: oop); cr.
  		 ^nil].
  	fmt := objectMemory formatOf: oop.
  	fmt > 4 ifTrue:
  		[self print: ' nbytes '; printNum: (objectMemory byteSizeOf: oop)].
  	self cr.
  	(fmt > 4 and: [fmt < 12]) ifTrue:
  		["This will answer false if splObj: ClassAlien is nilObject"
  		 (self is: oop KindOfClass: (objectMemory splObj: ClassAlien)) ifTrue:
  			[self print: ' datasize '; printNum: (self sizeOfAlienData: oop).
  			self print: ((self isIndirectAlien: oop)
  							ifTrue: [' indirect @ ']
  							ifFalse:
  								[(self isPointerAlien: oop)
  									ifTrue: [' pointer @ ']
  									ifFalse: [' direct @ ']]).
  			 self printHex: (self startOfAlienData: oop); cr.
  			 ^nil].
  		 (objectMemory isWords: oop) ifTrue:
+ 			[lastIndex := 64 min: ((objectMemory byteSizeOf: oop) / objectMemory bytesPerWord).
- 			[lastIndex := 64 min: ((objectMemory byteSizeOf: oop) / self bytesPerWord).
  			 lastIndex > 0 ifTrue:
  				[1 to: lastIndex do:
  					[:index|
  					self space; printHex: (objectMemory fetchLong32: index - 1 ofObject: oop).
  					(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
  						[self cr]].
  				(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
  					[self cr]].
  			^nil].
  		^self printStringOf: oop; cr].
+ 	lastIndex := 64 min: (startIP := (objectMemory lastPointerOf: oop) / objectMemory bytesPerWord).
- 	lastIndex := 64 min: (startIP := (objectMemory lastPointerOf: oop) / self bytesPerWord).
  	lastIndex > 0 ifTrue:
  		[1 to: lastIndex do:
  			[:index|
  			self cCode: 'printHex(fetchPointerofObject(index - 1, oop)); putchar('' '')'
  				inSmalltalk: [self space; printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space.
  							 self print: (self shortPrint: (objectMemory fetchPointer: index - 1 ofObject: oop))].
  			(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
  				[self cr]].
  		(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
  			[self cr]].
  	(objectMemory isCompiledMethod: oop)
  		ifFalse:
  			[startIP > 64 ifTrue: [self print: '...'; cr]]
  		ifTrue:
+ 			[startIP := startIP * objectMemory bytesPerWord + 1.
- 			[startIP := startIP * self bytesPerWord + 1.
  			 lastIndex := objectMemory lengthOf: oop.
  			 lastIndex - startIP > 100 ifTrue:
  				[lastIndex := startIP + 100].
  			 bytecodesPerLine := 10.
  			 startIP to: lastIndex do:
  				[:index| | byte |
  				byte := objectMemory fetchByte: index - 1 ofObject: oop.
  				self cCode: 'printf(" %02x/%-3d", byte,byte)'
  					inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte].
  				((index - startIP + 1) \\ bytecodesPerLine) = 0 ifTrue:
  					[self cr]].
  			((lastIndex - startIP + 1) \\ bytecodesPerLine) = 0 ifFalse:
  				[self cr]]!

Item was changed:
  ----- Method: StackInterpreter>>printOopShortInner: (in category 'debug printing') -----
  printOopShortInner: oop
  	| classOop name nameLen |
  	<var: #name type: #'char *'>
  	<inline: true>
  	self printChar: $=.
  	(objectMemory isIntegerObject: oop) ifTrue:
  		[self printNum: (objectMemory integerValueOf: oop);
  			printChar: $(;
  			printHex: (objectMemory integerValueOf: oop);
  			printChar: $).
  		 ^nil].
  	(oop between: objectMemory startOfMemory and: objectMemory freeStart) ifFalse:
  		[self printHex: oop; print: ' is not on the heap'.
  		 ^nil].
+ 	(oop bitAnd: (objectMemory bytesPerWord - 1)) ~= 0 ifTrue:
- 	(oop bitAnd: (self bytesPerWord - 1)) ~= 0 ifTrue:
  		[self printHex: oop; print: ' is misaligned'.
  		 ^nil].
  	(self isFloatObject: oop) ifTrue:
  		[self printFloat: (self dbgFloatValueOf: oop).
  		 ^nil].
  	classOop := objectMemory fetchClassOf: oop.
  	(objectMemory sizeBitsOf: classOop) = metaclassSizeBytes ifTrue:
  		[self printNameOfClass: oop count: 5.
  		 ^nil].
  	oop = objectMemory nilObject ifTrue: [self print: 'nil'. ^nil].
  	oop = objectMemory trueObject ifTrue: [self print: 'true'. ^nil].
  	oop = objectMemory falseObject ifTrue: [self print: 'false'. ^nil].
  	nameLen := self lengthOfNameOfClass: classOop.
  	nameLen = 0 ifTrue: [self print: 'a ??'. ^nil].
  	name := self nameOfClass: classOop.
  	nameLen = 10 ifTrue:
  		[(self str: name n: 'ByteString' cmp: 10) not "strncmp is weird" ifTrue:
  			[self printChar: $"; printStringOf: oop; printChar: $".
  			 ^nil].
  		 (self str: name n: 'ByteSymbol' cmp: 10) not "strncmp is weird" ifTrue:
  			[self printChar: $#; printStringOf: oop.
  			 ^nil]].
  	(nameLen = 9 and: [(self str: name n: 'Character' cmp: 9) not]) ifTrue:
  		[self printChar: $$; printChar: (objectMemory integerValueOf: (objectMemory fetchPointer: 0 ofObject: oop)).
  		 ^nil].
  	self cCode: [self prin: 'a(n) %.*s' t: nameLen f: name]
  		inSmalltalk: [self print: 'a(n) '; print: name]!

Item was changed:
  ----- Method: StackInterpreter>>printStringOf: (in category 'debug printing') -----
  printStringOf: oop
  	| fmt cnt i |
  	<inline: false>
  	(objectMemory isIntegerObject: oop) ifTrue:
  		[^nil].
  	(oop between: objectMemory startOfMemory and: objectMemory freeStart) ifFalse:
  		[^nil].
+ 	(oop bitAnd: (objectMemory bytesPerWord - 1)) ~= 0 ifTrue:
- 	(oop bitAnd: (self bytesPerWord - 1)) ~= 0 ifTrue:
  		[^nil].
  	fmt := objectMemory formatOf: oop.
  	fmt < 8 ifTrue: [ ^nil ].
  
  	cnt := 100 min: (objectMemory lengthOf: oop).
  	i := 0.
  
  	((objectMemory is: oop
  		  instanceOf: (objectMemory splObj: ClassByteArray)
  		  compactClassIndex: classByteArrayCompactIndex)
  	or: [(objectMemory is: oop
  			instanceOf: (objectMemory splObj: ClassLargePositiveInteger)
  			compactClassIndex: ClassLargePositiveIntegerCompactIndex)
  	or: [(objectMemory is: oop
  			instanceOf: (objectMemory splObj: ClassLargeNegativeInteger)
  			compactClassIndex: ClassLargeNegativeIntegerCompactIndex)]])
  		ifTrue:
  			[[i < cnt] whileTrue: [
  				self printHex: (objectMemory fetchByte: i ofObject: oop).
  				i := i + 1]]
  		ifFalse:
  			[[i < cnt] whileTrue: [
  				self printChar: (objectMemory fetchByte: i ofObject: oop).
  				i := i + 1]].
  	self flush!

Item was changed:
  ----- Method: StackInterpreter>>push: (in category 'internal interpreter access') -----
  push: object
  	"In the StackInterpreter stacks grow down."
  	| sp |
  	<inline: true>
  	<var: #sp type: #'char *'>
+ 	stackPages longAt: (sp := stackPointer - objectMemory bytesPerWord) put: object.
- 	stackPages longAt: (sp := stackPointer - self bytesPerWord) put: object.
  	stackPointer := sp!

Item was changed:
  ----- Method: StackInterpreter>>pushClosureCopyCopiedValuesBytecode (in category 'stack bytecodes') -----
  pushClosureCopyCopiedValuesBytecode
  	"The compiler has pushed the values to be copied, if any.  Find numArgs and numCopied in the byte following.
  	 Create a Closure with space for the copiedValues and pop numCopied values off the stack into the closure.
  	 Set numArgs as specified, and set startpc to the pc following the block size and jump over that code."
  	| newClosure numArgsNumCopied numArgs numCopied blockSize context |
  	numArgsNumCopied := self fetchByte.
  	numArgs := numArgsNumCopied bitAnd: 16rF.
  	numCopied := numArgsNumCopied bitShift: -4.
  	"Split blockSize := (self fetchByte * 256) + self fetchByte. into two because evaluation order in C is undefined."
  	blockSize := self fetchByte << 8.
  	blockSize := blockSize + self fetchByte.
  	"No need to record the pushed copied values in the outerContext."
+ 	context := self ensureFrameIsMarried: localFP SP: localSP + (numCopied * objectMemory bytesPerWord).
- 	context := self ensureFrameIsMarried: localFP SP: localSP + (numCopied * self bytesPerWord).
  	newClosure := self
  					closureIn: context
  					numArgs: numArgs
+ 					instructionPointer: (self oopForPointer: localIP) + 2 - (method+objectMemory baseHeaderSize)
- 					instructionPointer: (self oopForPointer: localIP) + 2 - (method+self baseHeaderSize)
  					numCopiedValues: numCopied.
  	numCopied > 0 ifTrue:
  		[0 to: numCopied - 1 do:
  			[:i|
  			"Assume: have just allocated a new BlockClosure; it must be young.
  			 Thus, can use unchecked stores."
  			 objectMemory storePointerUnchecked: i + ClosureFirstCopiedValueIndex
  				ofObject: newClosure
  				withValue: (self internalStackValue: numCopied - i - 1)].
  		 self internalPop: numCopied].
  	localIP := localIP + blockSize.
  	self fetchNextBytecode.
  	self internalPush: newClosure!

Item was changed:
  ----- Method: StackInterpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') -----
  readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset
  	"Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory."
  	"Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command."
  	"This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!"
  
  	| swapBytes headerStart headerSize dataSize oldBaseAddr hdrNumStackPages
  	  minimumMemory memStart bytesRead bytesToShift heapSize hdrEdenBytes
  	  headerFlags hdrMaxExtSemTabSize |
  	<var: #f type: 'sqImageFile '>
  	<var: #memStart type: 'usqInt'>
  	<var: #desiredHeapSize type: 'usqInt'>
  	<var: #headerStart type: 'squeakFileOffsetType '>
  	<var: #dataSize type: 'size_t '>
  	<var: #imageOffset type: 'squeakFileOffsetType '>
  
+ 	metaclassSizeBytes := 6 * objectMemory bytesPerWord.	"guess (Metaclass instSize * BPW)"
- 	metaclassSizeBytes := 6 * self bytesPerWord.	"guess (Metaclass instSize * BPW)"
  	swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
+ 	headerStart := (self sqImageFilePosition: f) - objectMemory bytesPerWord.  "record header start position"
- 	headerStart := (self sqImageFilePosition: f) - self bytesPerWord.  "record header start position"
  
  	headerSize			:= self getLongFromFile: f swap: swapBytes.
  	dataSize			:= self getLongFromFile: f swap: swapBytes.
  	oldBaseAddr		:= self getLongFromFile: f swap: swapBytes.
  	objectMemory setSpecialObjectsOop: (self getLongFromFile: f swap: swapBytes).
  	objectMemory setLastHash: (self getLongFromFile: f swap: swapBytes). "N.B.  not used."
  	savedWindowSize	:= self getLongFromFile: f swap: swapBytes.
  	headerFlags			:= self getLongFromFile: f swap: swapBytes.
  	self setImageHeaderFlagsFrom: headerFlags.
  	extraVMMemory		:= self getLongFromFile: f swap: swapBytes.
  	hdrNumStackPages	:= self getShortFromFile: f swap: swapBytes.
  	"4 stack pages is small.  Should be able to run with as few as
  	 three. 4 should be comfortable but slow.  8 is a reasonable
  	 default.  Can be changed via vmParameterAt: 43 put: n.
  	 Can be set as a preference (Info.plist, VM.ini, command line etc).
  	 If desiredNumStackPages is already non-zero then it has been
  	 set as a preference.  Ignore (but preserve) the header's default."
  	numStackPages := desiredNumStackPages ~= 0
  						ifTrue: [desiredNumStackPages]
  						ifFalse: [hdrNumStackPages = 0
  									ifTrue: [self defaultNumStackPages]
  									ifFalse: [hdrNumStackPages]].
  	desiredNumStackPages := hdrNumStackPages.
  	"pad to word boundary.  This slot can be used for anything else that will fit in 16 bits.
  	 Preserve it to be polite to images run on Cog."
  	theUnknownShort	:= self getShortFromFile: f swap: swapBytes.
  	hdrEdenBytes		:= self getLongFromFile: f swap: swapBytes.
  	objectMemory setEdenBytes: (desiredEdenBytes ~= 0
  						ifTrue: [desiredEdenBytes]
  						ifFalse:
  							[hdrEdenBytes = 0
  									ifTrue: [objectMemory defaultEdenBytes]
  									ifFalse: [hdrEdenBytes]]).
  	desiredEdenBytes := hdrEdenBytes.
  	hdrMaxExtSemTabSize := self getShortFromFile: f swap: swapBytes.
  	hdrMaxExtSemTabSize ~= 0 ifTrue:
  		[self setMaxExtSemSizeTo: hdrMaxExtSemTabSize].
  	"decrease Squeak object heap to leave extra memory for the VM"
  	heapSize := self cCode: 'reserveExtraCHeapBytes(desiredHeapSize, extraVMMemory)'.
  
  	"compare memory requirements with availability".
  	minimumMemory := dataSize + objectMemory edenBytes + self interpreterAllocationReserveBytes.
  	heapSize < minimumMemory ifTrue:
  		[self insufficientMemorySpecifiedError].
  
  	"allocate a contiguous block of memory for the Squeak heap"
  	objectMemory setMemory: (self cCode: 'sqAllocateMemory(minimumMemory, heapSize)').
  	objectMemory getMemory = nil ifTrue: [self insufficientMemoryAvailableError].
  
  	memStart := objectMemory startOfMemory.
  	objectMemory setMemoryLimit: (memStart + heapSize) - 24.  "decrease memoryLimit a tad for safety"
  	objectMemory setEndOfMemory: memStart + dataSize.
  
  	"position file after the header"
  	self sqImageFile: f Seek: headerStart + headerSize.
  
  	"read in the image in bulk, then swap the bytes if necessary"
  	bytesRead := self cCode: 'sqImageFileRead(pointerForOop(memory), sizeof(unsigned char), dataSize, f)'.
  	bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
  
  	self ensureImageFormatIsUpToDate: swapBytes.
  
  	"compute difference between old and new memory base addresses"
  	bytesToShift := memStart - oldBaseAddr.
  	self initializeInterpreter: bytesToShift.  "adjusts all oops to new location"
  	^dataSize
  !

Item was changed:
  ----- Method: StackInterpreter>>reestablishContextPriorToCallback: (in category 'callback support') -----
  reestablishContextPriorToCallback: callbackContext
  	"callbackContext is an activation of invokeCallback:[stack:registers:jmpbuf:].
  	 Its sender is the VM's state prior to the callback.  Reestablish that state,
  	 and mark calloutContext as dead."
  	| calloutContext theFP thePage |
  	<export: true>
  	<var: #theFP type: #'char *'>
  	<var: #thePage type: #'StackPage *'>
  	self flag: #obsolete.
  	(self isLiveContext: callbackContext) ifFalse:
  		[^false].
  	calloutContext := self externalInstVar: SenderIndex ofContext: callbackContext.
  	(self isLiveContext: calloutContext) ifFalse:
  		[^false].
  	"Mark callbackContext as dead; the common case is that it is the current frame.
  	 We go the extra mile for the debugger."
  	(self isSingleContext: callbackContext)
  		ifTrue: [self markContextAsDead: callbackContext]
  		ifFalse:
  			[theFP := self frameOfMarriedContext: callbackContext.
  			 framePointer = theFP "common case"
  				ifTrue:
  					[(self isBaseFrame: theFP)
  						ifTrue: [stackPages freeStackPage: stackPage]
  						ifFalse: "calloutContext is immediately below on the same page.  Make it current."
  							[instructionPointer := (self frameCallerSavedIP: framePointer) asUnsignedInteger.
+ 							 stackPointer := framePointer + (self frameStackedReceiverOffset: framePointer) + objectMemory bytesPerWord.
- 							 stackPointer := framePointer + (self frameStackedReceiverOffset: framePointer) + self bytesPerWord.
  							 framePointer := self frameCallerFP: framePointer.
  							 ^true]]
  				ifFalse:
  					[self externalDivorceFrame: theFP andContext: callbackContext.
  					 self markContextAsDead: callbackContext]].
  	"Make the calloutContext the active frame.  The case where calloutContext
  	 is immediately below callbackContext on the same page is handled above."
  	(self isStillMarriedContext: calloutContext)
  		ifTrue:
  			[theFP := self frameOfMarriedContext: calloutContext.
  			 thePage := stackPages stackPageFor: theFP.
  			 "findSPOf:on: points to the word beneath the instructionPointer, but
  			  there is no instructionPointer on the top frame of the current page."
  			 self assert: thePage ~= stackPage.
+ 			 stackPointer := (self findSPOf: theFP on: thePage) - objectMemory bytesPerWord.
- 			 stackPointer := (self findSPOf: theFP on: thePage) - self bytesPerWord.
  			 framePointer := theFP]
  		ifFalse:
  			[thePage := self makeBaseFrameFor: calloutContext.
  			 framePointer := thePage headFP.
  			 stackPointer := thePage headSP].
  	instructionPointer := self popStack.
  	self setStackPageAndLimit: thePage.
  	^true!

Item was changed:
  ----- Method: StackInterpreter>>returnAs:ThroughCallback:Context: (in category 'callback support') -----
  returnAs: returnTypeOop ThroughCallback: vmCallbackContext Context: callbackMethodContext
  	"callbackMethodContext is an activation of invokeCallback:[stack:registers:jmpbuf:].
  	 Its sender is the VM's state prior to the callback.  Reestablish that state (via longjmp),
  	 and mark callbackMethodContext as dead."
  	<export: true>
  	<var: #vmCallbackContext type: #'VMCallbackContext *'>
  	| calloutMethodContext theFP thePage |
  	<var: #theFP type: #'char *'>
  	<var: #thePage type: #'StackPage *'>
  	((self isIntegerObject: returnTypeOop)
  	 and: [self isLiveContext: callbackMethodContext]) ifFalse:
  		[^false].
  	calloutMethodContext := self externalInstVar: SenderIndex ofContext: callbackMethodContext.
  	(self isLiveContext: calloutMethodContext) ifFalse:
  		[^false].
  	"Mark callbackMethodContext as dead; the common case is that it is the current frame.
  	 We go the extra mile for the debugger."
  	(self isSingleContext: callbackMethodContext)
  		ifTrue: [self markContextAsDead: callbackMethodContext]
  		ifFalse:
  			[theFP := self frameOfMarriedContext: callbackMethodContext.
  			 framePointer = theFP "common case"
  				ifTrue:
  					[(self isBaseFrame: theFP)
  						ifTrue: [stackPages freeStackPage: stackPage]
  						ifFalse: "calloutMethodContext is immediately below on the same page.  Make it current."
  							[instructionPointer := (self frameCallerSavedIP: framePointer) asUnsignedInteger.
+ 							 stackPointer := framePointer + (self frameStackedReceiverOffset: framePointer) + objectMemory bytesPerWord.
- 							 stackPointer := framePointer + (self frameStackedReceiverOffset: framePointer) + self bytesPerWord.
  							 framePointer := self frameCallerFP: framePointer.
  							 self restoreCStackStateForCallbackContext: vmCallbackContext.
  							 "N.B. siglongjmp is defines as _longjmp on non-win32 platforms.
  							  This matches the use of _setjmp in ia32abicc.c."
  							 self siglong: vmCallbackContext trampoline jmp: (self integerValueOf: returnTypeOop).
  							 ^true]]
  				ifFalse:
  					[self externalDivorceFrame: theFP andContext: callbackMethodContext.
  					 self markContextAsDead: callbackMethodContext]].
  	"Make the calloutMethodContext the active frame.  The case where calloutMethodContext
  	 is immediately below callbackMethodContext on the same page is handled above."
  	(self isStillMarriedContext: calloutMethodContext)
  		ifTrue:
  			[theFP := self frameOfMarriedContext: calloutMethodContext.
  			 thePage := stackPages stackPageFor: theFP.
  			 "findSPOf:on: points to the word beneath the instructionPointer, but
  			  there is no instructionPointer on the top frame of the current page."
  			 self assert: thePage ~= stackPage.
+ 			 stackPointer := (self findSPOf: theFP on: thePage) - objectMemory bytesPerWord.
- 			 stackPointer := (self findSPOf: theFP on: thePage) - self bytesPerWord.
  			 framePointer := theFP]
  		ifFalse:
  			[thePage := self makeBaseFrameFor: calloutMethodContext.
  			 framePointer := thePage headFP.
  			 stackPointer := thePage headSP].
  	instructionPointer := self popStack.
  	self setStackPageAndLimit: thePage.
  	self restoreCStackStateForCallbackContext: vmCallbackContext.
  	 "N.B. siglongjmp is defines as _longjmp on non-win32 platforms.
  	  This matches the use of _setjmp in ia32abicc.c."
  	self siglong: vmCallbackContext trampoline jmp: (self integerValueOf: returnTypeOop).
  	"NOTREACHED"
  	^true!

Item was changed:
  ----- Method: StackInterpreter>>reverseDisplayFrom:to: (in category 'I/O primitive support') -----
  reverseDisplayFrom: startIndex to: endIndex 
  	"Reverse the given range of Display words (at different bit 
  	depths, this will reverse different numbers of pixels). Used to 
  	give feedback during VM activities such as garbage 
  	collection when debugging. It is assumed that the given 
  	word range falls entirely within the first line of the Display."
  	| displayObj displayBits w wordStartIndex wordEndIndex primFailCodeValue |
  	displayObj := objectMemory splObj: TheDisplay.
  	((objectMemory isPointers: displayObj) and: [(objectMemory lengthOf: displayObj) >= 4]) ifFalse: [^ nil].
  	w := objectMemory fetchPointer: 1 ofObject: displayObj.
  	displayBits := objectMemory fetchPointer: 0 ofObject: displayObj.
  	((objectMemory isIntegerObject: displayBits)
  	or: [(objectMemory isNonIntegerObject: w)
  	or: [objectMemory isPointersNonInt: displayBits]]) ifTrue: [^ nil].
  	wordStartIndex := startIndex * 4.
  	wordEndIndex := endIndex * 4 min: (objectMemory sizeBitsOf: displayBits).
+ 	displayBits := displayBits + objectMemory baseHeaderSize.
- 	displayBits := displayBits + self baseHeaderSize.
  	displayBits + wordStartIndex to: displayBits + wordEndIndex by: 4 do:
  		[:ptr | | reversed  |
  		reversed := (objectMemory long32At: ptr) bitXor: 16rFFFFFFFF.
  		objectMemory longAt: ptr put: reversed].
  	primFailCodeValue := primFailCode.
  	self initPrimCall.
  	self displayBitsOf: displayObj Left: 0 Top: 0 Right: (objectMemory integerValueOf: w) Bottom: 1.
  	self ioForceDisplayUpdate.
  	primFailCode := primFailCodeValue!

Item was changed:
  ----- Method: StackInterpreter>>roomToPushNArgs: (in category 'primitive support') -----
  roomToPushNArgs: n
  	"Answer if there is room to push n arguments onto the current stack.
  	 There may be room in this stackPage but there may not be room if
  	 the frame were converted into a context."
  	| cntxSize |
  	self assert: method = (stackPages longAt: framePointer + FoxMethod).
  	cntxSize := ((self headerOf: method) bitAnd: LargeContextBit) ~= 0
+ 					ifTrue: [LargeContextSize / objectMemory bytesPerWord - ReceiverIndex]
+ 					ifFalse: [SmallContextSize / objectMemory bytesPerWord - ReceiverIndex].
- 					ifTrue: [LargeContextSize / self bytesPerWord - ReceiverIndex]
- 					ifFalse: [SmallContextSize / self bytesPerWord - ReceiverIndex].
  	^self stackPointerIndex + n <= cntxSize!

Item was changed:
  ----- Method: StackInterpreter>>sendInvokeCallbackContext: (in category 'callback support') -----
  sendInvokeCallbackContext: vmCallbackContext
  	"Send the calllback message to Alien class with the supplied arg(s).  Use either the
  	 1 arg invokeCallbackContext: or the 4 arg invokeCallback:stack:registers:jmpbuf:
  	 message, depending on what selector is installed in the specialObjectsArray.
  	 Note that if invoking the legacy invokeCallback:stack:registers:jmpbuf: we pass the
  	 vmCallbackContext as the jmpbuf argument (see reestablishContextPriorToCallback:).
  	 The arguments are raw C addresses and are converted to integer objects on the way."
  	<export: true>
  	<var: #vmCallbackContext type: #'VMCallbackContext *'>
  	lkupClass := self fetchClassOfNonInt: (self splObj: ClassAlien).
  	messageSelector := self splObj: SelectorInvokeCallback.
  	(self lookupInMethodCacheSel: messageSelector class: lkupClass) ifFalse:
  	 	[(self lookupMethodNoMNUEtcInClass: lkupClass) ~= 0 ifTrue:
  			[^false]].
  	primitiveFunctionPointer ~= 0 ifTrue:
  		[^false].
  	self saveCStackStateForCallbackContext: vmCallbackContext.
  	self push: (self splObj: ClassAlien). "receiver"
+ 	self cppIf: [objectMemory bytesPerWord = 8]
- 	self cppIf: [self bytesPerWord = 8]
  		ifTrue:
  			[(self argumentCountOf: newMethod) = 4 ifTrue:
  				[self push: (self positive64BitIntegerFor: vmCallbackContext thunkp asUnsignedInteger).
  				 self push: (self positive64BitIntegerFor: vmCallbackContext stackp asUnsignedInteger).
  				 self push: (self positive64BitIntegerFor: vmCallbackContext intregargsp asUnsignedInteger)].
  			 self push: (self positive64BitIntegerFor: vmCallbackContext asUnsignedInteger)]
  		ifFalse:
  			[(self argumentCountOf: newMethod) = 4 ifTrue:
  				[self push: (self positive32BitIntegerFor: vmCallbackContext thunkp asUnsignedInteger).
  				 self push: (self positive32BitIntegerFor: vmCallbackContext stackp asUnsignedInteger).
  				 self push: (self positive32BitIntegerFor: vmCallbackContext intregargsp asUnsignedInteger)].
  			 self push: (self positive32BitIntegerFor: vmCallbackContext asUnsignedInteger)].
  	self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector.
  	self justActivateNewMethod.
  	(self isMachineCodeFrame: framePointer) ifFalse:
  		[self maybeFlagMethodAsInterpreted: newMethod].
  	self externalWriteBackHeadFramePointers.
  	self handleStackOverflow.
  	self enterSmalltalkExecutiveFromCallback.
  	"not reached"
  	^true!

Item was changed:
  ----- Method: StackInterpreter>>sizeOfSTArrayFromCPrimitive: (in category 'utilities') -----
  sizeOfSTArrayFromCPrimitive: cPtr
  	"Return the number of indexable fields of the given object. This method is to be called from an automatically generated C primitive. The argument is assumed to be a pointer to the first indexable field of a words or bytes object; the object header starts 4 bytes before that."
  	"Note: Only called by translated primitive code."
  
  	| oop |
  	<var: #cPtr type: 'void *'>
+ 	oop := (self oopForPointer: cPtr) - objectMemory baseHeaderSize.
- 	oop := (self oopForPointer: cPtr) - self baseHeaderSize.
  	(objectMemory isWordsOrBytes: oop) ifFalse: [
  		self primitiveFail.
  		^0].
  	^objectMemory lengthOf: oop
  !

Item was changed:
  ----- Method: StackInterpreter>>slowPrimitiveResponse (in category 'primitive support') -----
  slowPrimitiveResponse
  	"Called under the assumption that primFunctionPtr has been preloaded"
  	| nArgs savedFramePointer savedStackPointer |
  	<inline: true>
  	<asmLabel: false>
  	<var: #savedFramePointer type: #'char *'>
  	<var: #savedStackPointer type: #'char *'>
  	FailImbalancedPrimitives ifTrue:
  		[nArgs := argumentCount.
  		 savedStackPointer := stackPointer.
  		 savedFramePointer := framePointer].
  	self initPrimCall.
  	self dispatchFunctionPointer: primitiveFunctionPointer.
  	(FailImbalancedPrimitives
  	and: [self successful
  	and: [framePointer = savedFramePointer]]) ifTrue:"Don't fail if primitive has done something radical, e.g. perform:"
+ 		[stackPointer ~= (savedStackPointer + (nArgs * objectMemory bytesPerWord)) ifTrue:
- 		[stackPointer ~= (savedStackPointer + (nArgs * self bytesPerWord)) ifTrue:
  			[self flag: 'Would be nice to make this a message send of e.g. unbalancedPrimitive to the current process or context'.
  			 "This is necessary but insufficient; the result may still have been written to the stack.
  			   At least we'll know something is wrong."
  			 stackPointer := savedStackPointer.
  			 self failUnbalancedPrimitive]].
  	"If we are profiling, take accurate primitive measures"
  	nextProfileTick > 0 ifTrue:
  		[self checkProfileTick: newMethod].
  	^self successful!

Item was changed:
  ----- Method: StackInterpreter>>snapshotCleanUp (in category 'image save/restore') -----
  snapshotCleanUp
  	"Clean up right before saving an image, sweeping memory and:
  	* nilling out all fields of contexts above the stack pointer. 
  	* flushing external primitives 
  	* clearing the root bit of any object in the root table
  	* bereaving widowed contexts.
  	 By ensuring that all contexts are single in a snapshot (i.e. that no married contexts
  	 exist) we can maintain the invariant that a married or widowed context's frame
  	 reference (in its sender field) must point into the stack pages since no married or
  	 widowed contexts are present from older runs of the system."
  	| oop header fmt sz |
  	oop := objectMemory firstObject.
  	[self oop: oop isLessThan: objectMemory freeStart] whileTrue:
  		[(objectMemory isFreeObject: oop) ifFalse:
  			[header := self longAt: oop.
  			 fmt := objectMemory formatOfHeader: header.
  			 "Clean out context"
  			 (fmt = 3 and: [self isContextHeader: header]) ifTrue:
  				["All contexts have been divorced. Bereave remaining widows."
  				 (self isMarriedOrWidowedContext: oop) ifTrue:
  					[self markContextAsDead: oop].
  				 sz := objectMemory sizeBitsOf: oop.
+ 				 (objectMemory lastPointerOf: oop) + objectMemory bytesPerWord
+ 				 to: sz - objectMemory baseHeaderSize by: objectMemory bytesPerWord
- 				 (objectMemory lastPointerOf: oop) + self bytesPerWord
- 				 to: sz - self baseHeaderSize by: self bytesPerWord
  				 do: [:i | self longAt: oop + i put: objectMemory nilObject]].
  			 "Clean out external functions"
  			 fmt >= 12 ifTrue:
  				["This is a compiled method"
  				 (self primitiveIndexOf: oop) = PrimitiveExternalCallIndex ifTrue:
  					["Its primitiveExternalCall"
  					 self flushExternalPrimitiveOf: oop]]].
  			oop := objectMemory objectAfter: oop].
  	objectMemory clearRootsTable!

Item was changed:
  ----- Method: StackInterpreter>>stackFloatValue: (in category 'internal interpreter access') -----
  stackFloatValue: offset
  	"In the StackInterpreter stacks grow down."
  	| result floatPointer |
  	<returnTypeC: #double>
  	<var: #result type: #double>
+ 	floatPointer := stackPages longAt: stackPointer + (offset * objectMemory bytesPerWord).
- 	floatPointer := stackPages longAt: stackPointer + (offset * self bytesPerWord).
  
  	"N.B.  Because Slang always inlines assertClassOf:is:compactClassIndex:
  	 (because assertClassOf:is:compactClassIndex: has an inline: pragma) the
  	 phrase (self splObj: ClassArray) is expanded in-place and is _not_
  	 evaluated if ClassArrayCompactIndex is non-zero."
  	self assertClassOf: floatPointer
  		is: (objectMemory splObj: ClassFloat)
  		compactClassIndex: ClassFloatCompactIndex.
  	self successful ifTrue:
  		[self cCode: '' inSmalltalk: [result := Float new: 2].
+ 		objectMemory fetchFloatAt: floatPointer + objectMemory baseHeaderSize into: result.
- 		objectMemory fetchFloatAt: floatPointer + self baseHeaderSize into: result.
  		^result].
  	^0.0!

Item was changed:
  ----- Method: StackInterpreter>>stackLimitOffset (in category 'stack pages') -----
  stackLimitOffset
  	"Answer the amount of slots needed to fit a new frame at the point the stack
  	 limit is checked.  A frame looks like this at the point the stack limit is checked:
  			stacked receiver/closure
  			arg0
  			...
  			argN
  			caller's method ip/base frame's sender context
  	fp->	saved fp
  			method
  			method header fields
  			context (uninitialized)
  			receiver
  			first temp
  			...
  	sp->	Nth temp
  	So the amount of headroom is
  		the maximum number of arguments + 1 (for stacked receiver and arguments)
  		+ the frame size
  		+ the max number of temps.
  	 Since a method's number of temps includes its arguments the actual offset is:"
+ 	^(FrameSlots + 64) * objectMemory bytesPerWord!
- 	^(FrameSlots + 64) * self bytesPerWord!

Item was changed:
  ----- Method: StackInterpreter>>stackPositiveMachineIntegerValue: (in category 'internal interpreter access') -----
  stackPositiveMachineIntegerValue: offset
  	<api>
  	"In the StackInterpreter stacks grow down."
  	| integerPointer |
+ 	integerPointer := stackPages longAt: stackPointer + (offset * objectMemory bytesPerWord).
- 	integerPointer := stackPages longAt: stackPointer + (offset * self bytesPerWord).
  	^self positiveMachineIntegerValueOf: integerPointer!

Item was changed:
  ----- Method: StackInterpreter>>stackSignedMachineIntegerValue: (in category 'internal interpreter access') -----
  stackSignedMachineIntegerValue: offset
  	<api>
  	"In the StackInterpreter stacks grow down."
  	| integerPointer |
+ 	integerPointer := stackPages longAt: stackPointer + (offset * objectMemory bytesPerWord).
- 	integerPointer := stackPages longAt: stackPointer + (offset * self bytesPerWord).
  	^self signedMachineIntegerValueOf: integerPointer!

Item was changed:
  ----- Method: StackInterpreter>>stackValue: (in category 'internal interpreter access') -----
  stackValue: offset
  	<api>
  	"In the StackInterpreter stacks grow down."
+ 	^stackPages longAt: stackPointer + (offset * objectMemory bytesPerWord)!
- 	^stackPages longAt: stackPointer + (offset * self bytesPerWord)!

Item was changed:
  ----- Method: StackInterpreter>>stackValue:put: (in category 'internal interpreter access') -----
  stackValue: offset put: oop
  	"In the StackInterpreter stacks grow down."
  	^stackPages
+ 		longAt: stackPointer + (offset * objectMemory bytesPerWord)
- 		longAt: stackPointer + (offset * self bytesPerWord)
  		put: oop!

Item was changed:
  ----- Method: StackInterpreter>>sufficientSpaceToInstantiate:indexableSize: (in category 'object access primitives') -----
  sufficientSpaceToInstantiate: classOop indexableSize: size 
  	"Return the number of bytes required to allocate an instance of the given class with the given number of indexable fields."
  	"Details: For speed, over-estimate space needed for fixed fields or literals; the low space threshold is a blurry line."
  	| format atomSize|
  	<inline: true>
  	format := self instSpecOfClass: classOop.
  
  	"fail if attempting to call new: on non-indexable class"
  	((self cCoerce: size to: 'usqInt ') > 0 and: [format < 2])
  		ifTrue: [^ false].
  
  	format < 8
+ 		ifTrue: ["indexable fields are words or pointers" atomSize := objectMemory bytesPerWord]
- 		ifTrue: ["indexable fields are words or pointers" atomSize := self bytesPerWord]
  		ifFalse: ["indexable fields are bytes" atomSize := 1].
  	^objectMemory sufficientSpaceToAllocate: 2500 + (size * atomSize)!

Item was changed:
  ----- Method: StackInterpreter>>temporary:in: (in category 'internal interpreter access') -----
  temporary: offset in: theFP
  	"See StackInterpreter class>>initializeFrameIndices"
  	| frameNumArgs |
  	<inline: true>
  	<var: #theFP type: #'char *'>
  	^offset < (frameNumArgs := self frameNumArgs: theFP)
+ 		ifTrue: [stackPages longAt: theFP + FoxCallerSavedIP + ((frameNumArgs - offset) * objectMemory bytesPerWord)]
- 		ifTrue: [stackPages longAt: theFP + FoxCallerSavedIP + ((frameNumArgs - offset) * self bytesPerWord)]
  		ifFalse: [stackPages longAt: theFP + FoxReceiver - self bytesPerWord + ((frameNumArgs - offset) * self bytesPerWord)]!

Item was changed:
  ----- Method: StackInterpreter>>temporary:in:put: (in category 'internal interpreter access') -----
  temporary: offset in: theFP put: valueOop
  	"See StackInterpreter class>>initializeFrameIndices"
  	| frameNumArgs |
  	<inline: true>
  	<var: #theFP type: #'char *'>
  	offset < (frameNumArgs := self frameNumArgs: theFP)
+ 		ifTrue: [stackPages longAt: theFP + FoxCallerSavedIP + ((frameNumArgs - offset) * objectMemory bytesPerWord) put: valueOop]
- 		ifTrue: [stackPages longAt: theFP + FoxCallerSavedIP + ((frameNumArgs - offset) * self bytesPerWord) put: valueOop]
  		ifFalse: [stackPages longAt: theFP + FoxReceiver - self bytesPerWord + ((frameNumArgs - offset) * self bytesPerWord) put: valueOop]!

Item was changed:
  ----- Method: StackInterpreter>>temporaryLocation:in:numArgs: (in category 'internal interpreter access') -----
  temporaryLocation: offset in: theFP numArgs: numArgs
  	"Answer the pointer to a given temporary (for debug frame printing in odd circumstances)"
  	<var: #theFP type: #'char *'>
  	<returnTypeC: #'char *'>
  	<asmLabel: false>
  	^offset < numArgs
+ 		ifTrue: [theFP + FoxCallerSavedIP + ((numArgs - offset) * objectMemory bytesPerWord)]
- 		ifTrue: [theFP + FoxCallerSavedIP + ((numArgs - offset) * self bytesPerWord)]
  		ifFalse: [theFP + FoxReceiver - self bytesPerWord + ((numArgs - offset) * self bytesPerWord)]!

Item was changed:
  ----- Method: StackInterpreter>>unPop: (in category 'internal interpreter access') -----
  unPop: nItems
  	"In the StackInterpreter stacks grow down."
+ 	stackPointer := stackPointer - (nItems * objectMemory bytesPerWord)!
- 	stackPointer := stackPointer - (nItems * self bytesPerWord)!

Item was changed:
  ----- Method: StackInterpreter>>updateObjectsPostByteSwapFrom:to: (in category 'image save/restore') -----
  updateObjectsPostByteSwapFrom: startOop to: stopAddr 
  	"Byte-swap the words of all bytes objects in a range of the 
  	 image, including Strings, ByteArrays, and CompiledMethods.
  	 This returns these objects to their original byte ordering 
  	 after blindly byte-swapping the entire image. For compiled 
  	 methods, byte-swap only their bytecodes part.
  	 Ensure floats are in platform-order."
  	| oop fmt wordAddr methodHeader swapFloatWords temp |
  	swapFloatWords := objectMemory vmEndianness ~= imageFloatsBigEndian.
  	self assert: ClassFloatCompactIndex ~= 0.
  	oop := startOop.
  	[self oop: oop isLessThan: stopAddr] whileTrue:
  		[(objectMemory isFreeObject: oop) ifFalse:
  			[fmt := objectMemory formatOf: oop.
  			 fmt >= 8 ifTrue: "oop contains bytes"
+ 				[wordAddr := oop + objectMemory baseHeaderSize.
- 				[wordAddr := oop + self baseHeaderSize.
  				fmt >= 12 ifTrue: "compiled method; start after methodHeader and literals"
+ 					[methodHeader := self longAt: oop + objectMemory baseHeaderSize.
+ 					 wordAddr := wordAddr + objectMemory bytesPerWord + ((methodHeader >> 10 bitAnd: 255) * objectMemory bytesPerWord)].
- 					[methodHeader := self longAt: oop + self baseHeaderSize.
- 					 wordAddr := wordAddr + self bytesPerWord + ((methodHeader >> 10 bitAnd: 255) * self bytesPerWord)].
  				objectMemory reverseBytesFrom: wordAddr to: oop + (objectMemory sizeBitsOf: oop)].
  			 fmt = 6 ifTrue: "Bitmap, Float etc"
  				[(swapFloatWords
  				  and: [(objectMemory compactClassIndexOf: oop) = ClassFloatCompactIndex])
  					ifTrue:
+ 						[temp := self longAt: oop + objectMemory baseHeaderSize.
+ 						 self longAt: oop + objectMemory baseHeaderSize put: (self longAt: oop + objectMemory baseHeaderSize + 4).
+ 						 self longAt: oop + objectMemory baseHeaderSize + 4 put: temp]
- 						[temp := self longAt: oop + self baseHeaderSize.
- 						 self longAt: oop + self baseHeaderSize put: (self longAt: oop + self baseHeaderSize + 4).
- 						 self longAt: oop + self baseHeaderSize + 4 put: temp]
  					ifFalse:
+ 						[objectMemory bytesPerWord = 8 ifTrue: "Object contains 32-bit half-words packed into 64-bit machine words."
+ 							[wordAddr := oop + objectMemory baseHeaderSize.
- 						[self bytesPerWord = 8 ifTrue: "Object contains 32-bit half-words packed into 64-bit machine words."
- 							[wordAddr := oop + self baseHeaderSize.
  							 objectMemory reverseWordsFrom: wordAddr to: oop + (objectMemory sizeBitsOf: oop)]]]].
  			oop := objectMemory objectAfter: oop]!

Item was changed:
  ----- Method: StackInterpreter>>updateStateOfSpouseContextForFrame:WithSP: (in category 'frame access') -----
  updateStateOfSpouseContextForFrame: theFP WithSP: theSP
  	"Update the frame's spouse context with the frame's current state except for the
  	 sender and instruction pointer, which are used to mark the context as married."
  	| theContext tempIndex pointer |
  	<inline: false>
  	<var: #theFP type: #'char *'>
  	<var: #theSP type: #'char *'>
  	<var: #pointer type: #'char *'>
  	self assert: (self frameHasContext: theFP).
  	theContext := self frameContext: theFP.
  	self assert: (self frameReceiver: theFP)
  				= (objectMemory fetchPointer: ReceiverIndex ofObject: theContext).
  	tempIndex := self frameNumArgs: theFP.
+ 	pointer := theFP + FoxReceiver - objectMemory bytesPerWord.
- 	pointer := theFP + FoxReceiver - self bytesPerWord.
  	[pointer >= theSP] whileTrue:
  		[self assert: (objectMemory addressCouldBeOop: (stackPages longAt: pointer)).
  		 tempIndex := tempIndex + 1.
  		 objectMemory storePointer: ReceiverIndex + tempIndex
  			ofObject: theContext
  			withValue: (stackPages longAt: pointer).
+ 		 pointer := pointer - objectMemory bytesPerWord].
- 		 pointer := pointer - self bytesPerWord].
  	self assert: ReceiverIndex + tempIndex < (objectMemory lengthOf: theContext).
  	objectMemory storePointerUnchecked: StackPointerIndex
  		ofObject: theContext
  		withValue: (objectMemory integerObjectOf: tempIndex)!

Item was changed:
  ----- Method: StackInterpreter>>validInstructionPointer:inMethod:framePointer: (in category 'debug support') -----
  validInstructionPointer: instrPointer inMethod: aMethod framePointer: fp
  	<var: #instrPointer type: #usqInt>
  	<var: #aMethod type: #usqInt>
  	^instrPointer >= (aMethod + (objectMemory lastPointerOf: aMethod) + self bytesPerWord - 1)
+ 	  and: [instrPointer < (aMethod + (objectMemory byteLengthOf: aMethod) + objectMemory baseHeaderSize)]!
- 	  and: [instrPointer < (aMethod + (objectMemory byteLengthOf: aMethod) + self baseHeaderSize)]!

Item was changed:
  ----- Method: StackInterpreter>>withSmallIntegerTags: (in category 'frame access') -----
  withSmallIntegerTags: value
  	<inline: true>
  	<var: #value type: #'char *'>
+ 	self assert: ((self oopForPointer: value) bitAnd: objectMemory bytesPerWord - 1) = 0.
- 	self assert: ((self oopForPointer: value) bitAnd: self bytesPerWord - 1) = 0.
  	^(self oopForPointer: value) + 1!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveClosureCopyWithCopiedValues (in category 'control primitives') -----
  primitiveClosureCopyWithCopiedValues
  	| newClosure numArgs |
  	numArgs := self stackIntegerValue: 1.
  	self successful ifFalse:
  		[^self primitiveFail].
  
  	newClosure := self
  					closureIn: (self stackValue: 2)
  					numArgs: numArgs
  							"greater by 1 due to preIncrement of localIP"
+ 					instructionPointer: instructionPointer + 2 - (method + objectMemory baseHeaderSize)
- 					instructionPointer: instructionPointer + 2 - (method + self baseHeaderSize)
  					copiedValues: self stackTop.
  	self pop: 3 thenPush: newClosure!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveDoNamedPrimitiveWithArgs (in category 'plugin primitives') -----
  primitiveDoNamedPrimitiveWithArgs
  	"Simulate an primitiveExternalCall invocation (e.g. for the Debugger).  Do not cache anything.
  	 e.g. ContextPart>>tryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments"
  	| argumentArray arraySize methodArg methodHeader
  	  moduleName functionName moduleLength functionLength
  	  spec addr primRcvr ctxtRcvr |
  	<var: #addr declareC: 'void (*addr)()'>
  	argumentArray := self stackTop.
  	(objectMemory isArray: argumentArray) ifFalse:
  		[^self primitiveFailFor: -2]. "invalid args"
  	arraySize := objectMemory fetchWordLengthOf: argumentArray.
  	self success: (self roomToPushNArgs: arraySize).
  
  	methodArg := self stackObjectValue: 2.
  	self successful ifFalse:
  		[^self primitiveFailFor: -2]. "invalid args"
  
  	(objectMemory isOopCompiledMethod: methodArg) ifFalse:
  		[^self primitiveFailFor: -2]. "invalid args"
  
  	methodHeader := self headerOf: methodArg.
  
  	(self literalCountOfHeader: methodHeader) > 2 ifFalse:
  		[^self primitiveFailFor: -3]. "invalid methodArg state"
  	(self assertClassOf: (spec := objectMemory fetchPointer: 1 "first literal" ofObject: methodArg)
  		is: (objectMemory splObj: ClassArray) 
  		compactClassIndex: ClassArrayCompactIndex).
  	(self successful
  	and: [(objectMemory lengthOf: spec) = 4
  	and: [(self primitiveIndexOfMethodHeader: methodHeader) = 117]]) ifFalse:
  		[^self primitiveFailFor: -3]. "invalid methodArg state"
  
  	(self argumentCountOfMethodHeader: methodHeader) = arraySize ifFalse:
  		[^self primitiveFailFor: -2]. "invalid args (Array args wrong size)"
  
  	"The function has not been loaded yet. Fetch module and function name."
  	moduleName := objectMemory fetchPointer: 0 ofObject: spec.
  	moduleName = objectMemory nilObject
  		ifTrue: [moduleLength := 0]
  		ifFalse: [self success: (objectMemory isBytes: moduleName).
  				moduleLength := objectMemory lengthOf: moduleName.
  				self cCode: '' inSmalltalk:
  					[ (#('FloatArrayPlugin' 'Matrix2x3Plugin') includes: (self stringOf: moduleName)) "??"
  						ifTrue: [moduleLength := 0  "Cause all of these to fail"]]].
  	functionName := objectMemory fetchPointer: 1 ofObject: spec.
  	self success: (objectMemory isBytes: functionName).
  	functionLength := objectMemory lengthOf: functionName.
  	self successful ifFalse: [^self primitiveFailFor: -3]. "invalid methodArg state"
  
+ 	addr := self ioLoadExternalFunction: functionName + objectMemory baseHeaderSize
- 	addr := self ioLoadExternalFunction: functionName + self baseHeaderSize
  				OfLength: functionLength
+ 				FromModule: moduleName + objectMemory baseHeaderSize
- 				FromModule: moduleName + self baseHeaderSize
  				OfLength: moduleLength.
  	addr = 0 ifTrue:
  		[^self primitiveFailFor: -1]. "could not find function; answer generic failure (see below)"
  
  	"Cannot fail this primitive from now on.  Can only fail the external primitive."
  	objectMemory pushRemappableOop: (argumentArray := self popStack).
  	objectMemory pushRemappableOop: (primRcvr := self popStack).
  	objectMemory pushRemappableOop: self popStack. "the method"
  	objectMemory pushRemappableOop: self popStack. "the context receiver"
  	self push: primRcvr. "replace context receiver with actual receiver"
  	argumentCount := arraySize.
  	1 to: arraySize do:
  		[:index| self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray)].
  	"Run the primitive (sets primFailCode)"
  	lkupClass := objectMemory nilObject.
  	self callExternalPrimitive: addr.
  	ctxtRcvr  := objectMemory popRemappableOop.
  	methodArg := objectMemory popRemappableOop.
  	primRcvr := objectMemory popRemappableOop.
  	argumentArray := objectMemory popRemappableOop.
  	self successful ifFalse: "If primitive failed, then restore state for failure code"
  		[self pop: arraySize + 1.
  		 self push: ctxtRcvr.
  		 self push: methodArg.
  		 self push: primRcvr.
  		 self push: argumentArray.
  		 argumentCount := 3.
  		 "Hack.  A nil prim error code (primErrorCode = 1) is interpreted by the image
  		  as meaning this primitive is not implemented.  So to pass back nil as an error
  		  code we use -1 to indicate generic failure."
  		 primFailCode = 1 ifTrue:
  			[primFailCode := -1]]!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveExternalCall (in category 'plugin primitives') -----
  primitiveExternalCall
  	"Call an external primitive. External primitive methods first literals are an array of
  		* The module name (String | Symbol) 
  		* The function name (String | Symbol) 
  		* The session ID (SmallInteger) [OBSOLETE] 
  		* The function index (Integer) in the externalPrimitiveTable
  	For fast interpreter dispatch in subsequent invocations the primitiveFunctionPointer
  	in the method cache is rewritten, either to the function itself, or to zero if the external
  	function is not found.   This allows for fast responses as long as the method stays in
  	the cache. The cache rewrite relies on lastMethodCacheProbeWrite which is set in
  	addNewMethodToCache:. 
  	Now that the VM flushes function addresses from its tables, the session ID is obsolete,
  	but it is kept for backward compatibility. Also, a failed lookup is reported specially. If a
  	method has been  looked up and not been found, the function address is stored as -1
  	(i.e., the SmallInteger -1 to distinguish from 16rFFFFFFFF which may be returned from
  	lookup), and the primitive fails with PrimErrNotFound."
  	| lit addr moduleName functionName moduleLength functionLength index |
  	<var: #addr declareC: 'void (*addr)()'>
  	
  	"Fetch the first literal of the method"
  	(self literalCountOf: newMethod) > 0 ifFalse:
  		[^self primitiveFailFor: PrimErrBadMethod].
  
  	lit := self literal: 0 ofMethod: newMethod. 
  	"Check if it's an array of length 4"
  	((objectMemory isArray: lit) and: [(objectMemory lengthOf: lit) = 4]) ifFalse:
  		[^self primitiveFailFor: PrimErrBadMethod].
  
  	"Look at the function index in case it has been loaded before"
  	index := objectMemory fetchPointer: 3 ofObject: lit.
  	(objectMemory isIntegerObject: index) ifFalse:
  		[^self primitiveFailFor: PrimErrBadMethod].
  	index := objectMemory integerValueOf: index.
  	"Check if we have already looked up the function and failed."
  	index < 0 ifTrue:
  		["Function address was not found in this session, 
  		  Void the primitive function."
  		 self rewriteMethodCacheEntryForExternalPrimitiveToFunction: 0.
  		 ^self primitiveFailFor: PrimErrNotFound].
  
  	"Try to call the function directly"
  	(index > 0 and: [index <= MaxExternalPrimitiveTableSize]) ifTrue:
  		[addr := externalPrimitiveTable at: index - 1.
  		 addr ~= 0 ifTrue:
  			[self rewriteMethodCacheEntryForExternalPrimitiveToFunction: (self cCode: 'addr' inSmalltalk: [1000 + index]).
  			 self callExternalPrimitive: addr.
  			 ^nil].
  		"if we get here, then an index to the external prim was 
  		kept on the ST side although the underlying prim 
  		table was already flushed"
  		^self primitiveFailFor: PrimErrNamedInternal].
  
  	"Clean up session id and external primitive index"
  	objectMemory storePointerUnchecked: 2 ofObject: lit withValue: ConstZero.
  	objectMemory storePointerUnchecked: 3 ofObject: lit withValue: ConstZero.
  
  	"The function has not been loaded yet. Fetch module and function name."
  	moduleName := objectMemory fetchPointer: 0 ofObject: lit.
  	moduleName = objectMemory nilObject
  		ifTrue: [moduleLength := 0]
  		ifFalse: [(objectMemory isBytes: moduleName) ifFalse:
  					[self primitiveFailFor: PrimErrBadMethod].
  				moduleLength := objectMemory lengthOf: moduleName].
  	functionName := objectMemory fetchPointer: 1 ofObject: lit.
  	(objectMemory isBytes: functionName) ifFalse:
  		[self primitiveFailFor: PrimErrBadMethod].
  	functionLength := objectMemory lengthOf: functionName.
  
+ 	addr := self ioLoadExternalFunction: functionName + objectMemory baseHeaderSize
- 	addr := self ioLoadExternalFunction: functionName + self baseHeaderSize
  				OfLength: functionLength
+ 				FromModule: moduleName + objectMemory baseHeaderSize
- 				FromModule: moduleName + self baseHeaderSize
  				OfLength: moduleLength.
  	addr = 0
  		ifTrue: [index := -1]
  		ifFalse: ["add the function to the external primitive table"
  			index := self addToExternalPrimitiveTable: addr].
  
  	"Store the index (or -1 if failure) back in the literal"
  	objectMemory storePointerUnchecked: 3 ofObject: lit withValue: (objectMemory integerObjectOf: index).
  
  	"If the function has been successfully loaded cache and call it"
  	index >= 0
  		ifTrue:
  			[self rewriteMethodCacheEntryForExternalPrimitiveToFunction: (self cCode: [addr] inSmalltalk: [1000 + index]).
  			self callExternalPrimitive: addr]
  		ifFalse: ["Otherwise void the primitive function and fail"
  			self rewriteMethodCacheEntryForExternalPrimitiveToFunction: 0.
  			^self primitiveFailFor: PrimErrNotFound]!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitivePerform (in category 'control primitives') -----
  primitivePerform
  	<returnTypeC: #void>
  	| performSelector newReceiver lookupClass performMethod |
  	performSelector := messageSelector.
  	performMethod := newMethod.
  	messageSelector := self stackValue: argumentCount - 1.
  	newReceiver := self stackValue: argumentCount.
  
  	"NOTE: the following lookup may fail and be converted to #doesNotUnderstand:,
  	 so we must adjust argumentCount and slide args now, so that will work."
  
  	"Slide arguments down over selector"
  	argumentCount := argumentCount - 1.
  	argumentCount to: 1 by: -1 do:
  		[:i|
  		stackPages
+ 			longAt: stackPointer + (i * objectMemory bytesPerWord)
+ 			put: (stackPages longAt: stackPointer + ((i - 1) * objectMemory bytesPerWord))].
- 			longAt: stackPointer + (i * BytesPerWord)
- 			put: (stackPages longAt: stackPointer + ((i - 1) * BytesPerWord))].
  	self pop: 1.
  	lookupClass := objectMemory fetchClassOf: newReceiver.
+ 	self sendBreak: messageSelector + objectMemory baseHeaderSize
- 	self sendBreak: messageSelector + self baseHeaderSize
  		point: (objectMemory lengthOf: messageSelector)
  		receiver: newReceiver.
  	self findNewMethodInClass: lookupClass.
  
  	"Only test CompiledMethods for argument count - other objects will have to take their chances"
  	((objectMemory isOopCompiledMethod: newMethod)
  	  and: [(self argumentCountOf: newMethod) = argumentCount]) ifFalse:
  		["Slide the args back up (sigh) and re-insert the selector."
  		self unPop: 1.
  		1 to: argumentCount by: 1 do:
  			[:i |
+ 			stackPages longAt: stackPointer + ((i - 1) * objectMemory bytesPerWord)
+ 				put: (stackPages longAt: stackPointer + (i * objectMemory bytesPerWord))].
+ 		stackPages longAt: stackPointer + (argumentCount * objectMemory bytesPerWord) put: messageSelector.
- 			stackPages longAt: stackPointer + ((i - 1) * BytesPerWord)
- 				put: (stackPages longAt: stackPointer + (i * BytesPerWord))].
- 		stackPages longAt: stackPointer + (argumentCount * BytesPerWord) put: messageSelector.
  		argumentCount := argumentCount + 1.
  		newMethod := performMethod.
  		messageSelector := performSelector.
  		^self primitiveFail].
  
  	self executeNewMethod.
  	"Recursive xeq affects primErrorCode"
  	self initPrimCall!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveTerminateTo (in category 'control primitives') -----
  primitiveTerminateTo
  	"Primitive. Terminate up the context stack from the receiver up to but not including
  	 the argument, if previousContext is on my Context stack. Make previousContext my
  	 sender. This prim has to shadow the code in ContextPart>terminateTo: to be correct."
  	| thisCtx currentCtx aContextOrNil contextsFP contextsSP contextsIP nextCntx stackedReceiverOffset 
  	  theFP newFP newSP pageToStopOn thePage frameAbove |
  	<var: #contextsFP type: #'char *'>
  	<var: #theFP type: #'char *'>
  	<var: #newFP type: #'char *'>
  	<var: #newSP type: #'char *'>
  	<var: #contextsIP type: #usqInt>
  	<var: #frameAbove type: #'char *'>
  	<var: #contextsSP type: #'char *'>
  	<var: #source type: #'char *'>
  	<var: #pageToStopOn type: #'StackPage *'>
  	<var: #thePage type: #'StackPage *'>
  
  	aContextOrNil := self stackTop.
  	(aContextOrNil = objectMemory nilObject or: [self isContext: aContextOrNil]) ifFalse:
  		[^self primitiveFail].
  	thisCtx := self stackValue: 1.
  	thisCtx = aContextOrNil ifTrue:
  		[^self primitiveFail].		
  
  	"All stackPages need to have current head pointers to avoid confusion."
  	self externalWriteBackHeadFramePointers.
  
  	"If we're searching for aContextOrNil it might be on a stack page.  Helps to know
  	 if we can free a whole page or not, or if we can short-cut the termination."
  	(aContextOrNil ~= objectMemory nilObject and: [self isStillMarriedContext: aContextOrNil])
  		ifTrue: [contextsFP := self frameOfMarriedContext: aContextOrNil.
  				pageToStopOn := stackPages stackPageFor: contextsFP]
  		ifFalse: [pageToStopOn := 0].
  
  	"if thisCtx is married ensure it is a base frame.  Then we can assign its sender."
  	(self isStillMarriedContext: thisCtx)
  		ifTrue:
  			[theFP := self frameOfMarriedContext: thisCtx.
  			 "Optimize terminating thisContext.  Move its frame down to be next to
  			  aContextOrNil's frame. Common in the exception system and so helps to be fast."
  			 (theFP = framePointer
  			  and: [pageToStopOn = stackPage]) ifTrue:
  				[(self frameCallerFP: theFP) ~= contextsFP ifTrue:
  					[stackedReceiverOffset := self frameStackedReceiverOffset: theFP.
  					 frameAbove := self findFrameAbove: contextsFP inPage: pageToStopOn.
  					 contextsIP := self frameCallerSavedIP: frameAbove.
  					 newSP := self frameCallerSP: frameAbove.
+ 					 newFP := newSP - stackedReceiverOffset - objectMemory bytesPerWord.
- 					 newFP := newSP - stackedReceiverOffset - BytesPerWord.
  					 theFP + stackedReceiverOffset
  						to: stackPointer
+ 						by: objectMemory bytesPerWord negated
- 						by: BytesPerWord negated
  						do: [:source|
+ 							newSP := newSP - objectMemory bytesPerWord.
- 							newSP := newSP - BytesPerWord.
  							stackPages longAt: newSP put: (stackPages longAt: source)].
  					 stackPages longAt: newFP + FoxSavedFP put: contextsFP.
  					 stackPages longAt: newFP + FoxCallerSavedIP put: contextsIP.
  					 self assert: (self isContext: thisCtx).
  					 objectMemory storePointerUnchecked: SenderIndex
  						ofObject: thisCtx
  						withValue: (self withSmallIntegerTags: newFP).
  					 objectMemory storePointerUnchecked: InstructionPointerIndex
  						ofObject: thisCtx
  						withValue: (self withSmallIntegerTags: contextsFP).
  					 framePointer := newFP.
  					 stackPointer := newSP].
  				self pop: 1.
  				self assert: stackPage = stackPages mostRecentlyUsedPage.
  				^nil].
  			 theFP := self externalEnsureIsBaseFrame: theFP. "May cause a GC!!!!"
  			 currentCtx := self frameCallerContext: theFP.
  			 "May also reclaim aContextOrNil's page, hence..."
  			 (aContextOrNil ~= objectMemory nilObject and: [self isStillMarriedContext: aContextOrNil])
  				ifTrue: [contextsFP := self frameOfMarriedContext: aContextOrNil.
  						pageToStopOn := stackPages stackPageFor: contextsFP]
  				ifFalse: [pageToStopOn := 0]]
  		ifFalse:
  			[currentCtx := objectMemory fetchPointer: SenderIndex ofObject: thisCtx].
  
  	(self context: thisCtx hasSender: aContextOrNil) ifTrue:
  		["Need to walk the stack freeing stack pages and nilling contexts."
  		[currentCtx = aContextOrNil
  		 or: [currentCtx = objectMemory nilObject]] whileFalse:
  			[self assert: (self isContext: currentCtx).
  			 (self isMarriedOrWidowedContext: currentCtx)
  				ifTrue:
  					[theFP := self frameOfMarriedContext: currentCtx.
  					thePage := stackPages stackPageFor: theFP.
  					"If externalEnsureIsBaseFrame: above has moved thisContext to its own stack
  					 then we will always terminate to a frame on a different page.  But if we are
  					 terminating some other context to a context somewhere on the current page
  					 we must save the active frames above that context.  Things will look e.g. like this:
  		thisCtx			499383332 s MethodContext(ContextPart)>resume:
  						499380484 s BlockClosure>ensure:
  						499377320 s MethodContext(ContextPart)>handleSignal:
  						499373760 s MethodContext(ContextPart)>handleSignal:
  						499372772 s MessageNotUnderstood(Exception)>signal
  						499369068 s CodeSimulationTests(Object)>doesNotUnderstand: absentMethod
  						499368708 s [] in CodeSimulationTests>testDNU
  							(sender is 0xbffc2480 I CodeSimulationTests>runSimulated:)
  						------------
  		framePointer	0xbffc234c M MethodContext(ContextPart)>doPrimitive:method:receiver:args:
  						0xbffc2378 M MethodContext(ContextPart)>tryPrimitiveFor:receiver:args:
  						0xbffc23ac M MethodContext(ContextPart)>send:to:with:super:
  						0xbffc23e4 M MethodContext(ContextPart)>send:super:numArgs:
  						0xbffc2418 M MethodContext(InstructionStream)>interpretNextInstructionFor:
  						0xbffc2434 M MethodContext(ContextPart)>step
  						0xbffc2458 I MethodContext(ContextPart)>runSimulated:contextAtEachStep:
  						------------
  (499368708's sender)	0xbffc2480 I CodeSimulationTests>runSimulated:
  						0xbffc249c M CodeSimulationTests>testDNU
  						0xbffc24bc I CodeSimulationTests(TestCase)>performTest
  						0xbffc24dc I [] in CodeSimulationTests(TestCase)>runCase
  		aContextOrNil	0xbffc24fc M BlockClosure>ensure:
  						0xbffc2520 I CodeSimulationTests(TestCase)>runCase
  						0xbffc253c M [] in TestResult>runCase:
  					When we find this case we move the frames above to a new page by making the
  					frame above currentCtx a base frame, i.e. making 0xbffc2458 in the above example
  					a base frame.  But in this iteration of the loop we don't move down a frame i.e. currentCtx
  					doesn't change on this iteration."
  					thePage = stackPage
  						ifTrue:
  							[frameAbove := self findFrameAbove: theFP inPage: thePage.
  							self assert: frameAbove ~= 0.
  							frameAbove := self externalEnsureIsBaseFrame: frameAbove. "May cause a GC!!!! May also reclaim aContextOrNil's page, hence..."
  							(aContextOrNil ~= objectMemory nilObject and: [self isStillMarriedContext: aContextOrNil])
  								ifTrue: [contextsFP := self frameOfMarriedContext: aContextOrNil.
  										pageToStopOn := stackPages stackPageFor: contextsFP]
  								ifFalse: [pageToStopOn := 0]]
  						ifFalse:
  							[thePage = pageToStopOn
  								ifTrue:
  									["We're here.  Cut back the stack to aContextOrNil's frame,
  									  push its instructionPointer if it's not already a head frame,
  									  and we're done."
  									 frameAbove := self findFrameAbove: contextsFP inPage: thePage.
  									 frameAbove ~= 0 ifTrue:
+ 										[contextsSP := (self frameCallerSP: frameAbove) - objectMemory bytesPerWord.
- 										[contextsSP := (self frameCallerSP: frameAbove) - BytesPerWord.
  										 stackPages longAt: contextsSP put: (self frameCallerSavedIP: frameAbove).
  										 self setHeadFP: contextsFP andSP: contextsSP inPage: thePage].
  									 currentCtx := aContextOrNil]
  								ifFalse:
  									["We can free the entire page without further ado."
  									 currentCtx := self frameCallerContext: thePage baseFP.
  									 "for a short time invariant is violated; assert follows"
  									 stackPages freeStackPageNoAssert: thePage]]]
  				ifFalse:
  					[nextCntx := objectMemory fetchPointer: SenderIndex ofObject: currentCtx.
  					 self markContextAsDead: currentCtx.
  					 currentCtx := nextCntx]]].
  	self assert: stackPages pageListIsWellFormed.
  	(self isMarriedOrWidowedContext: thisCtx)
  		ifTrue:
  			[self assert: (self checkIsStillMarriedContext: thisCtx currentFP: framePointer).
  			 self assert: (self isBaseFrame: (self frameOfMarriedContext: thisCtx)).
  			 theFP := self frameOfMarriedContext: thisCtx.
  			 self frameCallerContext: theFP put: aContextOrNil]
  		ifFalse: [objectMemory storePointer: SenderIndex ofObject: thisCtx withValue: aContextOrNil].
  	self pop: 1.
  	self assert: stackPage = stackPages mostRecentlyUsedPage.
  	^nil!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveVMParameter (in category 'system control primitives') -----
(excessive size, no diff calculated)

Item was changed:
  ----- Method: StackInterpreterSimulator>>clipboardWrite:From:At: (in category 'I/O primitives') -----
  clipboardWrite: sz From: actualDataAddress At: ignored
  
+ 	Clipboard clipboardText: (self stringOf: actualDataAddress - objectMemory baseHeaderSize)!
- 	Clipboard clipboardText: (self stringOf: actualDataAddress - BaseHeaderSize)!

Item was changed:
  ----- Method: StackInterpreterSimulator>>shortPrint: (in category 'debug support') -----
  shortPrint: oop
  	| name classOop |
  	(objectMemory isIntegerObject: oop) ifTrue: [^ '=' , (objectMemory integerValueOf: oop) printString , 
  		' (' , (objectMemory integerValueOf: oop) hex , ')'].
  	(oop between: objectMemory startOfMemory and: objectMemory freeStart) ifFalse:
  		[^' is not on the heap'].
+ 	(oop bitAnd: (objectMemory bytesPerWord - 1)) ~= 0 ifTrue:
- 	(oop bitAnd: (BytesPerWord - 1)) ~= 0 ifTrue:
  		[^' is misaligned'].
  	classOop := objectMemory fetchClassOf: oop.
  	(objectMemory sizeBitsOf: classOop) = metaclassSizeBytes ifTrue: [
  		^ 'class ' , (self nameOfClass: oop)].
  	name := self nameOfClass: classOop.
  	name size = 0 ifTrue: [name := '??'].
  	name = 'String' ifTrue: [^ (self stringOf: oop) printString].
  	name = 'ByteString' ifTrue: [^ (self stringOf: oop) printString].
  	name = 'Symbol' ifTrue: [^ '#' , (self stringOf: oop)].
  	name = 'ByteSymbol' ifTrue: [^ '#' , (self stringOf: oop)].
  	name = 'Character' ifTrue: [^ '=' , (Character value: (objectMemory integerValueOf: 
  				(objectMemory fetchPointer: 0 ofObject: oop))) printString].
  	name = 'UndefinedObject' ifTrue: [^ 'nil'].
  	name = 'False' ifTrue: [^ 'false'].
  	name = 'True' ifTrue: [^ 'true'].
  	name = 'Float' ifTrue: [^ '=' , (self dbgFloatValueOf: oop) printString].
  	name = 'Association' ifTrue: [^ '(' ,
+ 				(self shortPrint: (self longAt: oop + objectMemory baseHeaderSize)) ,
- 				(self shortPrint: (self longAt: oop + BaseHeaderSize)) ,
  				' -> ' ,
+ 				(self longAt: oop + objectMemory baseHeaderSize + objectMemory bytesPerWord) hex8 , ')'].
- 				(self longAt: oop + BaseHeaderSize + BytesPerWord) hex8 , ')'].
  	('AEIOU' includes: name first)
  		ifTrue: [^ 'an ' , name]
  		ifFalse: [^ 'a ' , name]!

Item was changed:
  ----- Method: StackInterpreterSimulator>>shortPrintRelative: (in category 'debug support') -----
  shortPrintRelative: oop
  	| name classOop |
  	(objectMemory isIntegerObject: oop) ifTrue:
  		[^'=' , (objectMemory integerValueOf: oop) printString , 
  		' (' , (objectMemory integerValueOf: oop) hex , ')'].
  	(oop between: objectMemory startOfMemory and: objectMemory freeStart) ifFalse:
  		[^' is not on the heap'].
+ 	(oop bitAnd: (objectMemory bytesPerWord - 1)) ~= 0 ifTrue:
- 	(oop bitAnd: (BytesPerWord - 1)) ~= 0 ifTrue:
  		[^' is misaligned'].
  	classOop := objectMemory fetchClassOfNonInt: oop.
  	(objectMemory sizeBitsOf: classOop) = metaclassSizeBytes ifTrue: [
  		^'class ' , (self nameOfClass: oop)].
  	name := self nameOfClass: classOop.
  	name size = 0 ifTrue: [name := '??'].
  	name = 'String' ifTrue: [^(self stringOf: oop) printString].
  	name = 'ByteString' ifTrue: [^(self stringOf: oop) printString].
  	name = 'Symbol' ifTrue: [^'#' , (self stringOf: oop)].
  	name = 'ByteSymbol' ifTrue: [^'#' , (self stringOf: oop)].
  	name = 'Character' ifTrue: [^'=' , (Character value: (objectMemory integerValueOf: 
  				(objectMemory fetchPointer: 0 ofObject: oop))) printString].
  	name = 'UndefinedObject' ifTrue: [^'nil'].
  	name = 'False' ifTrue: [^'false'].
  	name = 'True' ifTrue: [^'true'].
  	name = 'Float' ifTrue: [^'=' , (self dbgFloatValueOf: oop) printString].
  	name = 'Association' ifTrue:
  		[| valOop |
+ 		valOop := self longAt: oop + objectMemory baseHeaderSize + objectMemory bytesPerWord.
- 		valOop := self longAt: oop + BaseHeaderSize + BytesPerWord.
  		^'(' ,
+ 			(self shortPrint: (self longAt: oop + objectMemory baseHeaderSize)) ,
- 			(self shortPrint: (self longAt: oop + BaseHeaderSize)) ,
  			' -> ' ,
  			((objectMemory isIntegerObject: valOop) ifTrue: [valOop] ifFalse: [valOop - objectMemory startOfMemory]) hex8 , ')'].
  	^(('AEIOU' includes: name first)
  		ifTrue: ['an ']
  		ifFalse: ['a ']) , name!

Item was changed:
  ----- Method: StackInterpreterSimulator>>stringOf: (in category 'debug support') -----
  stringOf: oop
  	| size long nLongs chars |
  	^ String streamContents:
  		[:strm |
  		size := 100 min: (self stSizeOf: oop).
+ 		nLongs := size-1//objectMemory bytesPerWord+1.
- 		nLongs := size-1//BytesPerWord+1.
  		1 to: nLongs do:
+ 			[:i | long := self longAt: oop + objectMemory baseHeaderSize + (i-1*objectMemory bytesPerWord).
- 			[:i | long := self longAt: oop + BaseHeaderSize + (i-1*BytesPerWord).
  			chars := self charsOfLong: long.
  			strm nextPutAll: (i=nLongs
+ 							ifTrue: [chars copyFrom: 1 to: size-1\\objectMemory bytesPerWord+1]
- 							ifTrue: [chars copyFrom: 1 to: size-1\\BytesPerWord+1]
  							ifFalse: [chars])]]!

Item was changed:
  ----- Method: StackInterpreterSimulator>>vmPathGet:Length: (in category 'file primitives') -----
  vmPathGet: stringBase Length: stringSize
  	| pathName stringOop |
  	pathName := Smalltalk vmPath.
+ 	stringOop := stringBase - objectMemory baseHeaderSize. "Due to C call in Interp"
- 	stringOop := stringBase - BaseHeaderSize. "Due to C call in Interp"
  	1 to: stringSize do:
  		[:i | objectMemory storeByte: i-1 ofObject: stringOop
  			withValue: (pathName at: i) asciiValue].
  !

Item was changed:
  ----- Method: StackInterpreterSimulator>>writeImageFileIO: (in category 'image save/restore') -----
  writeImageFileIO: numberOfBytesToWrite
  	"Actually emit the first numberOfBytesToWrite object memory bytes onto the snapshot."
  
  	| headerSize file |
+ 	objectMemory bytesPerWord = 4 ifFalse: [self error: 'Not rewritten for 64 bits yet'].
- 	BytesPerWord = 4 ifFalse: [self error: 'Not rewritten for 64 bits yet'].
  	headerSize := 64.
  
  	[
  		file := (FileStream fileNamed: imageName) binary.
  		file == nil ifTrue: [^nil].
  	
  		{
  			self imageFormatVersion.
  			headerSize.
  			numberOfBytesToWrite.
  			objectMemory startOfMemory.
  			(objectMemory getSpecialObjectsOop).
  			(objectMemory getLastHash).
  			self ioScreenSize.
  			fullScreenFlag.
  			extraVMMemory
  		}
  			do: [:long | self putLong: long toFile: file].
  
  		{	desiredNumStackPages. 	self unknownShortOrCodeSizeInKs } do:
  			[:short| self putShort: short toFile: file].
  
  		self putLong: desiredEdenBytes toFile: file.
  
  		{	maxExtSemTabSizeSet ifTrue: [self ioGetMaxExtSemTableSize] ifFalse: [0]. 0 } do:
  			[:short| self putShort: short toFile: file].
  
  		"Pad the rest of the header."
  		4 timesRepeat: [self putLong: 0 toFile: file].
  	
  		"Position the file after the header."
  		file position: headerSize.
  	
  		"Write the object memory."
  		objectMemory startOfMemory // 4 + 1
  			to: numberOfBytesToWrite // 4
  			do: [:index |
  				self
  					putLong: (objectMemory getMemory at: index)
  					toFile: file].
  	
  		self success: true
  	]
  		ensure: [file close]!

Item was changed:
  ----- Method: StackInterpreterSimulatorLSB>>nextLongFrom: (in category 'initialization') -----
  nextLongFrom: aStream
  	"Read a 32- or 64-bit quantity from the given (binary) stream."
  
+ 	^ aStream nextLittleEndianNumber: objectMemory bytesPerWord!
- 	^ aStream nextLittleEndianNumber: BytesPerWord!

Item was added:
+ ----- Method: TMethod>>superExpansionNodeFor:args: (in category 'inlining') -----
+ superExpansionNodeFor: aSelector args: argumentNodes
+ 	"Answer the expansion of a super send.  Merge the super expansion's
+ 	 locals, properties and comment into this method's properties."
+ 	(definingClass superclass lookupSelector: aSelector)
+ 		ifNil: [self error: 'superclass does not define super method']
+ 		ifNotNil:
+ 			[:superMethod| | superTMethod commonVars varMap |
+ 			superTMethod := superMethod methodNode asTranslationMethodOfClass: self class.
+ 			((argumentNodes allSatisfy: [:parseNode| parseNode isVariableNode])
+ 			and: [(argumentNodes asOrderedCollection collect: [:parseNode| parseNode key]) = superTMethod args]) ifFalse:
+ 				[self error: definingClass name, '>>',selector, ' args ~= ',
+ 							superTMethod definingClass name, '>>', aSelector,
+ 							(String with: $. with: Character cr),
+ 							'For super expansions to be translated correctly each argument must be a variable with the same name as the corresponding argument in the super method.'].
+ 			self mergePropertiesOfSuperMethod: superTMethod.
+ 			(commonVars := superTMethod locals intersection: self locals) notEmpty ifTrue:
+ 				[varMap := Dictionary new.
+ 				 commonVars do:
+ 					[:k| varMap at: k put: (superTMethod unusedNamePrefixedBy: k avoiding: self allLocals)].
+ 				 superTMethod renameVariablesUsing: varMap].
+ 			self assert: (superTMethod locals allSatisfy: [:var| (self locals includes: var) not]).
+ 			locals addAll: superTMethod locals.
+ 			superTMethod declarations keysAndValuesDo:
+ 				[:var :decl|
+ 				self declarationAt: var put: decl].
+ 			superTMethod comment ifNotNil:
+ 				[:superComment|
+ 				comment := comment
+ 								ifNil: [superComment]
+ 								ifNotNil: [superComment, comment]].
+ 			superTMethod extraVariableNumber ifNotNil:
+ 				[:scvn|
+ 				extraVariableNumber := extraVariableNumber ifNil: [scvn] ifNotNil: [:cvn| cvn + scvn]].
+ 			superTMethod elideAnyFinalReturn.
+ 			^superTMethod parseTree]!

Item was changed:
  ----- Method: VMMaker class>>versionString (in category 'version testing') -----
  versionString
  
  	"VMMaker versionString"
  
+ 	^'4.13.12'!
- 	^'4.13.11'!

Item was changed:
  ----- Method: VMStackFrameOffsets class>>initializeFrameIndices (in category 'class initialization') -----
  initializeFrameIndices
  	"Format of a stack frame.  Word-sized indices relative to the frame pointer.
  	 Terminology
  		Frames are either single (have no context) or married (have a context).
  		Contexts are either single (exist on the heap), married (have a context) or widowed (had a frame that has exited).
  	 Stacks grow down:
  
  			receiver for method activations/closure for block activations
  			arg0
  			...
  			argN
  			caller's method ip/base frame's sender context
  	fp->	saved fp
  			method
  			frame flags
  			context (uninitialized)
  			receiver
  			first temp
  			...
  	sp->	Nth temp
  
  	frame flags holds the number of arguments (since argument temporaries are above the frame)
  	the flag for a block activation
  	and the flag indicating if the context field is valid (whether the frame is married).
  
  	The first frame in a stack page is the baseFrame and is marked as such by a null saved fp,
  	in which case the saved method ip is actually the context (possibly hybrid) beneath the base frame"
  
  	| fxCallerSavedIP fxSavedFP fxMethod fxFrameFlags fxThisContext fxReceiver |
  	fxCallerSavedIP := 1.
  	fxSavedFP := 0.
  	fxMethod := -1.
  	fxFrameFlags := -2.	"Can find numArgs, needed for fast temp access. args are above fxCallerSavedIP.
  							 Can find ``is block'' bit
  							 Can find ``has context'' bit"
  	fxThisContext := -3.
  	fxReceiver := -4.
  
  	FrameSlots := fxCallerSavedIP - fxReceiver + 1.
  
+ 	FoxCallerSavedIP := fxCallerSavedIP * self bytesPerWord.
- 	FoxCallerSavedIP := fxCallerSavedIP * BytesPerWord.
  	"In base frames the caller saved ip field holds the caller context."
  	FoxCallerContext := FoxCallerSavedIP.
+ 	FoxSavedFP := fxSavedFP * self bytesPerWord.
+ 	FoxMethod := fxMethod * self bytesPerWord.
+ 	FoxFrameFlags := fxFrameFlags * self bytesPerWord.
+ 	FoxThisContext := fxThisContext * self bytesPerWord.
+ 	FoxReceiver := fxReceiver * self bytesPerWord!
- 	FoxSavedFP := fxSavedFP * BytesPerWord.
- 	FoxMethod := fxMethod * BytesPerWord.
- 	FoxFrameFlags := fxFrameFlags * BytesPerWord.
- 	FoxThisContext := fxThisContext * BytesPerWord.
- 	FoxReceiver := fxReceiver * BytesPerWord!



More information about the Vm-dev mailing list