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

commits at source.squeak.org commits at source.squeak.org
Tue Oct 1 22:18:03 UTC 2013


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

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

Name: VMMaker.oscog-eem.421
Author: eem
Time: 1 October 2013, 3:15:14.076 pm
UUID: 2b23b17a-be58-4e9b-ace2-d72abbc88c9c
Ancestors: VMMaker.oscog-eem.420

Refactor the Cogit code to allow interfacing with Spur.

Modify VMStructType's accessor generator to allow an offset
expression.  Modify CogBlockMethod class>>
instVarNamesAndTypesForTranslationDo: to use either Spur's
or ObjectMemory's header in a CogMethod.  Modify
CogMethodSurrogate to include a baseHeaderSize inst var so that
fields are correctly offset w.r.t. the object header at the front of a
CogMethod.  Parent CogMethodSurrogate with VMClass and arrange
that its class side has initializationOptions, hence objectMemoryClass
and hence baseHeaderSize.
Regenerate most of CogMethodSurrogateN & CogBlockSurrogateN's
accessors to use the baseHeaderSize offset, and move
objectHeader[:] to CogMethodSurrogate.  Make objectHeader
answer signed values and remove the signedIntFromLong sends in
clients.

Fix startPCOfMethod[Header]: and fix several instruction pointer
bounds checking asserts so that both of these are not confused by
the different header size.

Refactor entry code generation to allow CogObjectRepresentationForSpur
to generate the mask of SmallIntegers to occur before entry, allowing
a jump-free common case in the inline cache check.

Add CogObjectRepresentationForSpur & subclasses and
implement some of the translation protocol, including spiffy
concise entry point code.

Fix a few assert: isIntegerObject: and addressCouldBeObj:'s to
assert: addressCouldBeOop:'s.

More isIntegerObject: => isImmediate:,
isNonIntegerObject: => isNonImmediate:,
isArrayNonInt: => isArrayNonImm:.

Fix CoInterpreterMT class>>initializeMiscConstants to not set
COGMTVM to true unless COGMTVM is in initializationOptions.

Change the rumpCStackAddress to be aligned on a 64-byte
boundary.  Eases Spur simulation in the funky bootstrap testing
setup.

Add longLongAt:[put:] to LittleEndianBitmap for Spur header access.

Add Spur32BitCoMemoryManager to hold all the Cogit-specific
stuff in the memory manager.  Move all the accessors that hack
around the CoInterpreter/ObjectMemory split refactoring up into
SpurMemoryManager to avoid duplication.

Nuke CogObjectHeader.  Struct access would have been nice but
soooo sssllllooooowwww to ssssiiiimmmmmuuuuullllllaaaatttteeeee.

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

Item was changed:
  ----- Method: CoInterpreter>>assertValidExecutionPointe:r:s:imbar:line: (in category 'debug support') -----
  assertValidExecutionPointe: lip r: lifp s: lisp imbar: inInterpreter line: ln
  	<var: #lip type: #usqInt>
  	<var: #lifp type: #'char *'>
  	<var: #lisp type: #'char *'>
+ 	| methodField cogMethod theIP  |
- 	| methodField cogMethod savedIP  |
  	<var: #cogMethod type: #'CogMethod *'>
  	self assert: stackPage = (stackPages stackPageFor: lifp) l: ln.
  	self assert: stackPage = stackPages mostRecentlyUsedPage l: ln.
  	self assert: (self deferStackLimitSmashAround: #assertValidStackLimits: asSymbol with: ln).
  	self assert: lifp < stackPage baseAddress l: ln.
  	self assert: lisp < lifp l: ln.
  	self assert: lifp > lisp l: ln.
  	self assert: lisp >= (stackPage realStackLimit - self stackLimitOffset) l: ln.
  	self assert:  (lifp - lisp) < LargeContextSize l: ln.
  	methodField := self frameMethodField: lifp.
  	inInterpreter
  		ifTrue:
  			[self assert: (self isMachineCodeFrame: lifp) not l: ln.
  			 self assert: method = methodField l: ln.
  			 self cppIf: MULTIPLEBYTECODESETS
  				ifTrue: [self assert: (self methodUsesAlternateBytecodeSet: method) = (bytecodeSetSelector = 256) l: ln].
+ 			 (self asserta: (objectMemory cheapAddressCouldBeInHeap: methodField) l: ln) ifTrue:
+ 				[theIP := lip = cogit ceReturnToInterpreterPC
+ 							ifTrue: [self iframeSavedIP: lifp]
+ 							ifFalse: [lip].
+ 				 self assert: (theIP >= (methodField + (objectMemory lastPointerOf: methodField))
+ 							  and: [theIP < (methodField + (objectMemory byteLengthOf: methodField) + objectMemory baseHeaderSize - 1)])
+ 					l: ln].
- 			 ((self asserta: methodField asUnsignedInteger > objectMemory startOfMemory l: ln)
- 			   and: [self asserta: methodField asUnsignedInteger < objectMemory freeStart l: ln]) ifTrue:
- 				[lip = cogit ceReturnToInterpreterPC
- 					ifTrue:
- 						[savedIP := self iframeSavedIP: lifp.
- 						 self assert: (savedIP >= (methodField + (objectMemory lastPointerOf: methodField) + BaseHeaderSize - 1)
- 								  and: [savedIP < (methodField + (objectMemory byteLengthOf: methodField) + BaseHeaderSize)])
- 							l: ln]
- 					ifFalse:
- 						[self assert: (lip >= (methodField + (objectMemory lastPointerOf: methodField) + BaseHeaderSize - 1)
- 								  and: [lip < (methodField + (objectMemory byteLengthOf: methodField) + BaseHeaderSize)])
- 							l: ln]].
  			 self assert: ((self iframeIsBlockActivation: lifp)
  					or: [(self pushedReceiverOrClosureOfFrame: lifp) = (self iframeReceiver: lifp)])
  				l: ln]
  		ifFalse:
  			[self assert: (self isMachineCodeFrame: lifp) l: ln.
  			 ((self asserta: methodField asUnsignedInteger >= cogit minCogMethodAddress l: ln)
  			  and: [self asserta: methodField asUnsignedInteger < cogit maxCogMethodAddress l: ln]) ifTrue:
  				[cogMethod := self mframeHomeMethod: lifp.
  				 self assert: (lip > (methodField + ((self mframeIsBlockActivation: lifp)
  													ifTrue: [self sizeof: CogBlockMethod]
  													ifFalse: [self sizeof: CogMethod]))
  						and: [lip < (methodField + cogMethod blockSize)])
  					l: ln].
  			 self assert: ((self mframeIsBlockActivation: lifp)
  					or: [(self pushedReceiverOrClosureOfFrame: lifp) = (self mframeReceiver: lifp)])
  				l: ln].
  	(self isBaseFrame: lifp) ifTrue:
  		[self assert: (self frameHasContext: lifp) l: ln.
  		 self assert: (self frameContext: lifp) = (stackPages longAt: stackPage baseAddress - BytesPerWord) l: ln]!

Item was changed:
  ----- Method: CoInterpreter>>assertValidStackedInstructionPointersIn:line: (in category 'debug support') -----
  assertValidStackedInstructionPointersIn: aStackPage line: ln
  	"Check that the stacked instruction pointers in the given page are correct.
  	 Checks the interpreter sender/machine code callee contract."
  	<var: #aStackPage type: #'StackPage *'>
  	<var: #theFP type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	<var: #theIP type: #usqInt>
  	<var: #theMethod type: #'CogMethod *'>
  	<inline: false>
  	| prevFrameWasCogged theFP callerFP theMethod theIP methodObj |
  	(self asserta: (stackPages isFree: aStackPage) not l: ln) ifFalse:
  		[^false].
  	prevFrameWasCogged := false.
  	"The top of stack of an inactive page is always the instructionPointer.
  	 The top of stack of the active page may be the instructionPointer if it has been pushed,
  	 which is indicated by a 0 instructionPointer."
  	(stackPage = aStackPage and: [instructionPointer ~= 0])
  		ifTrue:
  			[theIP := instructionPointer.
  			theFP := framePointer]
  		ifFalse:
  			[theIP := (stackPages longAt: aStackPage headSP) asUnsignedInteger.
  			 theFP := aStackPage headFP.
  			 stackPage = aStackPage ifTrue:
  				[self assert: framePointer = theFP l: ln]].
  	[(self isMachineCodeFrame: theFP)
  		ifTrue:
  			[theMethod := self mframeHomeMethod: theFP.
  			 self assert: (theIP = cogit ceCannotResumePC
  						  or: [theIP >= theMethod asUnsignedInteger
  							   and: [theIP < (theMethod asUnsignedInteger + theMethod blockSize)]])
  					l: ln.
  			prevFrameWasCogged := true]
  		ifFalse: "assert-check the interpreter frame."
  			[methodObj := self iframeMethod: theFP.
  			 prevFrameWasCogged ifTrue:
  				[self assert: theIP = cogit ceReturnToInterpreterPC l: ln].
  			 theIP = cogit ceReturnToInterpreterPC ifTrue:
  				[theIP := self iframeSavedIP: theFP].
+ 			 self assert: (theIP >= (methodObj + (objectMemory lastPointerOf: methodObj))
+ 						  and: [theIP < (methodObj + (objectMemory byteLengthOf: methodObj) + objectMemory baseHeaderSize - 1)])
- 			 self assert: (theIP >= (methodObj + (objectMemory lastPointerOf: methodObj) + BaseHeaderSize - 1)
- 						  and: [theIP < (methodObj + (objectMemory byteLengthOf: methodObj) + BaseHeaderSize)])
  				l: ln.
  			 prevFrameWasCogged := false].
  	 theIP := (stackPages longAt: theFP + FoxCallerSavedIP) asUnsignedInteger.
  	 (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
  		[theFP := callerFP].
  	self assert: theIP = cogit ceBaseFrameReturnPC l: ln.
  	^true!

Item was changed:
  ----- Method: CoInterpreter>>ceDynamicSuperSend:to:numArgs: (in category 'trampolines') -----
  ceDynamicSuperSend: selector to: rcvr numArgs: numArgs
  	"Entry-point for an unlinked dynamic super send in a CogMethod.  Smalltalk stack looks like
  					receiver
  					args
  		head sp ->	sender return pc
  		
  	If an MNU then defer to handleMNUInMachineCodeTo:... which will dispatch the MNU and
  	may choose to allocate a closed PIC with a fast MNU dispatch for this send.  Otherwise
  	attempt to link the send site as efficiently as possible.  All link attempts may fail; e.g.
  	because we're out of code memory.
  
  	Continue execution via either executeMethod or interpretMethodFromMachineCode:
  	depending on whether the target method is cogged or not."
  	<api>
  	<option: #NewspeakVM>
  	| class classTag canLinkCacheTag errSelIdx cogMethod mClassMixin mixinApplication |
  	<inline: false>
  	<var: #cogMethod type: #'CogMethod *'>
  	<var: #newCogMethod type: #'CogMethod *'>
  	"self printExternalHeadFrame"
  	"self printStringOf: selector"
  	cogit assertCStackWellAligned.
+ 	self assert: (objectMemory addressCouldBeOop: rcvr).
- 	self assert: ((objectMemory isIntegerObject: rcvr) or: [objectMemory addressCouldBeObj: rcvr]).
  	self sendBreakpoint: selector receiver: rcvr.
  	mClassMixin := self mMethodClass.
  	mixinApplication := self 
  							findApplicationOfTargetMixin: mClassMixin
  							startingAtBehavior: (objectMemory fetchClassOf: rcvr).
  	self assert: (objectMemory lengthOf: mixinApplication) > (InstanceSpecificationIndex + 1).
  	classTag := self classTagForClass: (self superclassOf: mixinApplication).
  	class := objectMemory fetchClassOf: rcvr. "what about the read barrier??"
  	canLinkCacheTag := (objectMemory isYoungObject: class) not or: [cogit canLinkToYoungClasses].
  	argumentCount := numArgs.
  	(self lookupInMethodCacheSel: selector classTag: classTag)
  		ifTrue:"check for coggability because method is in the cache"
  			[self
  				ifAppropriateCompileToNativeCode: newMethod
  				selector: selector]
  		ifFalse:
  			[messageSelector := selector.
  			 (errSelIdx := self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue:
  				[self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: (objectMemory classForClassTag: classTag).
  				self assert: false "NOTREACHED"]].
  	"Method found and has a cog method.  Attempt to link to it."
  	(self maybeMethodHasCogMethod: newMethod) ifTrue:
  		[cogMethod := self cogMethodOf: newMethod.
  		 cogMethod selector = objectMemory nilObject
  			ifTrue: [cogit setSelectorOf: cogMethod to: selector]
  			ifFalse:
  				["Deal with anonymous accessors, e.g. in Newspeak.  The cogMethod may not have the correct
  				  selector.  If not, try and compile a new method with the correct selector."
  				 cogMethod selector ~= selector ifTrue:
  					[(cogit cog: newMethod selector: selector) ifNotNil:
  						[:newCogMethod| cogMethod := newCogMethod]]].
  		 (cogMethod selector = selector
  		 and: [canLinkCacheTag]) ifTrue:
  			[cogit
  				linkSendAt: (stackPages longAt: stackPointer)
  				in: (self mframeHomeMethod: framePointer)
  				to: cogMethod
  				offset: cogit dynSuperEntryOffset
  				receiver: rcvr].
  		 instructionPointer := self popStack.
  		 self executeNewMethod.
  		 self assert: false "NOTREACHED"].
  	instructionPointer := self popStack.
  	^self interpretMethodFromMachineCode
  	"NOTREACHED"!

Item was changed:
  ----- Method: CoInterpreter>>ceReturnToInterpreter: (in category 'trampolines') -----
  ceReturnToInterpreter: anOop
  	"Perform a return from a machine code frame to an interpreted frame.
  	 The machine code has executed a return instruction when the return address
  	 is set to ceReturnToInterpreterPC.  Return the result and switch to the interpreter."
  	<api>
+ 	self assert: (objectMemory addressCouldBeOop: anOop).
- 	self assert: ((objectMemory isIntegerObject: anOop) or: [objectMemory addressCouldBeObj: anOop]).
  	self flag: 'are you really sure setStackPageAndLimit: is needed?'.
  	"I think you're only doing this for the markStackPageMostRecentlyUsed:
  	 and that's probably not needed either"
  	self setStackPageAndLimit: stackPage.
  	self assert: (self isMachineCodeFrame: framePointer) not.
  	self setMethod: (self iframeMethod: framePointer).
  	self assertValidExecutionPointe: (self iframeSavedIP: framePointer)
  		r: framePointer
  		s: stackPointer
  		imbar: true
  		line: #'__LINE__'.
  	instructionPointer := self iframeSavedIP: framePointer.
  	self push: anOop.
  	self siglong: reenterInterpreter jmp: ReturnToInterpreter.
  	"NOTREACHED"
  	^nil!

Item was changed:
  ----- Method: CoInterpreter>>ceSend:super:to:numArgs: (in category 'trampolines') -----
  ceSend: selector super: superNormalBar to: rcvr numArgs: numArgs
  	"Entry-point for an unlinked send in a CogMethod.  Smalltalk stack looks like
  					receiver
  					args
  		head sp ->	sender return pc
  		
  	If an MNU then defer to handleMNUInMachineCodeTo:... which will dispatch the MNU and
  	may choose to allocate a closed PIC with a fast MNU dispatch for this send.  Otherwise
  	attempt to link the send site as efficiently as possible.  All link attempts may fail; e.g.
  	because we're out of code memory.
  
  	Continue execution via either executeMethod or interpretMethodFromMachineCode:
  	depending on whether the target method is cogged or not."
  	<api>
  	| classTag canLinkCacheTag errSelIdx cogMethod |
  	<inline: false>
  	<var: #cogMethod type: #'CogMethod *'>
  	<var: #newCogMethod type: #'CogMethod *'>
  	"self printExternalHeadFrame"
  	"self printStringOf: selector"
  	cogit assertCStackWellAligned.
+ 	self assert: (objectMemory addressCouldBeOop: rcvr).
- 	self assert: ((objectMemory isIntegerObject: rcvr) or: [objectMemory addressCouldBeObj: rcvr]).
  	self sendBreakpoint: selector receiver: rcvr.
  	superNormalBar = 0
  		ifTrue: [classTag := objectMemory fetchClassTagOf: rcvr]
  		ifFalse: [classTag := objectMemory classTagForClass: (self superclassOf: (self methodClassOf: (self frameMethodObject: framePointer)))].
  	canLinkCacheTag := objectMemory hasSpurMemoryManagerAPI
  						or: [(objectMemory isYoungObject: classTag) not or: [cogit canLinkToYoungClasses]].
  	argumentCount := numArgs.
  	(self lookupInMethodCacheSel: selector classTag: classTag)
  		ifTrue:"check for coggability because method is in the cache"
  			[self
  				ifAppropriateCompileToNativeCode: newMethod
  				selector: selector]
  		ifFalse:
  			[messageSelector := selector.
  			 (errSelIdx := self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue:
  				[(canLinkCacheTag
  				  and: [errSelIdx = SelectorDoesNotUnderstand
  				  and: [(cogMethod := cogit cogMNUPICSelector: messageSelector
  											methodOperand: (self mnuMethodOrNilFor: rcvr)
  											numArgs: argumentCount) asUnsignedInteger
  						> cogit minCogMethodAddress]]) ifTrue:
  						[cogit
  							linkSendAt: (stackPages longAt: stackPointer)
  							in: (self mframeHomeMethod: framePointer)
  							to: cogMethod
  							offset: (superNormalBar = 0
  									ifTrue: [cogit entryOffset]
  									ifFalse: [cogit noCheckEntryOffset])
  							receiver: rcvr].
  				self handleMNU: errSelIdx
  					InMachineCodeTo: rcvr
  					classForMessage: (objectMemory classForClassTag: classTag).
  				self assert: false "NOTREACHED"]].
  	"Method found and has a cog method.  Attempt to link to it.  The receiver's class may be young.
  	 If the Cogit can't store young classes in inline caches we can link to an open PIC instead."
  	(self maybeMethodHasCogMethod: newMethod) ifTrue:
  		[cogMethod := self cogMethodOf: newMethod.
  		 cogMethod selector = objectMemory nilObject
  			ifTrue: [cogit setSelectorOf: cogMethod to: selector]
  			ifFalse:
  				["Deal with anonymous accessors, e.g. in Newspeak.  The cogMethod may not have the
  				  correct selector.  If not, try and compile a new method with the correct selector."
  				 cogMethod selector ~= selector ifTrue:
  					[(cogit cog: newMethod selector: selector) ifNotNil:
  						[:newCogMethod| cogMethod := newCogMethod]]].
  		 (cogMethod selector = selector
  		  and: [canLinkCacheTag])
  			ifTrue:
  				[cogit
  					linkSendAt: (stackPages longAt: stackPointer)
  					in: (self mframeHomeMethod: framePointer)
  					to: cogMethod
  					offset: (superNormalBar = 0
  								ifTrue: [cogit entryOffset]
  								ifFalse: [cogit noCheckEntryOffset])
  					receiver: rcvr]
  			ifFalse: "If patchToOpenPICFor:.. returns we're out of code memory"
  				[cogit
  					patchToOpenPICFor: selector
  					numArgs: numArgs
  					receiver: rcvr].
  		 instructionPointer := self popStack.
  		 self executeNewMethod.
  		 self assert: false "NOTREACHED"].
  	instructionPointer := self popStack.
  	^self interpretMethodFromMachineCode
  	"NOTREACHED"!

Item was changed:
  ----- Method: CoInterpreter>>ceSendAbort:to:numArgs: (in category 'trampolines') -----
  ceSendAbort: selector to: rcvr numArgs: numArgs
  	"Entry-point for an abort send in a CogMethod (aboutToReturn:through:, cannotReturn: et al).
  	 Try and dispatch the send, but the send may turn into an MNU in which case defer to
  	 handleMNUInMachineCodeTo:... which will dispatch the MNU.
  
  	 Continue execution via either executeMethod or interpretMethodFromMachineCode:
  	 depending on whether the target method is cogged or not."
  	<api>
  	| classTag errSelIdx |
  	<inline: false>
  	"self printExternalHeadFrame"
  	"self printStringOf: selector"
  	cogit assertCStackWellAligned.
+ 	self assert: (objectMemory addressCouldBeOop: rcvr).
- 	self assert: ((objectMemory isIntegerObject: rcvr) or: [objectMemory addressCouldBeObj: rcvr]).
  	self sendBreakpoint: selector receiver: rcvr.
  	argumentCount := numArgs.
  	classTag := objectMemory fetchClassTagOf: rcvr.
  	(self lookupInMethodCacheSel: selector classTag: classTag)
  		ifTrue:"check for coggability because method is in the cache"
  			[self
  				ifAppropriateCompileToNativeCode: newMethod
  				selector: selector]
  		ifFalse:
  			[messageSelector := selector.
  			 (errSelIdx := self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue:
  				[self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: (objectMemory classForClassTag: classTag).
  				"NOTREACHED"
  				self assert: false]].
  	instructionPointer := self popStack.
  	(self maybeMethodHasCogMethod: newMethod) ifTrue:
  		[self executeNewMethod.
  		 self assert: false
  		 "NOTREACHED"].
  	^self interpretMethodFromMachineCode
  	"NOTREACHED"!

Item was changed:
  ----- Method: CoInterpreter>>ceSendFromInLineCacheMiss: (in category 'trampolines') -----
  ceSendFromInLineCacheMiss: oPIC
  	"Send from an Open PIC when the first-level method lookup probe has failed,
  	 or to continue when PIC creation has failed (e.g. because we're out of code space)."
  	<api>
  	<var: #oPIC type: #'CogMethod *'>
  	| numArgs rcvr classTag errSelIdx |
  	"self printFrame: stackPage headFP WithSP: stackPage headSP"
  	"self printStringOf: selector"
  	numArgs := oPIC cmNumArgs.
  	rcvr := self stackValue: numArgs + 1. "skip return pc"
+ 	self assert: (objectMemory addressCouldBeOop: rcvr).
- 	self assert: ((objectMemory isIntegerObject: rcvr) or: [objectMemory addressCouldBeObj: rcvr]).
  	classTag := objectMemory fetchClassTagOf: rcvr.
  	argumentCount := numArgs.
  	(self lookupInMethodCacheSel: oPIC selector classTag: classTag)
  		ifTrue:"check for coggability because method is in the cache"
  			[self
  				ifAppropriateCompileToNativeCode: newMethod
  				selector: oPIC selector]
  		ifFalse:
  			[messageSelector := oPIC selector.
  			 (errSelIdx := self lookupMethodNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue:
  				[self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: (objectMemory classForClassTag: classTag).
  				"NOTREACHED"
  				self assert: false]].
  	instructionPointer := self popStack.
  	(self maybeMethodHasCogMethod: newMethod) ifTrue:
  		[self executeNewMethod.
  		 self assert: false
  		 "NOTREACHED"].
  	^self interpretMethodFromMachineCode
  	"NOTREACHED"!

Item was changed:
  ----- Method: CoInterpreter>>cogMethodOf: (in category 'compiled methods') -----
  cogMethodOf: aMethodOop
  	<api>
  	<returnTypeC: #'CogMethod *'>
  	| methodHeader |
  	methodHeader := self rawHeaderOf: aMethodOop.
+ 	self assert: ((objectMemory isNonImmediate: methodHeader)
- 	self assert: ((objectMemory isNonIntegerObject: methodHeader)
  				and: [methodHeader asUnsignedInteger < objectMemory startOfMemory]).
  	^self cCoerceSimple: methodHeader to: #'CogMethod *'!

Item was changed:
  ----- Method: CoInterpreter>>maybeMethodHasCogMethod: (in category 'compiled methods') -----
  maybeMethodHasCogMethod: anOop
+ 	^(objectMemory isNonImmediate: anOop)
- 	^(objectMemory isNonIntegerObject: anOop)
  	  and: [(objectMemory isCompiledMethod: anOop)
  	  and: [self isCogMethodReference: (self rawHeaderOf: anOop)]]!

Item was changed:
  ----- Method: CoInterpreter>>methodHasCogMethod: (in category 'compiled methods') -----
  methodHasCogMethod: aMethodOop
  	<api>
+ 	self assert: (objectMemory isNonImmediate: aMethodOop).
- 	self assert: (objectMemory isNonIntegerObject: aMethodOop).
  	^self isCogMethodReference: (self rawHeaderOf: aMethodOop)!

Item was changed:
  ----- Method: CoInterpreter>>startPCOfMethodHeader: (in category 'compiled methods') -----
  startPCOfMethodHeader: aCompiledMethodHeader
  	<api>
  	"Zero-relative version of CompiledMethod>>startpc."
+ 	^(self literalCountOfHeader: aCompiledMethodHeader) + LiteralStart * objectMemory bytesPerOop!
- 	^(self literalCountOfHeader: aCompiledMethodHeader) * BytesPerWord + BaseHeaderSize!

Item was changed:
  ----- Method: CoInterpreter>>startPCOrNilOfLiteral:in: (in category 'cog jit support') -----
  startPCOrNilOfLiteral: lit in: aMethodObj
  	"Answer the startPC of lit if it is a (clean) block in aMethodObj, oitherwise answer nil."
  	<api>
  	| outerContext |
+ 	(objectMemory isImmediate: lit) ifTrue:
- 	(objectMemory isIntegerObject: lit) ifTrue:
  		[^nil].
  	(objectMemory lastPointerOf: lit) <= ClosureCopiedValuesIndex ifTrue:
  		[^nil].
+ 	(objectMemory isArrayNonImm: lit) ifTrue:
- 	(objectMemory isArrayNonInt: lit) ifTrue:
  		[^nil].
  	outerContext := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: lit.
  	(objectMemory isContext: outerContext) ifFalse:
  		[^nil].
  	aMethodObj ~~ (objectMemory fetchPointer: MethodIndex ofObject: outerContext) ifTrue:
  		[^nil].
  	^self quickFetchInteger: ClosureStartPCIndex ofObject: lit!

Item was changed:
  ----- Method: CoInterpreter>>updateStackZoneReferencesToCompiledCodePreCompaction (in category 'code compaction') -----
  updateStackZoneReferencesToCompiledCodePreCompaction
  	<api>
  	<var: #thePage type: #'StackPage *'>
  	<var: #theFP type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	<var: #theIPPtr type: #'char *'>
  	<var: #theIP type: #usqInt>
  	<var: #theMethod type: #'CogMethod *'>
  	0 to: numStackPages - 1 do:
  		[:i| | thePage theFP callerFP theIPPtr theIP theMethodField theFlags theMethod |
  		thePage := stackPages stackPageAt: i.
  		(stackPages isFree: thePage) ifFalse:
  			[theIPPtr := thePage headSP.
  			 theFP := thePage  headFP.
  			 [(self isMachineCodeFrame: theFP) ifTrue:
  				[theMethodField := self frameMethodField: theFP.
  				 theFlags := theMethodField bitAnd: MFMethodFlagsMask.
  				 theMethod := self cCoerceSimple: theMethodField - theFlags to: #'CogMethod *'.
  				 theMethod cmType = CMBlock ifTrue:
  					[theMethod := (self cCoerceSimple: theMethodField - theFlags to: #'CogBlockMethod *') cmHomeMethod].
  				 theIP := (stackPages longAt: theIPPtr) asUnsignedInteger.
  				 (theIP ~= cogit ceCannotResumePC
  				  and: [self asserta: (theIP >= theMethod asUnsignedInteger
  							   and: [theIP < (theMethod asUnsignedInteger + theMethod blockSize)])]) ifTrue:
  					[stackPages
  						longAt: theIPPtr
+ 						put: theIP + theMethod objectHeader].
- 						put: theIP + theMethod objectHeader signedIntFromLong].
  				 stackPages
  					longAt: theFP + FoxMethod
+ 					put: theMethodField + theMethod objectHeader].
- 					put: theMethodField + theMethod objectHeader signedIntFromLong].
  			 (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
  				[theIPPtr := theFP + FoxCallerSavedIP.
  				 theFP := callerFP]]]!

Item was changed:
  ----- Method: CoInterpreterMT class>>initializeMiscConstants (in category 'initialization') -----
  initializeMiscConstants
  
  	super initializeMiscConstants.
+ 
+ 	(initializationOptions notNil
+ 	 and: [(initializationOptions at: #COGMTVM ifAbsent: [false]) == false]) ifTrue:
+ 		[^self].
+ 
  	COGMTVM := true.
  
  	ReturnToThreadSchedulingLoop := 2. "setjmp/longjmp code."
  
  	"N.B. some of these DisownFlags are replicated in platforms/Cross/vm/sqVirtualMachine.h"
  	DisownVMLockOutFullGC := 1.
  	DisownVMForProcessorRelinquish := 2!

Item was added:
+ ----- Method: CoInterpreterStackPagesSimulator>>pages (in category 'accessing') -----
+ pages
+ 	^pages!

Item was added:
+ ----- Method: CogBlockMethod class>>defaultObjectMemoryClass (in category 'accessing class hierarchy') -----
+ defaultObjectMemoryClass
+ 	^NewObjectMemory!

Item was changed:
  ----- Method: CogBlockMethod class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
  instVarNamesAndTypesForTranslationDo: aBinaryBlock
+ 	"enumerate aBinaryBlock with the names and C type strings for the
+ 	 inst vars to include in a CogMethod or CogBlockMethod struct."
- 	"enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a CogMethod or CogBlockMethod struct."
  
  	self allInstVarNames do:
  		[:ivn|
  		"Notionally objectHeader is in a union with homeOffset and startpc but
  		 we don't have any convenient support for unions.  So hack, hack, hack, hack."
  		((self == CogBlockMethod
  			ifTrue: [#('objectHeader')]
  			ifFalse: [#('homeOffset' 'startpc' 'padToWord')]) includes: ivn) ifFalse:
  				[aBinaryBlock
  					value: ivn
  					value: (ivn caseOf: {
+ 								['objectHeader']			-> [self objectMemoryClass baseHeaderSize = 8
+ 																ifTrue: [#sqLong]
+ 																ifFalse: [#sqInt]].
  								['cmNumArgs']				-> [#(unsigned ' : 8')]. "SqueakV3 needs only 5 bits"
  								['cmType']					-> [#(unsigned ' : 3')].
  								['cmRefersToYoung']		-> [#(unsigned #Boolean ' : 1')].
  								['cpicHasMNUCase']		-> [#(unsigned #Boolean ' : 1')].
  								['cmUsageCount']			-> [#(unsigned ' : 3')]. "see CMMaxUsageCount in initialize"
  								['cmUsesPenultimateLit']	-> [#(unsigned #Boolean ' : 1')].
  								['cmUnusedFlags']			-> [#(unsigned ' : 3')].
  								['stackCheckOffset']		-> [#(unsigned ' : 12')]. "See MaxStackCheckOffset in initialize. a.k.a. cPICNumCases"
  								['blockSize']				-> [#'unsigned short']. "See MaxMethodSize in initialize"
  								['blockEntryOffset']			-> [#'unsigned short'].
  								['homeOffset']				-> [#'unsigned short'].
  								['startpc']					-> [#'unsigned short'].
+ 								['padToWord']				-> [#(#BaseHeaderSize 8 'unsigned int')].
- 								['padToWord']				-> [#(#BytesPerWord 8 'unsigned int')].
  								['nextMethod']				-> ['struct _CogMethod *']} "see NewspeakCogMethod"
  							otherwise:
  								[#sqInt])]]!

Item was added:
+ ----- Method: CogBlockMethod class>>offsetForInstVar: (in category 'code generation') -----
+ offsetForInstVar: instVarName
+ 	"Hack to offset accesses to variables by certain values.  The inst vars following
+ 	 the objectHeader must be offset by the baseHeaderSize."
+ 	^(#('objectHeader' 'homeOffset' 'startpc' 'padToWord') includes: instVarName) ifFalse:
+ 		['baseHeaderSize']!

Item was changed:
  ----- Method: CogBlockMethodSurrogate32 class>>alignedByteSize (in category 'accessing') -----
  alignedByteSize
+ 	^4 + self baseHeaderSize!
- 	^8!

Item was changed:
  ----- Method: CogBlockMethodSurrogate32>>cmNumArgs (in category 'accessing') -----
  cmNumArgs
+ 	^memory unsignedByteAt: address + 1 + baseHeaderSize!
- 	^memory unsignedByteAt: address + 5!

Item was changed:
  ----- Method: CogBlockMethodSurrogate32>>cmNumArgs: (in category 'accessing') -----
  cmNumArgs: aValue
  	^memory
+ 		unsignedByteAt: address + baseHeaderSize + 1
- 		unsignedByteAt: address + 5
  		put: aValue!

Item was changed:
  ----- Method: CogBlockMethodSurrogate32>>cmRefersToYoung (in category 'accessing') -----
  cmRefersToYoung
+ 	^(((memory unsignedByteAt: address + 2 + baseHeaderSize) bitShift: -3) bitAnd: 16r1) ~= 0!
- 	^(((memory unsignedByteAt: address + 6) bitShift: -3) bitAnd: 16r1) ~= 0!

Item was changed:
  ----- Method: CogBlockMethodSurrogate32>>cmRefersToYoung: (in category 'accessing') -----
  cmRefersToYoung: aValue
  	memory
+ 		unsignedByteAt: address + baseHeaderSize + 2
+ 		put: (((memory unsignedByteAt: address + baseHeaderSize + 2) bitAnd: 16rF7) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 3)).
- 		unsignedByteAt: address + 6
- 		put: (((memory unsignedByteAt: address + 6) bitAnd: 16rF7) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 3)).
  	^aValue!

Item was changed:
  ----- Method: CogBlockMethodSurrogate32>>cmType (in category 'accessing') -----
  cmType
+ 	^(memory unsignedByteAt: address + 2 + baseHeaderSize) bitAnd: 16r7!
- 	^(memory unsignedByteAt: address + 6) bitAnd: 16r7!

Item was changed:
  ----- Method: CogBlockMethodSurrogate32>>cmType: (in category 'accessing') -----
  cmType: aValue
  	self assert: (aValue between: 0 and: 16r7).
  	memory
+ 		unsignedByteAt: address + baseHeaderSize + 2
+ 		put: ((memory unsignedByteAt: address + baseHeaderSize + 2) bitAnd: 16rF8) + aValue.
- 		unsignedByteAt: address + 6
- 		put: ((memory unsignedByteAt: address + 6) bitAnd: 16rF8) + aValue.
  	^aValue!

Item was changed:
  ----- Method: CogBlockMethodSurrogate32>>cmUsageCount (in category 'accessing') -----
  cmUsageCount
+ 	^((memory unsignedByteAt: address + 2 + baseHeaderSize) bitShift: -5) bitAnd: 16r7!
- 	^((memory unsignedByteAt: address + 6) bitShift: -5) bitAnd: 16r7!

Item was changed:
  ----- Method: CogBlockMethodSurrogate32>>cmUsageCount: (in category 'accessing') -----
  cmUsageCount: aValue
  	self assert: (aValue between: 0 and: 16r7).
  	memory
+ 		unsignedByteAt: address + baseHeaderSize + 2
+ 		put: ((memory unsignedByteAt: address + baseHeaderSize + 2) bitAnd: 16r1F) + (aValue bitShift: 5).
- 		unsignedByteAt: address + 6
- 		put: ((memory unsignedByteAt: address + 6) bitAnd: 16r1F) + (aValue bitShift: 5).
  	^aValue!

Item was changed:
  ----- Method: CogBlockMethodSurrogate32>>cmUsesPenultimateLit (in category 'accessing') -----
  cmUsesPenultimateLit
+ 	^((memory unsignedByteAt: address + 3 + baseHeaderSize) bitAnd: 16r1) ~= 0!
- 	^((memory unsignedByteAt: address + 7) bitAnd: 16r1) ~= 0!

Item was changed:
  ----- Method: CogBlockMethodSurrogate32>>cmUsesPenultimateLit: (in category 'accessing') -----
  cmUsesPenultimateLit: aValue
  	memory
+ 		unsignedByteAt: address + baseHeaderSize + 3
+ 		put: (((memory unsignedByteAt: address + baseHeaderSize + 3) bitAnd: 16rFE) + (aValue ifTrue: [1] ifFalse: [0])).
- 		unsignedByteAt: address + 7
- 		put: (((memory unsignedByteAt: address + 7) bitAnd: 16rFE) + (aValue ifTrue: [1] ifFalse: [0])).
  	^aValue!

Item was changed:
  ----- Method: CogBlockMethodSurrogate32>>cpicHasMNUCase (in category 'accessing') -----
  cpicHasMNUCase
+ 	^(((memory unsignedByteAt: address + 2 + baseHeaderSize) bitShift: -4) bitAnd: 16r1) ~= 0!
- 	^(((memory unsignedByteAt: address + 6) bitShift: -4) bitAnd: 16r1) ~= 0!

Item was changed:
  ----- Method: CogBlockMethodSurrogate32>>cpicHasMNUCase: (in category 'accessing') -----
  cpicHasMNUCase: aValue
  	memory
+ 		unsignedByteAt: address + baseHeaderSize + 2
+ 		put: (((memory unsignedByteAt: address + baseHeaderSize + 2) bitAnd: 16rEF) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 4)).
- 		unsignedByteAt: address + 6
- 		put: (((memory unsignedByteAt: address + 6) bitAnd: 16rEF) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 4)).
  	^aValue!

Item was added:
+ ----- Method: CogBlockMethodSurrogate32>>padToWord (in category 'accessing') -----
+ padToWord
+ 	^memory unsignedLongAt: address + 5!

Item was added:
+ ----- Method: CogBlockMethodSurrogate32>>padToWord: (in category 'accessing') -----
+ padToWord: aValue
+ 	^memory
+ 		unsignedLongAt: address + 5
+ 		put: aValue!

Item was changed:
  ----- Method: CogBlockMethodSurrogate32>>stackCheckOffset (in category 'accessing') -----
  stackCheckOffset
+ 	^((memory unsignedShortAt: address + 3 + baseHeaderSize) bitShift: -4) bitAnd: 16rFFF!
- 	^((memory unsignedShortAt: address + 7) bitShift: -4) bitAnd: 16rFFF!

Item was changed:
  ----- Method: CogBlockMethodSurrogate32>>stackCheckOffset: (in category 'accessing') -----
  stackCheckOffset: aValue
  	self assert: (aValue between: 0 and: 16rFFF).
  	memory
+ 		unsignedShortAt: address + baseHeaderSize + 3
+ 		put: ((memory unsignedShortAt: address + baseHeaderSize + 3) bitAnd: 16rF) + (aValue bitShift: 4).
- 		unsignedShortAt: address + 7
- 		put: ((memory unsignedShortAt: address + 7) bitAnd: 16rF) + (aValue bitShift: 4).
  	^aValue!

Item was removed:
- ----- Method: CogBlockMethodSurrogate64>>padToWord (in category 'accessing') -----
- padToWord
- 	^memory unsignedLongAt: address + 5!

Item was removed:
- ----- Method: CogBlockMethodSurrogate64>>padToWord: (in category 'accessing') -----
- padToWord: aValue
- 	^memory
- 		unsignedLongAt: address + 5
- 		put: aValue!

Item was changed:
+ VMClass subclass: #CogMethodSurrogate
+ 	instanceVariableNames: 'address memory baseHeaderSize cogit'
- Object subclass: #CogMethodSurrogate
- 	instanceVariableNames: 'address memory cogit'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-JITSimulation'!

Item was added:
+ ----- Method: CogMethodSurrogate class>>baseHeaderSize (in category 'accessing') -----
+ baseHeaderSize
+ 	^self objectMemoryClass baseHeaderSize!

Item was added:
+ ----- Method: CogMethodSurrogate class>>defaultObjectMemoryClass (in category 'accessing class hierarchy') -----
+ defaultObjectMemoryClass
+ 	^NewCoObjectMemory!

Item was removed:
- ----- Method: CogMethodSurrogate>>at:memory:cogit: (in category 'instance initialization') -----
- at: anAddress memory: aBitmap cogit: aCogit
- 	address := anAddress.
- 	memory := aBitmap.
- 	cogit := aCogit!

Item was added:
+ ----- Method: CogMethodSurrogate>>at:objectMemory:cogit: (in category 'instance initialization') -----
+ at: anAddress objectMemory: objectMemory cogit: aCogit
+ 	address := anAddress.
+ 	memory := objectMemory memory.
+ 	baseHeaderSize := objectMemory baseHeaderSize.
+ 	cogit := aCogit!

Item was added:
+ ----- Method: CogMethodSurrogate>>objectHeader (in category 'accessing') -----
+ objectHeader
+ 	^baseHeaderSize = 8
+ 		ifTrue: [memory longLongAt: address + 1]
+ 		ifFalse: [memory longAt: address + 1]!

Item was added:
+ ----- Method: CogMethodSurrogate>>objectHeader: (in category 'accessing') -----
+ objectHeader: aValue
+ 	^baseHeaderSize = 8
+ 		ifTrue: [memory longLongAt: address + 1 put: aValue]
+ 		ifFalse: [memory longAt: address + 1 put: aValue]!

Item was changed:
  ----- Method: CogMethodSurrogate32 class>>alignedByteSize (in category 'accessing') -----
  alignedByteSize
+ 	^20 + self baseHeaderSize!
- 	^24!

Item was changed:
  ----- Method: CogMethodSurrogate32>>blockEntryOffset (in category 'accessing') -----
  blockEntryOffset
+ 	^memory unsignedShortAt: address + 7 + baseHeaderSize!
- 	^memory unsignedShortAt: address + 11!

Item was changed:
  ----- Method: CogMethodSurrogate32>>blockEntryOffset: (in category 'accessing') -----
  blockEntryOffset: aValue
  	^memory
+ 		unsignedShortAt: address + baseHeaderSize + 7
- 		unsignedShortAt: address + 11
  		put: aValue!

Item was changed:
  ----- Method: CogMethodSurrogate32>>blockSize (in category 'accessing') -----
  blockSize
+ 	^memory unsignedShortAt: address + 5 + baseHeaderSize!
- 	^memory unsignedShortAt: address + 9!

Item was changed:
  ----- Method: CogMethodSurrogate32>>blockSize: (in category 'accessing') -----
  blockSize: aValue
  	^memory
+ 		unsignedShortAt: address + baseHeaderSize + 5
- 		unsignedShortAt: address + 9
  		put: aValue!

Item was changed:
  ----- Method: CogMethodSurrogate32>>methodHeader (in category 'accessing') -----
  methodHeader
+ 	^memory unsignedLongAt: address + 13 + baseHeaderSize!
- 	^memory unsignedLongAt: address + 17!

Item was changed:
  ----- Method: CogMethodSurrogate32>>methodHeader: (in category 'accessing') -----
  methodHeader: aValue
  	^memory
+ 		unsignedLongAt: address + baseHeaderSize + 13
- 		unsignedLongAt: address + 17
  		put: aValue!

Item was changed:
  ----- Method: CogMethodSurrogate32>>methodObject (in category 'accessing') -----
  methodObject
+ 	^memory unsignedLongAt: address + 9 + baseHeaderSize!
- 	^memory unsignedLongAt: address + 13!

Item was changed:
  ----- Method: CogMethodSurrogate32>>methodObject: (in category 'accessing') -----
  methodObject: aValue
  	^memory
+ 		unsignedLongAt: address + baseHeaderSize + 9
- 		unsignedLongAt: address + 13
  		put: aValue!

Item was removed:
- ----- Method: CogMethodSurrogate32>>objectHeader (in category 'accessing') -----
- objectHeader
- 	^memory unsignedLongAt: address + 1!

Item was changed:
  ----- Method: CogMethodSurrogate32>>selector (in category 'accessing') -----
  selector
+ 	^memory unsignedLongAt: address + 17 + baseHeaderSize!
- 	^memory unsignedLongAt: address + 21!

Item was changed:
  ----- Method: CogMethodSurrogate32>>selector: (in category 'accessing') -----
  selector: aValue
  	^memory
+ 		unsignedLongAt: address + baseHeaderSize + 17
- 		unsignedLongAt: address + 21
  		put: aValue!

Item was removed:
- ----- Method: CogMethodSurrogate64>>objectHeader (in category 'accessing') -----
- objectHeader
- 	^memory unsignedLongLongAt: address + 1!

Item was changed:
  ----- Method: CogMethodZone>>planCompaction (in category 'compaction') -----
  planCompaction
  	"Some metods have been freed.  Compute how much each survivor needs to
  	 move during the ensuing compaction and record it in the objectHeader field."
  	| delta cogMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	delta := 0.
  	cogMethod := coInterpreter cCoerceSimple: baseAddress to: #'CogMethod *'.
  	[cogMethod asUnsignedInteger < mzFreeStart] whileTrue:
  		[cogMethod cmType = CMFree
  			ifTrue: [delta := delta - cogMethod blockSize]
  			ifFalse:
  				[self assert: (cogit cogMethodDoesntLookKosher: cogMethod) = 0.
+ 				 cogMethod objectHeader: delta].
- 				 cogMethod objectHeader: delta signedIntToLong].
  		 cogMethod := self methodAfter: cogMethod]!

Item was changed:
  ----- Method: CogMethodZone>>relocateAndPruneYoungReferrers (in category 'young referers') -----
  relocateAndPruneYoungReferrers
  	| source dest next cogMethod |
  	<var: #source type: #usqInt>
  	<var: #dest type: #usqInt>
  	<var: #next type: #usqInt>
  	<var: #cogMethod type: #'CogMethod *'>
  	<inline: false>
  
  	self assert: youngReferrers <= limitAddress.
  	youngReferrers = limitAddress ifTrue:
  		[^nil].
  	dest := limitAddress.
  	[next := dest - BytesPerWord.
  	 next >= youngReferrers
  	 and: [(cogMethod := coInterpreter cCoerceSimple: (objectMemory longAt: next) to: #'CogMethod *') cmType ~= CMFree
  	 and: [cogMethod cmRefersToYoung]]] whileTrue:
  		[cogMethod objectHeader ~= 0 ifTrue:
+ 			[coInterpreter longAt: next put: cogMethod asInteger + cogMethod objectHeader].
- 			[coInterpreter longAt: next put: cogMethod asInteger + cogMethod objectHeader signedIntFromLong].
  		 dest := next].
  	self assert: dest >= youngReferrers.
  	source := dest - BytesPerWord.
  	[source >= youngReferrers] whileTrue:
  		[cogMethod := coInterpreter cCoerceSimple: (objectMemory longAt: source) to: #'CogMethod *'.
  		 (cogMethod cmType ~= CMFree
  		  and: [cogMethod cmRefersToYoung]) ifTrue:
  			[self assert: source < (dest - BytesPerWord).
  			 cogMethod objectHeader ~= 0 ifTrue:
+ 				[cogMethod := coInterpreter cCoerceSimple: cogMethod asInteger + cogMethod objectHeader
- 				[cogMethod := coInterpreter cCoerceSimple: cogMethod asInteger + cogMethod objectHeader signedIntFromLong
  									to: #'CogMethod *'].
  			 objectMemory longAt: (dest := dest - BytesPerWord) put: cogMethod asInteger].
  		 source := source - BytesPerWord].
  	youngReferrers := dest.
  	"this assert must be deferred until after compaction.  See the end of compactCogCompiledCode"
  	"self assert: self kosherYoungReferrers"!

Item was removed:
- VMStructType subclass: #CogObjectHeader
- 	instanceVariableNames: 'classIndex unused0 isPinned isImmutable format isMarked isGrey isRemembered objHash slotSize'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'VMMaker-SpurMemoryManager'!

Item was removed:
- ----- Method: CogObjectHeader class>>initialize (in category 'class initialization') -----
- initialize
- 	(Smalltalk classNamed: #CogObjectHeaderSurrogate) ifNotNil:
- 		[:cohs|
- 		self checkGenerateSurrogate: cohs bytesPerWord: 4].
- 
- 	"CogObjectHeader initialize"!

Item was removed:
- ----- Method: CogObjectHeader class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') -----
- instVarNamesAndTypesForTranslationDo: aBinaryBlock
- 	"enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a BytecodeDescriptor struct."
- 	"self typedef"
- 
- 	self instVarNames do:
- 		[:ivn|
- 		aBinaryBlock
- 			value: ivn
- 			value: (ivn caseOf: {
- 							['classIndex']	->	[#'unsigned short']. "for speed; can extend to 22 bits by absorbing unused0"
- 							['unused0']		->	[#(unsigned ' : 6')].
- 							['format']		->	[#(unsigned ' : 5')].
- 							['objHash']		->	[#(unsigned ' : 24')].
- 							['slotSize']		->	[#'unsigned char'] }
- 						otherwise: [#(#unsigned #Boolean ' : 1')])]!

Item was removed:
- ----- Method: CogObjectHeader>>isForwarded (in category 'accessing') -----
- isForwarded
- 	^self classIndex = 0!

Item was removed:
- ----- Method: CogObjectHeader>>setIsForwarded (in category 'accessing') -----
- setIsForwarded
- 	self classIndex: 0!

Item was added:
+ CogObjectRepresentationForSpur subclass: #CogObjectRepresentationFor32BitSpur
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-JIT'!

Item was added:
+ ----- Method: CogObjectRepresentationFor32BitSpur>>genGetClassTagOf:into:scratchReg: (in category 'compile abstract instructions') -----
+ genGetClassTagOf: instReg into: destReg scratchReg: scratchReg
+ 	^self getInlineCacheClassTagFrom: instReg into: destReg!

Item was added:
+ ----- Method: CogObjectRepresentationFor32BitSpur>>genJumpNotSmallIntegerInScratchReg: (in category 'compile abstract instructions') -----
+ genJumpNotSmallIntegerInScratchReg: aRegister
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	cogit AndCq: 1 R: aRegister.
+ 	^cogit JumpZero: 0!

Item was added:
+ ----- Method: CogObjectRepresentationFor32BitSpur>>genJumpSmallIntegerInScratchReg: (in category 'compile abstract instructions') -----
+ genJumpSmallIntegerInScratchReg: aRegister
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	cogit AndCq: 1 R: aRegister.
+ 	^cogit JumpNonZero: 0!

Item was added:
+ ----- Method: CogObjectRepresentationFor32BitSpur>>getInlineCacheClassTagFrom:into: (in category 'compile abstract instructions') -----
+ getInlineCacheClassTagFrom: sourceReg into: destReg
+ 	"Extract the inline cache tag for the object in sourceReg into destReg. The inline
+ 	 cache tag for a given object is the value loaded in inline caches to distinguish objects
+ 	 of different classes.  In Spur this is either the tags for immediates, (with 1 & 3 collapsed
+ 	 to 1 for SmallIntegers), or the receiver's classIndex.  Generate something like this:
+ 		Limm:
+ 			andl $0x1, rDest
+ 			j Lcmp
+ 		Lentry:
+ 			movl rSource, rDest
+ 			andl $0x3, rDest
+ 			jnz Limm
+ 			movl 0x4(%edx), rDest
+ 			andl $0x3fffff, rDest
+ 		Lcmp
+ 	"
+ 	| immLabel entryLabel jumpCompare |
+ 	<var: #immLabel type: #'AbstractInstruction *'>
+ 	<var: #entryLabel type: #'AbstractInstruction *'>
+ 	<var: #jumpCompare type: #'AbstractInstruction *'>
+ 	cogit AlignmentNops: BytesPerWord.
+ 	immLabel := cogit Label.
+ 	cogit AndCq: 1 R: destReg.
+ 	jumpCompare := cogit Jump: 0.
+ 	cogit AlignmentNops: BytesPerWord.
+ 	entryLabel := cogit Label.
+ 	cogit MoveR: sourceReg R: destReg.
+ 	cogit AndCq: objectMemory tagMask R: destReg.
+ 	cogit JumpNonZero: immLabel.
+ 	self flag: #endianness.
+ 	"Get least significant half of header word in destReg"
+ 	cogit MoveMw: 0 r: sourceReg R: destReg.
+ 	cogit AndCq: objectMemory classIndexMask R: destReg.
+ 	jumpCompare jmpTarget: cogit Label.
+ 	^entryLabel!

Item was added:
+ CogObjectRepresentationForSpur subclass: #CogObjectRepresentationFor64BitSpur
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-JIT'!

Item was added:
+ CogObjectRepresentation subclass: #CogObjectRepresentationForSpur
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-JIT'!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genLoadSlot:sourceReg:destReg: (in category 'compile abstract instructions') -----
+ genLoadSlot: index sourceReg: sourceReg destReg: destReg
+ 	cogit
+ 		MoveMw: index * objectMemory wordSize + objectMemory baseHeaderSize
+ 		r: sourceReg
+ 		R: destReg.
+ 	^0!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genStoreCheckTrampoline (in category 'initialization') -----
+ genStoreCheckTrampoline
+ 	"Call ceStoreCheck: with the object stored into"
+ 	^cogit
+ 		genTrampolineFor: #ceStoreCheck:
+ 		called: 'ceStoreCheckTrampoline'
+ 		arg: ReceiverResultReg
+ 		result: cogit returnRegForStoreCheck!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>getInlineCacheClassTagFrom:into: (in category 'compile abstract instructions') -----
+ getInlineCacheClassTagFrom: sourceReg into: destReg
+ 	"Extract the inline cache tag for the object in sourceReg into destReg. The inline cache tag
+ 	 for a given object is the value loaded in inline caches to distinguish objects of different
+ 	 classes.  In Spur this is either the tags for immediates, or the receiver's classIndex."
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>isSmallIntegerTagNonZero (in category 'object representation') -----
+ isSmallIntegerTagNonZero
+ 	^true!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>shouldAnnotateObjectReference: (in category 'garbage collection') -----
+ shouldAnnotateObjectReference: anOop
+ 	"Objects in newSpace or oldSPace except nil, true & false need to be annotated."
+ 	^(objectMemory isNonImmediate: anOop)
+ 	  and: [(self oop: anOop isGreaterThan: objectMemory trueObject)
+ 		or: [self oop: anOop isLessThan: objectMemory nilObject]]!

Item was changed:
  ----- Method: CogObjectRepresentationForSqueakV3>>genGetClassTagOf:into:scratchReg: (in category 'compile abstract instructions') -----
  genGetClassTagOf: instReg into: destReg scratchReg: scratchReg
+ 	"Compatibility with SpurObjectRepresentation/SpurMemoryManager."
+ 	| entryLabel |
+ 	<var: #entryLabel type: #'AbstractInstruction *'>
+ 	cogit AlignmentNops: (BytesPerWord max: 8).
+ 	entryLabel := cogit Label.
+ 	self genGetClassObjectOf: instReg into: destReg scratchReg: scratchReg.
+ 	^entryLabel!
- 	"Compatibility with SpurObjectRepresentation/purMemorymanager."
- 	^self genGetClassObjectOf: instReg into: destReg scratchReg: scratchReg!

Item was changed:
  ----- Method: CogObjectRepresentationForSqueakV3>>genStoreCheckTrampoline (in category 'initialization') -----
  genStoreCheckTrampoline
+ 	"Call ceStoreCheck: with the object stored into"
- 	"Call noteAsRoot: with the object stored into"
  	^cogit
  		genTrampolineFor: #ceStoreCheck:
  		called: 'ceStoreCheckTrampoline'
  		arg: ReceiverResultReg
  		result: cogit returnRegForStoreCheck!

Item was changed:
  ----- Method: CogObjectRepresentationForSqueakV3>>getInlineCacheClassTagFrom:into: (in category 'compile abstract instructions') -----
  getInlineCacheClassTagFrom: sourceReg into: destReg
  	"Extract the inline cache tag for the object in sourceReg into destReg. The inline
  	 cache tag for a given object is the value loaded in inline caches to distinguish objects
  	 of different classes.  In SqueakV3 the tag is the integer tag bit for SmallIntegers (1),
  	 the compact class index shifted by log: 2 word size for objects with compact classes
  	 (1 * 4 to: 31 * 4 by: 4), or the class.  These ranges cannot overlap because the heap
  	 (and hence the lowest class object) is beyond the machine code zone."
+ 	| entryLabel jumpIsInt jumpCompact |
+ 	<var: #entryLabel type: #'AbstractInstruction *'>
- 	| jumpIsInt jumpCompact |
  	<var: #jumpIsInt type: #'AbstractInstruction *'>
  	<var: #jumpCompact type: #'AbstractInstruction *'>
+ 	cogit AlignmentNops: (BytesPerWord max: 8).
+ 	entryLabel := cogit Label.
  	cogit MoveR: sourceReg R: destReg.
  	cogit AndCq: 1 R: destReg.
  	jumpIsInt := cogit JumpNonZero: 0.
  	"Get header word in destReg"
  	cogit MoveMw: 0 r: sourceReg R: destReg.
  	"Form the byte index of the compact class field"
  	cogit LogicalShiftRightCq: (objectMemory compactClassFieldLSB - ShiftForWord) R: destReg.
  	cogit AndCq: self compactClassFieldMask << ShiftForWord R: destReg.
  	jumpCompact := cogit JumpNonZero: 0.
  	cogit MoveMw: objectMemory classFieldOffset r: sourceReg R: destReg.
  	"The use of signedIntFromLong is a hack to get round short addressing mode computations.
  	 Much easier if offsets are signed and the arithmetic machinery we have makes it difficult to
  	 mix signed and unsigned offsets."
  	cogit AndCq: AllButTypeMask signedIntFromLong R: destReg.
  	jumpCompact jmpTarget: (jumpIsInt jmpTarget: cogit Label).
+ 	^entryLabel!
- 	^0!

Item was changed:
  ----- Method: CogVMSimulator class>>initializeWithOptions:objectMemoryClass: (in category 'class initialization') -----
  initializeWithOptions: optionsDictionaryOrArray objectMemoryClass: objectMemoryClassOrNil
  	"The relevant ObjectMemory, Interpreter and Cogit classes must be initialized in order.
  	 This happens notionally every time we start the simulator,
  	 but in fact happens when ever we instantiate a simulator."
+ 	| cogitClassOrName |
+ 	initializationOptions := optionsDictionaryOrArray isArray
- 	| optionsDictionary cogitClassOrName |
- 	optionsDictionary := optionsDictionaryOrArray isArray
  							ifTrue: [Dictionary newFromPairs: optionsDictionaryOrArray]
  							ifFalse: [optionsDictionaryOrArray].
  	(objectMemoryClassOrNil ifNil: [self objectMemoryClass])
+ 		initializeWithOptions: initializationOptions.
- 		initializeWithOptions: optionsDictionary.
  
+ 	((initializationOptions at: #COGMTVM ifAbsent: [false])
- 	((optionsDictionary at: #COGMTVM ifAbsent: [false])
  			ifTrue: [CoInterpreterMT]
  			ifFalse: [CoInterpreter])
+ 		initializeWithOptions: initializationOptions.
- 		initializeWithOptions: optionsDictionary.
  
+ 	(initializationOptions includesKey: #Cogit) ifTrue:
+ 		[cogitClassOrName := initializationOptions at: #Cogit.
- 	(optionsDictionary includesKey: #Cogit) ifTrue:
- 		[cogitClassOrName := optionsDictionary at: #Cogit.
  		 cogitClassOrName isSymbol ifTrue:
  			[cogitClassOrName := Smalltalk classNamed: cogitClassOrName].
  		CoInterpreter classPool at: #CogitClass put: cogitClassOrName].
  
  	(self cogitClass withAllSuperclasses copyUpTo: Cogit) reverseDo:
+ 		[:c| c initializeWithOptions: initializationOptions]!
- 		[:c| c initializeWithOptions: optionsDictionary]!

Item was changed:
  ----- Method: CogVMSimulator class>>onObjectMemory:cogit:options: (in category 'instance creation') -----
  onObjectMemory: anObjectMemory cogit: aCogit options: optionsDictionaryOrArray
  	^self == CogVMSimulator
  		ifTrue:
  			[self initializeWithOptions: optionsDictionaryOrArray
  				objectMemoryClass: (anObjectMemory ifNotNil: [anObjectMemory class]).
  			 SmalltalkImage current endianness == #big
  				ifTrue: [self notYetImplemented]
  				ifFalse: [CogVMSimulatorLSB onObjectMemory: anObjectMemory cogit: aCogit options: optionsDictionaryOrArray]]
  		ifFalse:
  			[| sim |
+ 			self initializeWithOptions: optionsDictionaryOrArray.
  			sim := self basicNew.
  			sim objectMemory: anObjectMemory.
  			sim cogit: aCogit.
  			sim initialize.
  			COGMTVM ifTrue: "Set via options"
  				[sim initializeThreadSupport; initialize].
  			sim]!

Item was changed:
  ----- Method: CogVMSimulator>>checkStackIntegrity (in category 'object memory support') -----
  checkStackIntegrity
  	"Override to deal with incomplete initialization."
  	stackPages ifNil: [^true].
+ 	stackPages pages ifNil: [^true].
  	^super checkStackIntegrity!

Item was added:
+ ----- Method: CogVMSimulator>>imageName: (in category 'spur bootstrap') -----
+ imageName: aString
+ 	imageName := aString!

Item was added:
+ ----- Method: CogVMSimulator>>printHexnp: (in category 'debug printing') -----
+ printHexnp: anInteger
+ 
+ 	traceOn ifTrue:
+ 		[transcript nextPutAll: (anInteger storeStringBase: 16)]!

Item was changed:
  ----- Method: CogVMSimulator>>rumpCStackAddress (in category 'rump c stack') -----
  rumpCStackAddress
+ 	| alignment alignedHeapBase |
+ 	alignment := 64. "byte alignment for stack frames; IA32 requires 16 bytes."
+ 	alignedHeapBase := heapBase bitAnd: alignment negated.
+ 	^alignedHeapBase = heapBase
+ 		ifTrue: [heapBase - alignment]
+ 		ifFalse: [alignedHeapBase]!
- 	^heapBase - BytesPerWord!

Item was changed:
  ----- Method: CogVMSimulator>>shortPrint: (in category 'debug support') -----
  shortPrint: oop
  	| name classOop |
+ 	(objectMemory isImmediate: oop) ifTrue:
+ 		[(objectMemory isImmediateCharacter: oop) ifTrue:
+ 			[^ '=$' , (objectMemory characterValueOf: oop) printString , 
+ 			' (' , (String with: (Character value: (objectMemory characterValueOf: oop))) , ')'].
+ 		(objectMemory isIntegerObject: oop) ifTrue:
+ 			[^ '=' , (objectMemory integerValueOf: oop) printString , 
+ 			' (' , (objectMemory integerValueOf: oop) hex , ')'].
+ 		^'= UNKNOWN IMMEDIATE', ' (' , (objectMemory integerValueOf: oop) hex , ')'].
+ 	(objectMemory addressCouldBeObj: oop) ifFalse:
+ 		[^(oop bitAnd: objectMemory allocationUnit - 1) ~= 0
+ 			ifTrue: [' is misaligned']
+ 			ifFalse: [' is not on the heap']].
+ 	(objectMemory isFreeObject: oop) ifTrue:
+ 		[^' is a free chunk of size ', (objectMemory sizeOfFree: oop) printString].
+ 	(objectMemory isForwarded: oop) ifTrue:
+ 		[^' is a forwarded object to ', (objectMemory followForwarded: oop) hex,
+ 			' of slot size ', (objectMemory numSlotsOfAny: oop) printString].
+ 	classOop := objectMemory fetchClassOfNonImm: oop.
+ 	(objectMemory sizeBitsOf: classOop) = metaclassSizeBits ifTrue:
+ 		[^'class ' , (self nameOfClass: oop)].
- 	(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: (BytesPerWord - 1)) ~= 0 ifTrue:
- 		[^' is misaligned'].
- 	classOop := objectMemory fetchClassOf: oop.
- 	(objectMemory sizeBitsOf: classOop) = metaclassSizeBits 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: "SpurMemoryManager has immediate Characters; ObjectMemory does not"
+ 		[^ '=' , (Character value: (objectMemory integerValueOf: 
- 	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 + BaseHeaderSize)) ,
+ 		' -> ' ,
+ 		(self longAt: oop + BaseHeaderSize + BytesPerWord) hex8 , ')'].
+ 	^('AEIOU' includes: name first)
+ 		ifTrue: ['an ' , name]
+ 		ifFalse: ['a ' , name]!
- 	name = 'Association' ifTrue: [^ '(' ,
- 				(self shortPrint: (self longAt: oop + BaseHeaderSize)) ,
- 				' -> ' ,
- 				(self longAt: oop + BaseHeaderSize + BytesPerWord) hex8 , ')'].
- 	('AEIOU' includes: name first)
- 		ifTrue: [^ 'an ' , name]
- 		ifFalse: [^ 'a ' , name]!

Item was changed:
  ----- Method: Cogit class>>initializeWithOptions: (in category 'class initialization') -----
  initializeWithOptions: optionsDictionary
+ 	CogMethodSurrogate withAllSubclassesDo:
+ 		[:cmsClass|
+ 		cmsClass initializationOptions: optionsDictionary].
- 
  	super initializeWithOptions: optionsDictionary.
  	self initializeMiscConstants. "must preceed other initialization."
  	self initializeErrorCodes.
  	self initializeCogMethodConstants.
  	self initializeAnnotationConstants.
  	self initializeBytecodeTable.
  	self initializePrimitiveTable!

Item was changed:
  ----- Method: Cogit>>cogBlockMethodSurrogateAt: (in category 'simulation only') -----
  cogBlockMethodSurrogateAt: address
  	<doNotGenerate>
  	self assert: (address bitAnd: BytesPerWord - 1) = 0.
  	^cogBlockMethodSurrogateClass new
  		at: address
+ 		objectMemory: objectMemory
- 		memory: objectMemory memory
  		cogit: self!

Item was changed:
  ----- Method: Cogit>>cogMethodDoesntLookKosher: (in category 'debugging') -----
  cogMethodDoesntLookKosher: cogMethod
  	"Check that the header fields onf a non-free method are consistent with
  	 the type. Answer 0 if it is ok, otherwise answer a code for the error."
  	<api>
  	<inline: false>
  	<var: #cogMethod type: #'CogMethod *'>
  	((cogMethod blockSize bitAnd: BytesPerWord - 1) ~= 0
  	 or: [cogMethod blockSize < (self sizeof: CogMethod)
  	 or: [cogMethod blockSize >= 32768]]) ifTrue:
  		[^1].
  
  	cogMethod cmType = CMFree ifTrue: [^2].
  
  	cogMethod cmType = CMMethod ifTrue:
  		[(objectMemory isIntegerObject: cogMethod methodHeader) ifFalse:
  			[^11].
  		 (objectRepresentation couldBeObject: cogMethod methodObject) ifFalse:
  			[^12].
  		 (cogMethod stackCheckOffset > 0
  		 and: [cogMethod stackCheckOffset < cmNoCheckEntryOffset]) ifTrue:
  			[^13].
  		 ^0].
  
  	cogMethod cmType = CMOpenPIC ifTrue:
  		[cogMethod blockSize ~= openPICSize ifTrue:
  			[^21].
  		 cogMethod methodHeader ~= 0 ifTrue:
  			[^22].
  		
  		 "Check the nextOpenPIC link unless we're compacting"
+ 		 cogMethod objectHeader >= 0 ifTrue:
- 		 cogMethod objectHeader signedIntFromLong >= 0 ifTrue:
  			[(cogMethod methodObject ~= 0
  			 and: [cogMethod methodObject < methodZoneBase
  				   or: [cogMethod methodObject > (methodZone freeStart - openPICSize)
  				   or: [(cogMethod methodObject bitAnd: BytesPerWord - 1) ~= 0
  				   or: [(self cCoerceSimple: cogMethod methodObject
  							to: #'CogMethod *') cmType ~= CMOpenPIC]]]]) ifTrue:
  				[^23]].
  		 cogMethod stackCheckOffset ~= 0 ifTrue:
  			[^24].
  		 ^0].
  
  	cogMethod cmType = CMClosedPIC ifTrue:
  		[cogMethod blockSize ~= closedPICSize ifTrue:
  			[^31].
  		 (cogMethod cPICNumCases between: 1 and: numPICCases) ifFalse:
  			[^32].
  		 cogMethod methodHeader ~= 0 ifTrue:
  			[^33].
  		 cogMethod methodObject ~= 0 ifTrue:
  			[^34].
  		 ^0].
  
  	^9!

Item was changed:
  ----- Method: Cogit>>cogMethodSurrogateAt: (in category 'simulation only') -----
  cogMethodSurrogateAt: address
  	<doNotGenerate>
  	self assert: (address bitAnd: BytesPerWord - 1) = 0.
  	^cogMethodSurrogateClass new
  		at: address
+ 		objectMemory: objectMemory
- 		memory: objectMemory memory
  		cogit: self!

Item was changed:
  ----- Method: Cogit>>compileBlockEntry: (in category 'compile abstract instructions') -----
  compileBlockEntry: blockStart
  	"Compile a block's entry.  This looks like a dummy CogBlockMethod header (for frame parsing)
  	 followed by either a frame build, if a frame is required, or nothing.  The CogMethodHeader's
  	 objectHeader field is a back pointer to the method, but this can't be filled in until code generation."
  	<var: #blockStart type: #'BlockStart *'>
  	self AlignmentNops: (self sizeof: CogBlockMethod).
- 	self assert: (self sizeof: CogBlockMethod) = (2 * BytesPerWord).
  	blockStart fakeHeader: self Label.
+ 	(self sizeof: CogBlockMethod) caseOf:
+ 		{ [2 * BytesPerWord]	"ObjectMemory"
+ 			->	[self Fill32: 0.		"gets filled in later with the homeOffset and startpc"
+ 				 self Fill32: 0].		"gets filled in later with numArgs et al"
+ 		   [3 * BytesPerWord]	"Spur"
+ 			->	[self Fill32: 0.		"gets filled in later with the homeOffset and startpc"
+ 				 self Fill32: 0.		"is left fallow"
+ 				 self Fill32: 0].		"gets filled in later with numArgs et al"
+ 		}.
- 	self Fill32: 0. "gets filled in later with the homeOffset and startpc"
- 	self Fill32: 0. "gets filled in later with numArgs et al"
  	blockStart entryLabel: self Label.
  	needsFrame
  		ifTrue:
  			[self compileBlockFrameBuild: blockStart.
  			 self recordBlockTrace ifTrue:
  				[self CallRT: ceTraceBlockActivationTrampoline]]
  		ifFalse:
  			[self compileBlockFramelessEntry: blockStart]!

Item was changed:
  ----- Method: Cogit>>compileCPICEntry (in category 'in-line cacheing') -----
  compileCPICEntry
  	<returnTypeC: #'AbstractInstruction *'>
  	"Compile the cache tag computation and the first comparison.  Answer the address of that comparison."
+ 	entry := objectRepresentation getInlineCacheClassTagFrom: ReceiverResultReg into: TempReg.
- 	self AlignmentNops: (BytesPerWord max: 8).
- 	entry := self Label.
- 	objectRepresentation getInlineCacheClassTagFrom: ReceiverResultReg into: TempReg.
  	self CmpR: ClassReg R: TempReg.
  	^self JumpNonZero: 0!

Item was changed:
  ----- Method: Cogit>>compileEntry (in category 'compile abstract instructions') -----
  compileEntry
  	"The entry code to a method checks that the class of the current receiver matches
  	 that in the inline cache.  Other non-obvious elements are that its alignment must be
  	 different from the alignment of the noCheckEntry so that the method map machinery
  	 can distinguish normal and super sends (super sends bind to the noCheckEntry).
  	 In Newspeak we also need to distinguish dynSuperSends from normal and super
  	 and so bind a the preceeding nop (on x86 there happens to be one anyway)."
+ 
+ 	self cppIf: NewspeakVM ifTrue:
+ 		[self Nop. "1st nop differentiates dynSuperEntry from no-check entry if using nextMethod"
+ 		 dynSuperEntry := self Nop].
+ 	entry := objectRepresentation getInlineCacheClassTagFrom: ReceiverResultReg into: TempReg.
- 	self cppIf: NewspeakVM
- 		ifTrue: "1st nop differentiates dynSuperEntry from no-check entry if using nextMethod"
- 			[self Nop. 
- 			dynSuperEntry := self Nop].
- 	self AlignmentNops: (BytesPerWord max: 8).
- 	entry := self Label.
- 	objectRepresentation getInlineCacheClassTagFrom: ReceiverResultReg into: TempReg.
  	self CmpR: ClassReg R: TempReg.
  	self JumpNonZero: sendMissCall.
  	noCheckEntry := self Label.
  	self recordSendTrace ifTrue:
  		[self CallRT: ceTraceLinkedSendTrampoline]!

Item was changed:
  ----- Method: Cogit>>relocateCallsAndSelfReferencesInMethod: (in category 'compaction') -----
  relocateCallsAndSelfReferencesInMethod: cogMethod
  	<var: #cogMethod type: #'CogMethod *'>
  	| delta |
+ 	delta := cogMethod objectHeader.
- 	delta := cogMethod objectHeader signedIntFromLong.
  	backEnd relocateCallBeforeReturnPC: cogMethod asInteger + missOffset by: delta negated.
  	self mapFor: cogMethod
  		performUntil: #relocateIfCallOrMethodReference:mcpc:delta:
  		arg: delta!

Item was changed:
  ----- Method: Cogit>>relocateCallsInClosedPIC: (in category 'compaction') -----
  relocateCallsInClosedPIC: cPIC
  	<var: #cPIC type: #'CogMethod *'>
  	| delta pc entryPoint targetMethod |
  	<var: #targetMethod type: #'CogMethod *'>
+ 	delta := cPIC objectHeader.
- 	delta := cPIC objectHeader signedIntFromLong.
  	self assert: (backEnd callTargetFromReturnAddress: cPIC asInteger + missOffset)
  					= (self picAbortTrampolineFor: cPIC cmNumArgs).
  	backEnd relocateCallBeforeReturnPC: cPIC asInteger + missOffset by: delta negated.
  
  	pc := cPIC asInteger + firstCPICCaseOffset.
  	1 to: cPIC cPICNumCases do:
  		[:i|
  		entryPoint := backEnd jumpLongTargetBeforeFollowingAddress: pc.
  		"Find target from jump.  Ignore jumps to the interpret and MNU calls within this PIC"
  		(entryPoint < cPIC asInteger
  		 or: [entryPoint > (cPIC asInteger + cPIC blockSize)]) ifTrue:
  			[targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
  			 self assert: targetMethod cmType = CMMethod.
  			 backEnd
  				relocateJumpBeforeFollowingAddress: pc
+ 				by: (delta - targetMethod objectHeader) negated].
- 				by: (delta - targetMethod objectHeader signedIntFromLong) negated].
  		pc := pc + cPICCaseSize].
  	self assert: cPIC cPICNumCases > 0.
  	pc := pc - cPICCaseSize.
  	"Finally relocate the load of the PIC and the jump to the overflow routine ceCPICMiss:receiver:"
  	backEnd relocateMethodReferenceBeforeAddress: pc + backEnd loadLiteralByteSize by: delta.
  	backEnd relocateJumpBeforeFollowingAddress: pc + cPICEndSize by: delta negated!

Item was changed:
  ----- Method: Cogit>>relocateIfCallOrMethodReference:mcpc:delta: (in category 'compaction') -----
  relocateIfCallOrMethodReference: annotation mcpc: mcpc delta: delta
  	<var: #mcpc type: #'char *'>
  	| entryPoint offset sendTable targetMethod unlinkedRoutine |
  	<var: #sendTable type: #'sqInt *'>
  	<var: #targetMethod type: #'CogMethod *'>
  	(self isSendAnnotation: annotation) ifTrue:
  		[entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  		 entryPoint <= methodZoneBase ifTrue: "send is not linked; just relocate"
  			[backEnd relocateCallBeforeReturnPC: mcpc asInteger by: delta negated.
  			 ^0].
  		"It's a linked send; find which kind."
  		self
  			offsetAndSendTableFor: entryPoint
  			annotation: annotation
  			into: [:off :table| offset := off. sendTable := table].
  		 targetMethod := self cCoerceSimple: entryPoint - offset to: #'CogMethod *'.
  		 targetMethod cmType = CMMethod ifTrue: "send target not freed; just relocate."
  			[backEnd
  				relocateCallBeforeReturnPC: mcpc asInteger
+ 				by: (delta - targetMethod objectHeader) negated.
- 				by: (delta - targetMethod objectHeader signedIntFromLong) negated.
  			 ^0].
  		"Target was freed; map back to an unlinked send; but include this method's reocation"
  		 unlinkedRoutine := sendTable at: (targetMethod cmNumArgs min: NumSendTrampolines - 1).
  		 unlinkedRoutine := unlinkedRoutine - delta.
  		 backEnd
  			rewriteInlineCacheAt: mcpc asInteger
  			tag: targetMethod selector
  			target: unlinkedRoutine.
  		 ^0].
  	annotation = IsRelativeCall ifTrue:
  		[backEnd relocateCallBeforeReturnPC: mcpc asInteger by: delta negated.
  		 ^0].
  	annotation = IsAbsPCReference ifTrue:
  		[backEnd relocateMethodReferenceBeforeAddress: mcpc asInteger by: delta].
  	^0 "keep scanning"!

Item was added:
+ ----- Method: LittleEndianBitmap>>longAt: (in category 'accessing') -----
+ longAt: byteIndex
+ 	^self longAt: byteIndex bigEndian: false!

Item was added:
+ ----- Method: LittleEndianBitmap>>longLongAt: (in category 'accessing') -----
+ longLongAt: byteAddress
+ 	"memory is a Bitmap, a 32-bit indexable array of bits"
+ 	| hiWord loWord |
+ 	byteAddress - 1 \\ 8 ~= 0 ifTrue: [self unalignedAccessError].
+ 	loWord := self at: byteAddress - 1 // 4 + 1.
+ 	hiWord := self at: byteAddress - 1 // 4 + 2.
+ 	^hiWord = 0
+ 		ifTrue: [loWord]
+ 		ifFalse: [(hiWord signedIntFromLong bitShift: 32) + loWord]!

Item was added:
+ ----- Method: NewCoObjectMemory>>cheapAddressCouldBeInHeap: (in category 'debug support') -----
+ cheapAddressCouldBeInHeap: address 
+ 	^(address bitAnd: self wordSize - 1) = 0
+ 	  and: [(self oop: address isGreaterThanOrEqualTo: self startOfMemory)
+ 	  and: [self oop: address isLessThan: freeStart]]!

Item was changed:
  ----- Method: ObjectMemory>>isArray: (in category 'header access') -----
  isArray: oop
  	"Answer true if this is an indexable object with pointer elements, e.g., an array"
+ 	^(self isNonIntegerObject: oop) and:[self isArrayNonImm: oop]!
- 	^(self isNonIntegerObject: oop) and:[self isArrayNonInt: oop]!

Item was added:
+ ----- Method: ObjectMemory>>isArrayNonImm: (in category 'header access') -----
+ isArrayNonImm: oop
+ 	"Answer true if this is an indexable object with pointer elements, e.g., an array"
+ 	^ (self formatOf: oop) = 2!

Item was removed:
- ----- Method: ObjectMemory>>isArrayNonInt: (in category 'header access') -----
- isArrayNonInt: oop
- 	"Answer true if this is an indexable object with pointer elements, e.g., an array"
- 	^ (self formatOf: oop) = 2!

Item was added:
+ Spur32BitMemoryManager subclass: #Spur32BitCoMemoryManager
+ 	instanceVariableNames: 'cogit'
+ 	classVariableNames: ''
+ 	poolDictionaries: 'CogMethodConstants'
+ 	category: 'VMMaker-SpurMemoryManager'!

Item was added:
+ ----- Method: Spur32BitCoMemoryManager>>ceStoreCheck: (in category 'trampolines') -----
+ ceStoreCheck: anOop
+ 	<api>
+ 	"Do the store check.  Answer the argument for the benefit of the code generator;
+ 	 ReceiverResultReg may be caller-saved and hence smashed by this call.  Answering
+ 	 it allows the code generator to reload ReceiverResultReg cheaply."
+ 	self assert: (self isNonImmediate: anOop).
+ 	self assert: (self oop: anOop isGreaterThan: newSpaceLimit).
+ 	self assert: (self isRemembered: anOop) not.
+ 	scavenger remember: anOop.
+ 	self setIsRememberedOf: anOop to: true.
+ 	^anOop!

Item was added:
+ ----- Method: Spur32BitCoMemoryManager>>headerWhileForwardingOf: (in category 'garbage collection') -----
+ headerWhileForwardingOf: aCompiledMethodObjOop
+ 	"Answer the header of the argument even though
+ 	 it may have its header word in a forwarding block
+ 	 (which shouldn't happen with Spur)."
+ 	self assert: (self isForwarded: aCompiledMethodObjOop) not.
+ 	^self baseHeader: aCompiledMethodObjOop!

Item was added:
+ ----- Method: Spur32BitCoMemoryManager>>nullHeaderForMachineCodeMethod (in category 'garbage collection') -----
+ nullHeaderForMachineCodeMethod
+ 	<api>
+ 	^self firstLongFormat << self formatShift + ClassBitmapCompactIndex!

Item was added:
+ Spur32BitCoMemoryManager subclass: #Spur32BitMMLECoSimulator
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-SpurMemoryManagerSimulation'!

Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>byteAt: (in category 'memory access') -----
+ byteAt: byteAddress
+ 	| lowBits long |
+ 	lowBits := byteAddress bitAnd: 3.
+ 	long := self longAt: byteAddress - lowBits.
+ 	^(lowBits caseOf: {
+ 		[0] -> [ long ].
+ 		[1] -> [ long bitShift: -8  ].
+ 		[2] -> [ long bitShift: -16 ].
+ 		[3] -> [ long bitShift: -24 ]
+ 	}) bitAnd: 16rFF!

Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>byteAt:put: (in category 'memory access') -----
+ byteAt: byteAddress put: byte
+ 	| lowBits long longAddress |
+ 	lowBits := byteAddress bitAnd: 3.
+ 	longAddress := byteAddress - lowBits.
+ 	long := self longAt: longAddress.
+ 	long := (lowBits caseOf: {
+ 		[0] -> [ (long bitAnd: 16rFFFFFF00) bitOr: byte ].
+ 		[1] -> [ (long bitAnd: 16rFFFF00FF) bitOr: (byte bitShift: 8) ].
+ 		[2] -> [ (long bitAnd: 16rFF00FFFF) bitOr: (byte bitShift: 16)  ].
+ 		[3] -> [ (long bitAnd: 16r00FFFFFF) bitOr: (byte bitShift: 24)  ]
+ 	}).
+ 	self longAt: longAddress put: long.
+ 	^byte!

Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>byteAtPointer: (in category 'memory access') -----
+ byteAtPointer: pointer
+ 	"This gets implemented by Macros in C, where its types will also be checked.
+ 	 pointer is a raw address."
+ 
+ 	^self byteAt: pointer!

Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>coInterpreter:cogit: (in category 'initialization') -----
+ coInterpreter: aCoInterpreter cogit: aCogit
+ 	coInterpreter := aCoInterpreter.
+ 	cogit := aCogit.
+ 	scavenger coInterpreter: aCoInterpreter!

Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>eek (in category 'debug support') -----
+ eek
+ 	self halt!

Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>endianness (in category 'memory access') -----
+ endianness
+ 	^#little!

Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>fetchFloatAt:into: (in category 'float primitives') -----
+ fetchFloatAt: floatBitsAddress into: aFloat
+ 	aFloat at: 2 put: (self long32At: floatBitsAddress).
+ 	aFloat at: 1 put: (self long32At: floatBitsAddress+4)!

Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>firstIndexableField: (in category 'object format') -----
+ firstIndexableField: objOop
+ 	"NOTE: overridden from SpurMemoryManager to add coercion to CArray, so please duplicate any changes.
+ 	 There are only two important cases, both for objects with named inst vars, i.e. formats 2,3 & 5.
+ 	 The first indexable field for formats 2 & 5 is the slot count (by convention, even though that's off the end
+ 	 of the object).  For 3 we must go to the class."
+ 	| fmt classFormat |
+ 	<returnTypeC: #'void *'>
+ 	fmt := self formatOf: objOop.
+ 	fmt <= self lastPointerFormat ifTrue: "pointer; may need to delve into the class format word"
+ 		[(fmt between: self indexablePointersFormat and: self weakArrayFormat) ifTrue:
+ 			[classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop).
+ 			 ^self cCoerce: (self pointerForOop: objOop
+ 												+ self baseHeaderSize
+ 												+ ((self fixedFieldsOfClassFormat: classFormat) << self wordSize))
+ 					to: #'oop *'].
+ 		^self cCoerce: (self pointerForOop: objOop
+ 											+ self baseHeaderSize
+ 											+ ((self numSlotsOf: objOop) << self wordSize))
+ 				to: #'oop *'].
+ 	"All bit objects, and indeed CompiledMethod, though this is a non-no, start at 0"
+ 	self assert: (fmt >= self sixtyFourBitIndexableFormat and: [fmt < self firstCompiledMethodFormat]).
+ 	^self
+ 		cCoerce: (self pointerForOop: objOop + self baseHeaderSize)
+ 		to: (fmt < self firstByteFormat
+ 				ifTrue:
+ 					[fmt = self sixtyFourBitIndexableFormat
+ 						ifTrue: ["64 bit field objects" #'long long *']
+ 						ifFalse:
+ 							[fmt < self firstShortFormat
+ 								ifTrue: ["32 bit field objects" #'int *']
+ 								ifFalse: ["16-bit field objects" #'short *']]]
+ 				ifFalse: ["byte objects (including CompiledMethod" #'char *'])!

Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>halfWordHighInLong32: (in category 'memory access') -----
+ halfWordHighInLong32: long32
+ 	"Used by Balloon"
+ 
+ 	^long32 bitAnd: 16rFFFF!

Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>halfWordLowInLong32: (in category 'memory access') -----
+ halfWordLowInLong32: long32
+ 	"Used by Balloon"
+ 
+ 	^long32 bitShift: -16!

Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>headerForSlots:format:classIndex: (in category 'header format') -----
+ headerForSlots: numSlots format: formatField classIndex: classIndex
+ 	"The header format in LSB is
+ 	 MSB:	| 2 bits				|
+ 			| 22: identityHash	|
+ 			| 8: slotSize			|
+ 			| 3 bits				|
+ 			| 5: format			|
+ 			| 2 bits				|
+ 			| 22: classIndex		| : LSB"
+ 	self assert: (numSlots bitAnd: self numSlotsMask) = numSlots.
+ 	self assert: (formatField bitAnd: self formatMask) = formatField.
+ 	self assert: (classIndex bitAnd: self classIndexMask) = classIndex.
+ 	^super headerForSlots: numSlots format: formatField classIndex: classIndex!

Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>intAt:put: (in category 'memory access') -----
+ intAt: byteAddress put: a32BitValue
+ 	^self longAt: byteAddress put: (a32BitValue bitAnd: 16rFFFFFFFF)!

Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>long32At: (in category 'memory access') -----
+ long32At: byteAddress
+ 	"Answer the 32-bit word at byteAddress which must be 0 mod 4."
+ 
+ 	^self longAt: byteAddress!

Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>long32At:put: (in category 'memory access') -----
+ long32At: byteAddress put: a32BitValue
+ 	"Store the 32-bit value at byteAddress which must be 0 mod 4."
+ 
+ 	^self longAt: byteAddress put: a32BitValue!

Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>longAt: (in category 'memory access') -----
+ longAt: byteAddress
+ 	"Note: Adjusted for Smalltalk's 1-based array indexing."
+ 	byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError].
+ 	^memory at: byteAddress // 4 + 1!

Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>longAt:put: (in category 'memory access') -----
+ longAt: byteAddress put: a32BitValue
+ 	"Note: Adjusted for Smalltalk's 1-based array indexing."
+ 	"(byteAddress = 16r1614CB8 and: [a32BitValue = 16rA000035]) ifTrue:
+ 		[self halt]."
+ 	byteAddress \\ 4 ~= 0 ifTrue: [self unalignedAccessError].
+ 	^memory at: byteAddress // 4 + 1 put: a32BitValue!

Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>longLongAt: (in category 'memory access') -----
+ longLongAt: byteAddress
+ 	"memory is a Bitmap, a 32-bit indexable array of bits"
+ 	| hiWord loWord |
+ 	byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError].
+ 	loWord := memory at: byteAddress // 4 + 1.
+ 	hiWord := memory at: byteAddress // 4 + 2.
+ 	^hiWord = 0
+ 		ifTrue: [loWord]
+ 		ifFalse: [(hiWord bitShift: 32) + loWord]!

Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>longLongAt:put: (in category 'memory access') -----
+ longLongAt: byteAddress put: a64BitValue
+ 	byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError].
+ 	self
+ 		longAt: byteAddress put: (a64BitValue bitAnd: 16rffffffff);
+ 		longAt: byteAddress + 4 put: a64BitValue >> 32.
+ 	^a64BitValue!

Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>scavengingGC (in category 'generation scavenging') -----
+ scavengingGC
+ 	"Run the scavenger."
+ 	self halt: (statScavenges + 1) printString, ((statScavenges between: 9 and: 19)
+ 													ifTrue: ['th']
+ 													ifFalse: [#('st' 'nd' 'rd') at: (statScavenges + 1) \\ 10 ifAbsent: 'th']), ' scavenge'.
+ 	^super scavengingGC!

Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>shortAt: (in category 'memory access') -----
+ shortAt: byteAddress
+     "Return the half-word at byteAddress which must be even."
+ 	| lowBits long |
+ 	lowBits := byteAddress bitAnd: 2.
+ 	long := self longAt: byteAddress - lowBits.
+ 	^ lowBits = 2
+ 		ifTrue: [ long bitShift: -16 ]
+ 		ifFalse: [ long bitAnd: 16rFFFF ]!

Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>storeFloatAt:from: (in category 'float primitives') -----
+ storeFloatAt: floatBitsAddress from: aFloat
+ 	self long32At: floatBitsAddress put: (aFloat at: 2).
+ 	self long32At: floatBitsAddress+4 put: (aFloat at: 1)!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>become:with:twoWay:copyHash: (in category 'become api') -----
- become: array1 with: array2 twoWay: twoWayFlag copyHash: copyHashFlag
- 
- 	"(thisContext findContextSuchThat: [:c| c selector == #rehashImage]) ifNotNil:
- 		[:ctxt|
- 		(((ctxt tempAt: 4) at: 1) = 108
- 		 and: [(ctxt tempAt: 2) byteCount = 553985]) ifTrue: [self halt]]."
- 	^super become: array1 with: array2 twoWay: twoWayFlag copyHash: copyHashFlag!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>booleanValueOf: (in category 'simulation only') -----
- booleanValueOf: obj
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter booleanValueOf: obj!

Item was changed:
  ----- Method: Spur32BitMMLESimulator>>byteAt:put: (in category 'memory access') -----
  byteAt: byteAddress put: byte
  	| lowBits long longAddress |
  	lowBits := byteAddress bitAnd: 3.
  	longAddress := byteAddress - lowBits.
  	long := self longAt: longAddress.
  	long := (lowBits caseOf: {
  		[0] -> [ (long bitAnd: 16rFFFFFF00) bitOr: byte ].
  		[1] -> [ (long bitAnd: 16rFFFF00FF) bitOr: (byte bitShift: 8) ].
  		[2] -> [ (long bitAnd: 16rFF00FFFF) bitOr: (byte bitShift: 16)  ].
  		[3] -> [ (long bitAnd: 16r00FFFFFF) bitOr: (byte bitShift: 24)  ]
  	}).
- 	self assert: (self cheapAddressCouldBeInHeap: longAddress).
  	self longAt: longAddress put: long.
  	^byte!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>cCoerce:to: (in category 'memory access') -----
- cCoerce: value to: cTypeString
- 	"Type coercion. For translation a cast will be emmitted. When running in Smalltalk
- 	 answer a suitable wrapper for correct indexing."
- 
- 	^value
- 		ifNil: [value]
- 		ifNotNil: [value coerceTo: cTypeString sim: self]!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>failed (in category 'simulation only') -----
- failed
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter failed!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>fetchInteger:ofObject: (in category 'simulation only') -----
- fetchInteger: fieldIndex ofObject: objectPointer
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter fetchInteger: fieldIndex ofObject: objectPointer!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>floatValueOf: (in category 'simulation only') -----
- floatValueOf: obj
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter floatValueOf: obj!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>forward:to: (in category 'become') -----
- forward: obj1 to: obj2
- 	"(obj1 = 16r150CD8 or: [obj1 = 16r1510B8
- 	 or: [obj2 = 16r150CD8 or: [obj2 = 16r1510B8]]]) ifTrue:
- 		[self halt]."
- 	^super forward: obj1 to: obj2!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>ioLoadFunction:From: (in category 'simulation only') -----
- ioLoadFunction: functionString From: pluginString
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter ioLoadFunction: functionString From: pluginString!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>is:KindOf: (in category 'simulation only') -----
- is: oop KindOf: classNameString
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter is: oop KindOf: classNameString!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>isFloatObject: (in category 'simulation only') -----
- isFloatObject: oop
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter isFloatObject: oop!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>methodArgumentCount (in category 'simulation only') -----
- methodArgumentCount
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter methodArgumentCount!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>pop: (in category 'simulation only') -----
- pop: nItems
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter pop: nItems!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>pop:thenPush: (in category 'simulation only') -----
- pop: nItems thenPush: oop
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter pop: nItems thenPush: oop!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>positive32BitIntegerFor: (in category 'simulation only') -----
- positive32BitIntegerFor: integerValue
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter positive32BitIntegerFor: integerValue!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>positive32BitValueOf: (in category 'simulation only') -----
- positive32BitValueOf: oop
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter positive32BitValueOf: oop!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>positive64BitIntegerFor: (in category 'simulation only') -----
- positive64BitIntegerFor: integerValue
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter positive64BitIntegerFor: integerValue!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>positive64BitValueOf: (in category 'simulation only') -----
- positive64BitValueOf: oop
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter positive64BitValueOf: oop!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>primitiveFail (in category 'simulation only') -----
- primitiveFail
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter primitiveFail!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>primitiveFailureCode (in category 'simulation only') -----
- primitiveFailureCode
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter primitiveFailureCode!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>push: (in category 'simulation only') -----
- push: oop
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter push: oop!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>pushBool: (in category 'simulation only') -----
- pushBool: trueOrFalse
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter pushBool: trueOrFalse!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>pushFloat: (in category 'simulation only') -----
- pushFloat: f
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter pushFloat: f!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>pushInteger: (in category 'simulation only') -----
- pushInteger: integerValue
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter pushInteger: integerValue!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>showDisplayBits:Left:Top:Right:Bottom: (in category 'simulation only') -----
- showDisplayBits: aForm Left: l Top: t Right: r Bottom: b
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter showDisplayBits: aForm Left: l Top: t Right: r Bottom: b!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>stObject:at:put: (in category 'simulation only') -----
- stObject: objOop at: indexOop put: valueOop
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter stObject: objOop at: indexOop put: valueOop!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>stackFloatValue: (in category 'simulation only') -----
- stackFloatValue: offset
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter stackFloatValue: offset!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>stackIntegerValue: (in category 'simulation only') -----
- stackIntegerValue: offset
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter stackIntegerValue: offset!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>stackObjectValue: (in category 'simulation only') -----
- stackObjectValue: offset
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter stackObjectValue: offset!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>stackValue: (in category 'simulation only') -----
- stackValue: offset
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter stackValue: offset!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>storeInteger:ofObject:withValue: (in category 'simulation only') -----
- storeInteger: fieldIndex ofObject: objectPointer withValue: integerValue
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter storeInteger: fieldIndex ofObject: objectPointer withValue: integerValue!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>stringOf: (in category 'simulation only') -----
- stringOf: oop
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter stringOf: oop!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>success: (in category 'simulation only') -----
- success: boolean
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter success: boolean!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>transcript (in category 'simulation only') -----
- transcript
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter transcript!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>unalignedAccessError (in category 'memory access') -----
- unalignedAccessError
- 	^self error: 'unaligned access'!

Item was added:
+ ----- Method: Spur32BitMemoryManager class>>objectRepresentationClass (in category 'accessing') -----
+ objectRepresentationClass
+ 	^CogObjectRepresentationFor32BitSpur!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>objectRepresentationClass (in category 'simulation') -----
+ objectRepresentationClass
+ 	^CogObjectRepresentationFor32BitSpur!

Item was added:
+ ----- Method: Spur64BitMemoryManager class>>objectRepresentationClass (in category 'accessing') -----
+ objectRepresentationClass
+ 	^CogObjectRepresentationFor64BitSpur!

Item was changed:
+ ----- Method: Spur64BitMemoryManager>>initFreeChunkWithBytes:at: (in category 'free space') -----
- ----- Method: Spur64BitMemoryManager>>initFreeChunkWithBytes:at: (in category 'garbage collection') -----
  initFreeChunkWithBytes: numBytes at: address
  	<var: #numBytes type: #usqLong>
  	| numSlots |
  	"must have room for a header (single or double) plus the next free pointer"
  	self assert: (numBytes \\ self allocationUnit = 0
  				 and: [numBytes >= (self baseHeaderSize + self wordSize)]).
  	"double header"
  	numBytes >= (self numSlotsMask << self shiftForWord) ifTrue:
  		[numSlots := numBytes - self baseHeaderSize - self baseHeaderSize >> self shiftForWord.
  		 self longAt: address put: self numSlotsMask << self numSlotsFullShift + numSlots;
  			longAt: address + 8 put: self numSlotsMask << self numSlotsFullShift. "0's classIndex; 0 = classIndex of free chunks"
  		^address + 8].
  	"single header"
  	numSlots := numBytes - self baseHeaderSize >> self shiftForWord.
  	self longAt: address put: numSlots << self numSlotsFullShift. "0's classIndex; 0 = classIndex of free chunks"
  	^address!

Item was added:
+ ----- Method: Spur64BitMemoryManager>>objectRepresentationClass (in category 'simulation') -----
+ objectRepresentationClass
+ 	^CogObjectRepresentationFor64BitSpur!

Item was changed:
  ----- Method: SpurGenerationScavenger>>shouldBeTenured: (in category 'scavenger') -----
  shouldBeTenured: survivor
  	"Answer if an object should be tenured.  Use the tenuringThreshold to decide.
  	 If the survivors (measured in bytes) are above some fraction of the survivor
  	 space then objects below the threshold (older objects, since allocation grows
  	 upwards and hence new objects are later than old) are scavenged.  Otherwise,
  	 the threshold is set to 0 and no objects are tenured.  See e.g.
  	 An adaptive tenuring policy for generation scavengers, David Ungar & Frank Jackson.
  	 ACM TOPLAS, Volume 14 Issue 1, Jan. 1992, pp 1 - 27."
  
+ 	^survivor < tenuringThreshold
+ 	  and: [survivor >= manager startOfMemory] "exclude methods in the method zone"!
- 	^survivor < tenuringThreshold!

Item was added:
+ ----- Method: SpurMemoryManager class>>baseHeaderSize (in category 'accessing') -----
+ baseHeaderSize
+ 	"For CogBlockMethod class>>instVarNamesAndTypesForTranslationDo:"
+ 	^8!

Item was changed:
  ----- Method: SpurMemoryManager class>>initializeWithOptions: (in category 'class initialization') -----
  initializeWithOptions: optionsDictionary
  	"SpurMemoryManager initializeWithOptions: Dictionary new"
  
+ 	super initializeWithOptions: optionsDictionary.
  	self initBytesPerWord: (self == SpurMemoryManager
  								ifTrue: [optionsDictionary at: #BytesPerWord ifAbsent: [4]]
  								ifFalse: [self wordSize]).
  	BytesPerOop := optionsDictionary at: #BytesPerOop ifAbsent: [BytesPerWord].
  
  	self initializeSpurObjectRepresentationConstants.
  	self initializeSpecialObjectIndices.
  	self initializeCompactClassIndices.
  	self initializePrimitiveErrorCodes.
  	self initializeObjectHeaderConstants.
  
  	SpurGenerationScavenger initialize!

Item was added:
+ ----- Method: SpurMemoryManager class>>objectRepresentationClass (in category 'accessing') -----
+ objectRepresentationClass
+ 	^self subclassResponsibility!

Item was removed:
- ----- Method: SpurMemoryManager>>allocateMemoryOfSize:newSpaceSize:codeSize: (in category 'simulation') -----
- allocateMemoryOfSize: memoryBytes newSpaceSize: newSpaceBytes codeSize: codeBytes
- 	"Intialize the receiver for bootsraping an image.
- 	 Set up a large oldSpace and an empty newSpace and set-up freeStart and scavengeThreshold
- 	 to allocate in oldSpace.  Later on (in initializePostBootstrap) freeStart and scavengeThreshold
- 	 will be set to sane values."
- 	<doNotGenerate>
- 	self assert: (memoryBytes \\ self allocationUnit = 0
- 				and: [newSpaceBytes \\ self allocationUnit = 0
- 				and: [codeBytes \\ self allocationUnit = 0]]).
- 	memory := (self endianness == #little
- 					ifTrue: [LittleEndianBitmap]
- 					ifFalse: [Bitmap]) new: (memoryBytes + newSpaceBytes + codeBytes) // 4.
- 	startOfMemory := codeBytes.
- 	endOfMemory := freeOldSpaceStart := memoryBytes + newSpaceBytes + codeBytes.
- 	"leave newSpace empty for the bootstrap"
- 	freeStart := newSpaceBytes + startOfMemory.
- 	newSpaceLimit := newSpaceBytes + startOfMemory.
- 	scavengeThreshold := memory size * 4. "Bitmap is a 4-byte per word array"
- 	scavenger := SpurGenerationScavengerSimulator new
- 					manager: self
- 					newSpaceStart: startOfMemory
- 					newSpaceBytes: newSpaceBytes
- 					edenBytes: newSpaceBytes * 5 // 7 "David's paper uses 140Kb eden + 2 x 28kb survivor spaces :-)"!

Item was added:
+ ----- Method: SpurMemoryManager>>allocateMemoryOfSize:newSpaceSize:stackSize:codeSize: (in category 'simulation') -----
+ allocateMemoryOfSize: memoryBytes newSpaceSize: newSpaceBytes stackSize: stackBytes codeSize: codeBytes
+ 	"Intialize the receiver for bootsraping an image.
+ 	 Set up a large oldSpace and an empty newSpace and set-up freeStart and scavengeThreshold
+ 	 to allocate in oldSpace.  Later on (in initializePostBootstrap) freeStart and scavengeThreshold
+ 	 will be set to sane values."
+ 	<doNotGenerate>
+ 	self assert: (memoryBytes \\ self allocationUnit = 0
+ 				and: [newSpaceBytes \\ self allocationUnit = 0
+ 				and: [codeBytes \\ self allocationUnit = 0]]).
+ 	memory := (self endianness == #little
+ 					ifTrue: [LittleEndianBitmap]
+ 					ifFalse: [Bitmap]) new: (memoryBytes + newSpaceBytes + codeBytes + stackBytes) // 4.
+ 	startOfMemory := codeBytes + stackBytes.
+ 	endOfMemory := freeOldSpaceStart := memoryBytes + newSpaceBytes + codeBytes + stackBytes.
+ 	"leave newSpace empty for the bootstrap"
+ 	freeStart := newSpaceBytes + startOfMemory.
+ 	newSpaceLimit := newSpaceBytes + startOfMemory.
+ 	scavengeThreshold := memory size * 4. "Bitmap is a 4-byte per word array"
+ 	scavenger := SpurGenerationScavengerSimulator new
+ 					manager: self
+ 					newSpaceStart: startOfMemory
+ 					newSpaceBytes: newSpaceBytes
+ 					edenBytes: newSpaceBytes * 5 // 7 "David's paper uses 140Kb eden + 2 x 28kb survivor spaces :-)"!

Item was added:
+ ----- Method: SpurMemoryManager>>booleanValueOf: (in category 'simulation only') -----
+ booleanValueOf: obj
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter booleanValueOf: obj!

Item was added:
+ ----- Method: SpurMemoryManager>>cCoerce:to: (in category 'memory access') -----
+ cCoerce: value to: cTypeString
+ 	"Type coercion. For translation a cast will be emmitted. When running in Smalltalk
+ 	  answer a suitable wrapper for correct indexing."
+ 
+ 	^value
+ 		ifNil: [value]
+ 		ifNotNil: [value coerceTo: cTypeString sim: self]!

Item was changed:
  ----- Method: SpurMemoryManager>>cheapAddressCouldBeInHeap: (in category 'debug support') -----
  cheapAddressCouldBeInHeap: address 
  	^(address bitAnd: self wordSize - 1) = 0
+ 	  and: [(self oop: address isGreaterThanOrEqualTo: startOfMemory)
+ 	  and: [self oop: address isLessThan: freeOldSpaceStart]]!
- 	  and: [address >= startOfMemory
- 	  and: [address <= freeOldSpaceStart]]!

Item was removed:
- ----- Method: SpurMemoryManager>>cheapAddressCouldBeObj: (in category 'debug support') -----
- cheapAddressCouldBeObj: address 
- 	^(address bitAnd: self baseHeaderSize - 1) = 0
- 	  and: [address >= startOfMemory
- 	  and: [address <= freeOldSpaceStart]]!

Item was added:
+ ----- Method: SpurMemoryManager>>failed (in category 'simulation only') -----
+ failed
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter failed!

Item was added:
+ ----- Method: SpurMemoryManager>>fetchInteger:ofObject: (in category 'simulation only') -----
+ fetchInteger: fieldIndex ofObject: objectPointer
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter fetchInteger: fieldIndex ofObject: objectPointer!

Item was added:
+ ----- Method: SpurMemoryManager>>floatValueOf: (in category 'simulation only') -----
+ floatValueOf: obj
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter floatValueOf: obj!

Item was added:
+ ----- Method: SpurMemoryManager>>ioLoadFunction:From: (in category 'simulation only') -----
+ ioLoadFunction: functionString From: pluginString
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter ioLoadFunction: functionString From: pluginString!

Item was added:
+ ----- Method: SpurMemoryManager>>is:KindOf: (in category 'simulation only') -----
+ is: oop KindOf: classNameString
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter is: oop KindOf: classNameString!

Item was added:
+ ----- Method: SpurMemoryManager>>isCompiledMethodHeader: (in category 'object testing') -----
+ isCompiledMethodHeader: objHeader
+     "Answer whether the argument header has compiled method format"
+     ^(self formatOfHeader: objHeader) >= self firstCompiledMethodFormat!

Item was added:
+ ----- Method: SpurMemoryManager>>isFloatObject: (in category 'simulation only') -----
+ isFloatObject: oop
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter isFloatObject: oop!

Item was changed:
  ----- Method: SpurMemoryManager>>isIntegerObject: (in category 'object testing') -----
  isIntegerObject: oop
  	"This list records the valid senders of isIntegerObject: as we replace uses of
  	  isIntegerObject: by isImmediate: where appropriate."
  	| sel |
  	sel := thisContext sender method selector.
  	(#(	DoIt
  		DoItIn:
  		on:do: "from the debugger"
  		makeBaseFrameFor:
  		quickFetchInteger:ofObject:
  		frameOfMarriedContext:
  		objCouldBeClassObj:
  		isMarriedOrWidowedContext:
  		shortPrint:
  		bytecodePrimAt
  		bytecodePrimAtPut
  		commonAt:
  		commonAtPut:
  		loadFloatOrIntFrom:
  		positive32BitValueOf:
  		primitiveExternalCall
  		checkedIntegerValueOf:
  		bytecodePrimAtPut
  		commonAtPut:
  		primitiveVMParameter
  		checkIsStillMarriedContext:currentFP:
  		displayBitsOf:Left:Top:Right:Bottom:
  		fetchStackPointerOf:
  		primitiveContextAt
  		primitiveContextAtPut
  		subscript:with:storing:format:
  		printContext:
  		compare31or32Bits:equal:
  		signed64BitValueOf:
  		primDigitMultiply:negative:
  		digitLength:
  		isNegativeIntegerValueOf:
  		magnitude64BitValueOf:
  		primitiveMakePoint
  		primitiveAsCharacter
  		primitiveInputSemaphore
  		baseFrameReturn
  		primitiveExternalCall
  		primDigitCompare:
  		isLiveContext:
  		numPointerSlotsOf:
  		fileValueOf:
  		loadBitBltDestForm
  		fetchIntOrFloat:ofObject:ifNil:
  		fetchIntOrFloat:ofObject:
  		loadBitBltSourceForm
  		loadPoint:from:
  		primDigitAdd:
  		primDigitSubtract:
  		positive64BitValueOf:
  		digitBitLogic:with:opIndex:
  		signed32BitValueOf:
  		isNormalized:
  		primDigitDiv:negative:
  		bytesOrInt:growTo:
+ 		primitiveNewMethod
+ 		isCogMethodReference:
+ 		functionForPrimitiveExternalCall:
+ 		genSpecialSelectorArithmetic
+ 		genSpecialSelectorComparison) includes: sel) ifFalse:
- 		primitiveNewMethod) includes: sel) ifFalse:
  		[self halt].
  	^(oop bitAnd: 1) ~= 0!

Item was changed:
  ----- Method: SpurMemoryManager>>isNonIntegerObject: (in category 'object testing') -----
  isNonIntegerObject: oop
  	"This list records the valid senders of isNonIntegerObject: as we replace uses of
  	  isNonIntegerObject: by isNonImmediate: where appropriate."
  	(#(	on:do: "from the dbeugger"
  		reverseDisplayFrom:to:
+ 		primitiveObjectAtPut
+ 		isCogMethodReference:) includes: thisContext sender method selector) ifFalse:
- 		primitiveObjectAtPut) includes: thisContext sender method selector) ifFalse:
  		[self halt].
  	^(oop bitAnd: 1) = 0!

Item was added:
+ ----- Method: SpurMemoryManager>>lookupAddress: (in category 'simulation only') -----
+ lookupAddress: address
+ 	"If address appears to be that of a Symbol or a few well-known objects (such as classes) answer it, otherwise answer nil.
+ 	 For code disassembly"
+ 	<doNotGenerate>
+ 	| fmt size string class classSize maybeThisClass classNameIndex thisClassIndex |
+ 	(self addressCouldBeObj: address) ifFalse:
+ 		[^nil].
+ 	fmt := self formatOf: address.
+ 	size := self lengthOf: address baseHeader: (self baseHeader: address) format: fmt.
+ 	size = 0 ifTrue:
+ 		[^address caseOf: { [nilObj] -> ['nil']. [trueObj] -> ['true']. [falseObj] -> ['false'] } otherwise: []].
+ 	((fmt between: self firstByteFormat and: self firstCompiledMethodFormat - 1) "indexable byte fields"
+ 	and: [(size between: 1 and: 64)
+ 	and: [Scanner isLiteralSymbol: (string := (0 to: size - 1) collect: [:i| Character value: (self fetchByte: i ofObject: address)])]]) ifTrue:
+ 		[^'#', (ByteString withAll: string)].
+ 	class := self fetchClassOfNonImm: address.
+ 	(class isNil or: [class = nilObj]) ifTrue:
+ 		[^nil].
+ 	"address is either a class or a metaclass, or an instance of a class or invalid.  determine which."
+ 	classNameIndex := coInterpreter classNameIndex.
+ 	thisClassIndex := coInterpreter thisClassIndex.
+ 	((classSize := self numSlotsOf: class) <= (classNameIndex max: thisClassIndex)
+ 	 or: [classSize > 255]) ifTrue:
+ 		[^nil].
+ 	"Address could be a class or a metaclass"
+ 	(fmt = 1 and: [size >= classNameIndex]) ifTrue:
+ 		["Is address a class? If so class's thisClass is address."
+ 		 (self lookupAddress: (self fetchPointer: classNameIndex ofObject: address)) ifNotNil:
+ 			[:maybeClassName|
+ 			(self fetchPointer: thisClassIndex ofObject: class) = address ifTrue:
+ 				[^maybeClassName allButFirst]].
+ 		"Is address a Metaclass?  If so class's name is Metaclass and address's thisClass holds the class name"
+ 		((self isBytes: (self fetchPointer: classNameIndex ofObject: class))
+ 		 and: [(self lookupAddress: (self fetchPointer: classNameIndex ofObject: class)) = '#Metaclass'
+ 		 and: [size >= thisClassIndex]]) ifTrue:
+ 			[maybeThisClass := self fetchPointer: thisClassIndex ofObject: address.
+ 			(self lookupAddress: (self fetchPointer: classNameIndex ofObject: maybeThisClass)) ifNotNil:
+ 				[:maybeThisClassName| ^maybeThisClassName allButFirst, ' class']]].
+ 	^(self lookupAddress: (self fetchPointer: classNameIndex ofObject: class)) ifNotNil:
+ 		[:maybeClassName| 'a(n) ', maybeClassName allButFirst]!

Item was added:
+ ----- Method: SpurMemoryManager>>memory: (in category 'accessing') -----
+ memory: aValue
+ 	^memory := aValue!

Item was added:
+ ----- Method: SpurMemoryManager>>methodArgumentCount (in category 'simulation only') -----
+ methodArgumentCount
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter methodArgumentCount!

Item was added:
+ ----- Method: SpurMemoryManager>>newSpaceIsEmpty (in category 'generation scavenging') -----
+ newSpaceIsEmpty
+ 	^freeStart = scavenger eden start
+ 	  and: [pastSpaceStart = scavenger pastSpace start]!

Item was added:
+ ----- Method: SpurMemoryManager>>newSpaceLimit (in category 'accessing') -----
+ newSpaceLimit
+ 	^newSpaceLimit!

Item was removed:
- ----- Method: SpurMemoryManager>>numStrongSlotsOf: (in category 'object access') -----
- numStrongSlotsOf: objOop
- 	"Answer the number of strong pointer fields in the given object.
- 	 Works with CompiledMethods, as well as ordinary objects."
- 	<api>
- 	<inline: true>
- 	<asmLabel: false>
- 	| fmt contextSize numLiterals |
- 	fmt := self formatOf: objOop.
- 	fmt <= self lastPointerFormat ifTrue:
- 		[fmt = self weakArrayFormat ifTrue:
- 			[^self fixedFieldsOfClass: (self fetchClassOfNonImm: objOop)].
- 		 (fmt = self indexablePointersFormat
- 		  and: [self isContextNonImm: objOop]) ifTrue:
- 			["contexts end at the stack pointer"
- 			contextSize := coInterpreter fetchStackPointerOf: objOop.
- 			^CtxtTempFrameStart + contextSize].
- 		^self numSlotsOf: objOop  "all pointers"].
- 	fmt = self forwardedFormat ifTrue: [^1].
- 	fmt < self firstCompiledMethodFormat ifTrue: [^0]. "no pointers"
- 
- 	"CompiledMethod: contains both pointers and bytes"
- 	numLiterals := coInterpreter literalCountOf: objOop.
- 	^numLiterals + LiteralStart!

Item was added:
+ ----- Method: SpurMemoryManager>>pop: (in category 'simulation only') -----
+ pop: nItems
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter pop: nItems!

Item was added:
+ ----- Method: SpurMemoryManager>>pop:thenPush: (in category 'simulation only') -----
+ pop: nItems thenPush: oop
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter pop: nItems thenPush: oop!

Item was added:
+ ----- Method: SpurMemoryManager>>positive32BitIntegerFor: (in category 'simulation only') -----
+ positive32BitIntegerFor: integerValue
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter positive32BitIntegerFor: integerValue!

Item was added:
+ ----- Method: SpurMemoryManager>>positive32BitValueOf: (in category 'simulation only') -----
+ positive32BitValueOf: oop
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter positive32BitValueOf: oop!

Item was added:
+ ----- Method: SpurMemoryManager>>positive64BitIntegerFor: (in category 'simulation only') -----
+ positive64BitIntegerFor: integerValue
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter positive64BitIntegerFor: integerValue!

Item was added:
+ ----- Method: SpurMemoryManager>>positive64BitValueOf: (in category 'simulation only') -----
+ positive64BitValueOf: oop
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter positive64BitValueOf: oop!

Item was added:
+ ----- Method: SpurMemoryManager>>primitiveFail (in category 'simulation only') -----
+ primitiveFail
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter primitiveFail!

Item was added:
+ ----- Method: SpurMemoryManager>>primitiveFailureCode (in category 'simulation only') -----
+ primitiveFailureCode
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter primitiveFailureCode!

Item was added:
+ ----- Method: SpurMemoryManager>>push: (in category 'simulation only') -----
+ push: oop
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter push: oop!

Item was added:
+ ----- Method: SpurMemoryManager>>pushBool: (in category 'simulation only') -----
+ pushBool: trueOrFalse
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter pushBool: trueOrFalse!

Item was added:
+ ----- Method: SpurMemoryManager>>pushFloat: (in category 'simulation only') -----
+ pushFloat: f
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter pushFloat: f!

Item was added:
+ ----- Method: SpurMemoryManager>>pushInteger: (in category 'simulation only') -----
+ pushInteger: integerValue
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter pushInteger: integerValue!

Item was added:
+ ----- Method: SpurMemoryManager>>showDisplayBits:Left:Top:Right:Bottom: (in category 'simulation only') -----
+ showDisplayBits: aForm Left: l Top: t Right: r Bottom: b
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter showDisplayBits: aForm Left: l Top: t Right: r Bottom: b!

Item was added:
+ ----- Method: SpurMemoryManager>>stObject:at:put: (in category 'simulation only') -----
+ stObject: objOop at: indexOop put: valueOop
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter stObject: objOop at: indexOop put: valueOop!

Item was added:
+ ----- Method: SpurMemoryManager>>stackFloatValue: (in category 'simulation only') -----
+ stackFloatValue: offset
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter stackFloatValue: offset!

Item was added:
+ ----- Method: SpurMemoryManager>>stackIntegerValue: (in category 'simulation only') -----
+ stackIntegerValue: offset
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter stackIntegerValue: offset!

Item was added:
+ ----- Method: SpurMemoryManager>>stackObjectValue: (in category 'simulation only') -----
+ stackObjectValue: offset
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter stackObjectValue: offset!

Item was added:
+ ----- Method: SpurMemoryManager>>stackValue: (in category 'simulation only') -----
+ stackValue: offset
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter stackValue: offset!

Item was added:
+ ----- Method: SpurMemoryManager>>storeInteger:ofObject:withValue: (in category 'simulation only') -----
+ storeInteger: fieldIndex ofObject: objectPointer withValue: integerValue
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter storeInteger: fieldIndex ofObject: objectPointer withValue: integerValue!

Item was added:
+ ----- Method: SpurMemoryManager>>stringOf: (in category 'simulation only') -----
+ stringOf: oop
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter stringOf: oop!

Item was added:
+ ----- Method: SpurMemoryManager>>success: (in category 'simulation only') -----
+ success: boolean
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter success: boolean!

Item was added:
+ ----- Method: SpurMemoryManager>>transcript (in category 'simulation only') -----
+ transcript
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	<doNotGenerate>
+ 	^coInterpreter transcript!

Item was added:
+ ----- Method: SpurNewSpaceSpace>>limit: (in category 'accessing') -----
+ limit: n
+ 	limit := n!

Item was added:
+ ----- Method: SpurNewSpaceSpace>>start: (in category 'accessing') -----
+ start: n
+ 	start := n!

Item was changed:
  ----- Method: StackInterpreter>>startPCOfMethod: (in category 'compiled methods') -----
  startPCOfMethod: aCompiledMethod
  	<api>
  	"Zero-relative version of CompiledMethod>>startpc."
+ 	^(self literalCountOf: aCompiledMethod) + LiteralStart * objectMemory bytesPerOop!
- 	^objectMemory lastPointerOf: aCompiledMethod!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>compileOpenPIC:numArgs: (in category 'in-line cacheing') -----
  compileOpenPIC: selector numArgs: numArgs
  	"Compile the code for an open PIC.  Perform a probe of the first-level method
  	 lookup cache followed by a call of ceSendFromOpenPIC: if the probe fails.
  	 Override to push the register args when calling ceSendFromOpenPIC:"
  	| jumpSelectorMiss jumpClassMiss itsAHit jumpBCMethod routine |
  	<var: #jumpSelectorMiss type: #'AbstractInstruction *'>
  	<var: #jumpClassMiss type: #'AbstractInstruction *'>
  	<var: #itsAHit type: #'AbstractInstruction *'>
  	<var: #jumpBCMethod type: #'AbstractInstruction *'>
  	self compilePICProlog: numArgs.
+ 	entry := objectRepresentation genGetClassTagOf: ReceiverResultReg into: ClassReg scratchReg: TempReg.
- 	self AlignmentNops: (BytesPerWord max: 8).
- 	entry := self Label.
- 	objectRepresentation genGetClassTagOf: ReceiverResultReg into: ClassReg scratchReg: TempReg.
  
  	"Do first of three probes.  See CoInterpreter>>lookupInMethodCacheSel:classTag:"
  	self flag: #lookupInMethodCacheSel:classTag:. "so this method shows up as a sender of lookupInMethodCacheSel:class:"
  	self MoveR: ClassReg R: SendNumArgsReg.
  	self annotate: (self XorCw: selector R: ClassReg) objRef: selector.
  	self LogicalShiftLeftCq: ShiftForWord R: ClassReg.
  	self AndCq: MethodCacheMask << ShiftForWord R: ClassReg.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheSelector << ShiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self annotate: (self CmpCw: selector R: TempReg) objRef: selector.
  	jumpSelectorMiss := self JumpNonZero: 0.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheClass << ShiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self CmpR: SendNumArgsReg R: TempReg.
  	jumpClassMiss := self JumpNonZero: 0.
  
  	itsAHit := self Label.
  	"Fetch the method.  The interpret trampoline requires the bytecoded method in SendNumArgsReg"
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheMethod << ShiftForWord)
  		r: ClassReg
  		R: SendNumArgsReg.
  	"If the method is compiled jump to its unchecked entry-point, otherwise interpret it."
  	objectRepresentation
  		genLoadSlot: HeaderIndex sourceReg: SendNumArgsReg destReg: TempReg.
  	self MoveR: TempReg R: ClassReg.
  	jumpBCMethod := objectRepresentation genJumpSmallIntegerInScratchReg: TempReg.
  	jumpBCMethod jmpTarget: interpretCall.
  	self AddCq: cmNoCheckEntryOffset R: ClassReg.
  	self JumpR: ClassReg.
  
  	"First probe missed.  Do second of three probes.  Shift hash right one and retry."
  	jumpSelectorMiss jmpTarget: (jumpClassMiss jmpTarget: self Label).
  	self MoveR: SendNumArgsReg R: ClassReg.
  	self annotate: (self XorCw: selector R: ClassReg) objRef: selector.
  	self LogicalShiftLeftCq: ShiftForWord - 1 R: ClassReg.
  	self AndCq: MethodCacheMask << ShiftForWord R: ClassReg.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheSelector << ShiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self annotate: (self CmpCw: selector R: TempReg) objRef: selector.
  	jumpSelectorMiss := self JumpNonZero: 0.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheClass << ShiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self CmpR: SendNumArgsReg R: TempReg.
  	self JumpZero: itsAHit.
  
  	"Second probe missed.  Do last probe.  Shift hash right two and retry."
  	jumpSelectorMiss jmpTarget: self Label.
  	self MoveR: SendNumArgsReg R: ClassReg.
  	self annotate: (self XorCw: selector R: ClassReg) objRef: selector.
  	ShiftForWord > 2 ifTrue:
  		[self LogicalShiftLeftCq: ShiftForWord - 1 R: ClassReg].
  	self AndCq: MethodCacheMask << ShiftForWord R: ClassReg.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheSelector << ShiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self annotate: (self CmpCw: selector R: TempReg) objRef: selector.
  	jumpSelectorMiss := self JumpNonZero: 0.
  	self MoveMw: coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheClass << ShiftForWord)
  		r: ClassReg
  		R: TempReg.
  	self CmpR: SendNumArgsReg R: TempReg.
  	self JumpZero: itsAHit.
  
  	"Last probe missed.  Call ceSendFromOpenPIC: to do the full lookup."
  	jumpSelectorMiss jmpTarget: self Label.
  	self genPushRegisterArgsForNumArgs: numArgs.
  	self genSaveStackPointers.
  	self genLoadCStackPointers.
  	methodLabel addDependent: (self annotateAbsolutePCRef: (self MoveCw: methodLabel asInteger R: SendNumArgsReg)).
  	cStackAlignment > BytesPerWord ifTrue:
  		[backEnd
  			genAlignCStackSavingRegisters: false
  			numArgs: 1
  			wordAlignment: cStackAlignment / BytesPerWord].
  	backEnd genPassReg: SendNumArgsReg asArgument: 0.
  	routine := self cCode: '(sqInt)ceSendFromInLineCacheMiss'
  					inSmalltalk: [self simulatedAddressFor: #ceSendFromInLineCacheMiss:].
  	self annotateCall: (self Call: routine)
  	"Note that this call does not return."!

Item was changed:
  ----- Method: VMClass class>>initializeWithOptions: (in category 'initialization') -----
+ initializeWithOptions: optionsDictionaryOrArray
- initializeWithOptions: optionsDictionary
  	"Initialize the receiver, typically initializing class variables. Initialize any class variables
  	 whose names occur in optionsDictionary with the corresponding values there-in."
+ 	| optionsDictionary |
+ 	optionsDictionary := optionsDictionaryOrArray isArray
+ 							ifTrue: [Dictionary newFromPairs: optionsDictionaryOrArray]
+ 							ifFalse: [optionsDictionaryOrArray].
  	(self withAllSuperclasses copyUpThrough: VMClass) do:
  		[:class|
  		class initializationOptions: optionsDictionary]!

Item was changed:
  ----- Method: VMStructType class>>checkGenerateFieldAccessors:bitPosition:in: (in category 'code generation') -----
  checkGenerateFieldAccessors: fieldSpecs bitPosition: firstBitPosition in: surrogateClass
+ 	| bitPosition alignedByteSize currentOffset code |
- 	| bitPosition alignedByteSize |
  	bitPosition := firstBitPosition.
  	fieldSpecs do:
+ 		[:spec|
+ 		"reset the bitPosition if the offset expression changes."
+ 		currentOffset ~= (self offsetForInstVar: spec first) ifTrue:
+ 			[bitPosition := firstBitPosition.
+ 			 currentOffset := self offsetForInstVar: spec first].
- 		[:spec| | code |
  		"If the accessor is already defined in a superclass don't redefine it in the subclass.
  		 We assume it is correctly defined in the superclass."
  		(spec first ~= #unused
  		 and: [(surrogateClass whichClassIncludesSelector: spec first asSymbol)
  				ifNil: [true]
  				ifNotNil: [:implementingClass|
  						self assert: (implementingClass inheritsFrom: Object).
  						implementingClass == surrogateClass]]) ifTrue:
  			[code := self getter: spec first
  						 bitPosition: bitPosition
  						 bitWidth: spec second
  						 type: (spec at: 3 ifAbsent: []).
  			 code ~= (surrogateClass sourceCodeAt: spec first asSymbol ifAbsent: ['']) asString ifTrue:
  				[surrogateClass compile: code classified: #accessing].
  			 code := self setter: spec first
  						 bitPosition: bitPosition
  						 bitWidth: spec second
  						 type: (spec at: 3 ifAbsent: []).
  			 code ~= (surrogateClass sourceCodeAt: (spec first, ':') asSymbol ifAbsent: ['']) asString ifTrue:
  				[surrogateClass compile: code classified: #accessing]].
  		bitPosition := bitPosition + spec second].
  	alignedByteSize := bitPosition / 8.
  	self assert: alignedByteSize isInteger.
+ 	code := 'alignedByteSize'
+ 			, (String with: Character cr with: Character tab with: $^)
+ 			, alignedByteSize printString,
+ 			(currentOffset ifNil: [''] ifNotNil: [' + self ', currentOffset]).
+ 	code ~= (surrogateClass class sourceCodeAt: #alignedByteSize) asString ifTrue:
+ 		[surrogateClass class compile: code classified: #accessing]!
- 	alignedByteSize ~= surrogateClass alignedByteSize ifTrue:
- 		[surrogateClass class
- 			compile: 'alignedByteSize'
- 					, (String with: Character cr with: Character tab with: $^)
- 					, alignedByteSize printString
- 			classified: #accessing]!

Item was changed:
  ----- Method: VMStructType class>>getter:bitPosition:bitWidth:type: (in category 'code generation') -----
  getter: getter bitPosition: bitPosition bitWidth: bitWidth type: typeOrNil
  	^String streamContents:
  		[:s| | startByte endByte alignedPowerOf2 shift bool |
  		startByte := bitPosition // 8.
  		endByte := bitPosition + bitWidth - 1 // 8.
  		shift := bitPosition \\ 8.
  		alignedPowerOf2 := (#(8 16 32 64) includes: bitWidth) and: [shift = 0].
  		s nextPutAll: getter; crtab: 1.
  		(typeOrNil notNil and: [typeOrNil last = $*]) ifTrue:
  			[s nextPutAll: '| v |'; crtab: 1].
  		s nextPut: $^.
  		typeOrNil ifNotNil:
  			[s nextPut: $(.
  			 typeOrNil last = $* ifTrue:
  				[s nextPutAll: 'v := ']].
  		alignedPowerOf2 ifFalse:
  			[s nextPut: $(].
  		shift ~= 0 ifTrue:
  			[s nextPut: $(].
  		s nextPutAll: 'memory unsigned';
  		   nextPutAll: (#('Byte' 'Short' 'Long' 'Long')
  							at: endByte - startByte + 1
  							ifAbsent: ['LongLong']);
  		  nextPutAll: 'At: address + '; print: startByte + 1.
+ 		(self offsetForInstVar: getter) ifNotNil:
+ 			[:offsetExpr| s nextPutAll: ' + '; nextPutAll: offsetExpr].
  		shift ~= 0 ifTrue:
  			[s nextPutAll: ') bitShift: -'; print: shift].
  		alignedPowerOf2 ifFalse:
  			[s nextPutAll: ') bitAnd: '; nextPutAll: ((1 << bitWidth) - 1) hex].
  		typeOrNil ifNotNil:
  			[s nextPutAll: ') ~= 0'.
  			typeOrNil last = $* ifTrue:
  				[s nextPutAll: ' ifTrue:';
  					crtab: 2;
  					nextPutAll: '[cogit cCoerceSimple: v to: ';
  					store: typeOrNil;
  					nextPut: $]]]]!

Item was added:
+ ----- Method: VMStructType class>>offsetForInstVar: (in category 'code generation') -----
+ offsetForInstVar: instVarName
+ 	"Hack to offset accesses to variables by certain values."
+ 	^nil!

Item was changed:
  ----- Method: VMStructType class>>setter:bitPosition:bitWidth:type: (in category 'code generation') -----
  setter: getter bitPosition: bitPosition bitWidth: bitWidth type: typeOrNil
  	^String streamContents:
  		[:s| | startByte endByte shift alignedPowerOf2 accessor mask expr |
  		startByte := bitPosition // 8.
  		endByte := bitPosition + bitWidth - 1 // 8.
  		shift := bitPosition \\ 8.
  		alignedPowerOf2 := (#(8 16 32 64) includes: bitWidth) and: [shift = 0].
  		accessor := 'unsigned'
  					, (#('Byte' 'Short' 'Long' 'Long')
  							at: endByte - startByte + 1
  							ifAbsent: ['LongLong'])
  					, 'At: address + '.
+ 		(self offsetForInstVar: getter) ifNotNil:
+ 			[:offsetExpr| accessor := accessor, offsetExpr, ' + '].
  		mask := #(16rFF 16rFFFF 16rFFFFFFFF 16rFFFFFFFF)
  						at: endByte - startByte + 1
  						ifAbsent: [(2 raisedTo: 64) - 1].
  		s nextPutAll: getter; nextPutAll: ': aValue'.
  		(typeOrNil notNil or: [alignedPowerOf2]) ifFalse:
  			[s crtab: 1; nextPutAll: 'self assert: (aValue between: 0 and: '; nextPutAll:  ((1 << bitWidth) - 1) hex; nextPutAll: ').'].
  		s crtab: 1.
  		alignedPowerOf2 ifTrue:
  			[s nextPut: $^].
  		s nextPutAll: 'memory';
+ 		  crtab: 2; nextPutAll: accessor; print: startByte + 1.
+ 		s crtab: 2; nextPutAll: 'put: '.
- 		  crtab: 2; nextPutAll: accessor; print: startByte + 1;
- 		  crtab: 2; nextPutAll: 'put: '.
  		typeOrNil ifNotNil:
  			[s nextPut: $(].
  		alignedPowerOf2 ifFalse:
  			[s nextPutAll: '((memory '; nextPutAll: accessor; print: startByte + 1;
  			    nextPutAll: ') bitAnd: '; nextPutAll: (mask - ((1 << bitWidth - 1) << shift)) hex;
  			    nextPutAll: ') + '].
  		expr := typeOrNil caseOf: {
  						[nil] -> ['aValue'].
  						[#Boolean] -> ['(aValue ifTrue: [1] ifFalse: [0])'] }
  					otherwise: ['(aValue ifNotNil: [aValue asUnsignedInteger] ifNil: [0])'].
  		shift = 0
  			ifTrue:
  				[s nextPutAll: expr]
  			ifFalse:
  				[s nextPut: $(; nextPutAll: expr; nextPutAll: ' bitShift: '; print: shift; nextPut: $)].
  		typeOrNil notNil ifTrue:
  			[s nextPut: $)].
  		alignedPowerOf2 ifFalse:
  			[s nextPut: $.; crtab: 1; nextPutAll: '^aValue']]!



More information about the Vm-dev mailing list