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

commits at source.squeak.org commits at source.squeak.org
Tue Feb 21 04:14:45 UTC 2012


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

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

Name: VMMaker-dtl.268
Author: dtl
Time: 20 February 2012, 11:13:18.88 pm
UUID: 5910e3cd-6f36-4ec1-bd4a-a2e3745db18c
Ancestors: VMMaker-dtl.266

VMMaker 4.8.3

Bring the simulator back to life.

Add ObjectMemorySimulator and subclasses for methods related to object memory access (methods moved from InterpreterSimulator to ObjectMemory hierarchy).

Move methods between interpreter and object memory to resolve issues exposed in simulator (but masked in the generated C).

Some object memory methods require access to interpreter, so add instance variable to support.

Some issues exist in plugin simulation. These are preexisting problems since before the object memory / interpreter refactorings.

Mark SlangTest>>testSetInstanceVariableWithAnAccessorMethod as an expected failure. This is a minor limitation of the inliner, not a bug. Keep the test but do not treat it as a failure.

Generated C code remains equivalent that that produced prior to the object memory / interpreter refactorings.

=============== Diff against VMMaker-dtl.266 ===============

Item was changed:
  ----- Method: CCodeGenerator>>addClass:asInstanceVariable: (in category 'composition') -----
  addClass: aClass asInstanceVariable: varName
  	"For an instance variable var in one of the classes that has been added to
  	this code generator, assume that an instance of aClass would normally be
  	assigned to that variable. Arrange for the methods in aClass to be incorporated
  	into the generated C source module as if they had been methods in the class
  	with instance variable var.
  	
  	n.b. See #addStructureClass: mechanism in Cog."
  
  	self addClass: aClass.
+ 	self mapVar: varName ofClass: aClass as: 'self'
- 	receiverDict at: varName asString put: 'self'.
- 	variables remove: varName ifAbsent: []
  !

Item was added:
+ ----- Method: CCodeGenerator>>mapVar:ofClass:as: (in category 'composition') -----
+ mapVar: instanceVarName ofClass: aClass as: newName
+ 	"instanceVarName is an instance variable in aClass that has been added
+ 	to this code generator. Treat sends to the object at instanceVarName as if
+ 	they were sends to newName. When newName is 'self', all such methods are
+ 	translated to C as functions in the current C module."
+ 
+ 	receiverDict at: instanceVarName asString
+ 		ifPresent: [ :var |
+ 			self error: aClass name,'>>', instanceVarName, ' previously mapped to ',
+ 				newName, ' by another class' ]
+ 		ifAbsent: [ receiverDict at: instanceVarName asString put: newName.
+ 			variables remove: instanceVarName ifAbsent: [] ]
+ !

Item was changed:
  InterpreterPrimitives subclass: #Interpreter
  	instanceVariableNames: 'activeContext theHomeContext method receiver instructionPointer stackPointer localIP localSP localHomeContext localReturnContext localReturnValue messageSelector currentBytecode primitiveIndex primitiveFunctionPointer methodCache atCache lkupClass reclaimableContextCount nextPollTick nextWakeupTick lastTick interruptPending semaphoresToSignalA semaphoresUseBufferA semaphoresToSignalCountA semaphoresToSignalB semaphoresToSignalCountB savedWindowSize fullScreenFlag deferDisplayUpdates pendingFinalizationSignals compilerInitialized compilerHooks extraVMMemory newNativeMethod methodClass receiverClass interpreterVersion imageFormatVersionNumber interpreterProxy showSurfaceFn interruptCheckCounter interruptCheckCounterFeedBackReset interruptChecksEveryNms externalPrimitiveTable primitiveTable globalSessionID jmpBuf jmpDepth jmpMax suspendedCallbacks suspendedMethods imageFormatInitialVersion'
+ 	classVariableNames: 'AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BlockArgumentCountIndex BytecodeTable CacheProbeMax CallerIndex CharacterValueIndex ClosureFirstCopiedValueIndex ClosureIndex ClosureNumArgsIndex ClosureOuterContextIndex ClosureStartPCIndex CompilerHooksSize DirBadPath DirEntryFound DirNoMoreEntries DoBalanceChecks FirstLinkIndex HomeIndex InitialIPIndex LastLinkIndex MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MessageArgumentsIndex MessageDictionaryIndex MessageLookupClassIndex MessageSelectorIndex MethodArrayIndex MethodCacheNative MethodIndex NextLinkIndex PrimitiveExternalCallIndex PrimitiveTable SelectorStart SemaphoresToSignalSize StackPointerIndex StreamArrayIndex StreamIndexIndex StreamReadLimitIndex StreamWriteLimitIndex SuperclassIndex SuspendedContextIndex TempFrameStart ValueIndex'
- 	classVariableNames: 'AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BlockArgumentCountIndex BytecodeTable CacheProbeMax CallerIndex CharacterValueIndex ClosureFirstCopiedValueIndex ClosureIndex ClosureNumArgsIndex ClosureOuterContextIndex ClosureStartPCIndex CompilerHooksSize DirBadPath DirEntryFound DirNoMoreEntries DoBalanceChecks FirstLinkIndex HomeIndex InitialIPIndex InstanceSpecificationIndex LastLinkIndex MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MessageArgumentsIndex MessageDictionaryIndex MessageLookupClassIndex MessageSelectorIndex MethodArrayIndex MethodCacheNative MethodIndex NextLinkIndex PrimitiveExternalCallIndex PrimitiveTable SelectorStart SemaphoresToSignalSize StackPointerIndex StreamArrayIndex StreamIndexIndex StreamReadLimitIndex StreamWriteLimitIndex SuperclassIndex SuspendedContextIndex TempFrameStart ValueIndex'
  	poolDictionaries: 'VMMethodCacheConstants VMSqueakV3BytecodeConstants'
  	category: 'VMMaker-Interpreter'!
  
  !Interpreter commentStamp: '<historical>' prior: 0!
  This class is a complete implementation of the Smalltalk-80 virtual machine, derived originally from the Blue Book specification but quite different in some areas.
  
  It has been modernized with 32-bit pointers, better management of Contexts, and attention to variable use that allows the CCodeGenerator (qv) to keep, eg, the instruction pointer and stack pointer in registers as well as keeping most simple variables in a global array that seems to improve performance for most platforms.
  
  In addition to SmallInteger arithmetic and Floats, it supports logic on 32-bit PositiveLargeIntegers, thus allowing it to simulate itself much more effectively than would otherwise be the case.
  
  NOTE:  Here follows a list of things to be borne in mind when working on this code, or when making changes for the future.
  
  1.  There are a number of things that should be done the next time we plan to release a copletely incompatible image format.  These include unifying the instanceSize field of the class format word -- see instantiateClass:indexableSize:, and unifying the bits of the method primitive index (if we decide we need more than 512, after all) -- see primitiveIndexOf:.  Also, contexts should be given a special format code (see next item).
  
  2.  There are several fast checks for contexts (see isContextHeader: and isMethodContextHeader:) which will fail if the compact class indices of BlockContext or MethodContext change.  This is necessary because the oops may change during a compaction when the oops are being adjusted.  It's important to be aware of this when writing a new image using the systemTracer.  A better solution would be to reserve one of the format codes for Contexts only.
  
  3.  We have made normal files tolerant to size and positions up to 32 bits.  This has not been done for async files, since they are still experimental.  The code in size, at: and at:put: should work with sizes and indices up to 31 bits, although I have not tested it (di 12/98); it might or might not work with 32-bit sizes.
  
  4.  Note that 0 is used in a couple of places as an impossible oop.  This should be changed to a constant that really is impossible (or perhaps there is code somewhere that guarantees it --if so it should be put in this comment).  The places include the method cache and the at cache. !

Item was removed:
- ----- Method: Interpreter class>>initializeCodeGenerator: (in category 'translation') -----
- initializeCodeGenerator: cg
- 	"Load a code generator with classes in a manner suitable for generating
- 	code for this class."
- 
- 	super initializeCodeGenerator: cg.
- 	cg addClass: ObjectMemory asInstanceVariable: #objectMemory.
- 	^cg
- !

Item was changed:
  ----- Method: Interpreter>>activateNewClosureMethod: (in category 'control primitives') -----
  activateNewClosureMethod: blockClosure
  	"Similar to activateNewMethod but for Closure and newMethod."
  	| theBlockClosure closureMethod newContext methodHeader numCopied where outerContext |
  
  	DoAssertionChecks ifTrue:
+ 		[objectMemory okayOop: blockClosure].
- 		[self okayOop: blockClosure].
  	outerContext := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: blockClosure.
  	DoAssertionChecks ifTrue:
+ 		[objectMemory okayOop: outerContext].
- 		[self okayOop: outerContext].
  	closureMethod := objectMemory fetchPointer: MethodIndex ofObject: outerContext.
  	methodHeader := self headerOf: closureMethod.
  	objectMemory pushRemappableOop: blockClosure.
  	newContext := objectMemory allocateOrRecycleContext: (methodHeader bitAnd: LargeContextBit). "All for one, and one for all!!"
  
  	"allocateOrRecycleContext: may cause a GC; restore blockClosure and refetch outerContext et al"
  	theBlockClosure := objectMemory popRemappableOop.
  	outerContext := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: theBlockClosure.
  	numCopied := (objectMemory fetchWordLengthOf: theBlockClosure) - ClosureFirstCopiedValueIndex.
  
  	"Assume: newContext will be recorded as a root if necessary by the
  	 call to newActiveContext: below, so we can use unchecked stores."
  	where :=  newContext + objectMemory baseHeaderSize.
+ 	objectMemory longAt: where + (SenderIndex << objectMemory shiftForWord)
- 	self longAt: where + (SenderIndex << objectMemory shiftForWord)
  		put: activeContext.
+ 	objectMemory longAt: where + (InstructionPointerIndex << objectMemory shiftForWord)
- 	self longAt: where + (InstructionPointerIndex << objectMemory shiftForWord)
  		put: (objectMemory fetchPointer: ClosureStartPCIndex ofObject: theBlockClosure).
+ 	objectMemory longAt: where + (StackPointerIndex << objectMemory shiftForWord)
- 	self longAt: where + (StackPointerIndex << objectMemory shiftForWord)
  		put: (objectMemory integerObjectOf: argumentCount + numCopied).
+ 	objectMemory longAt: where + (MethodIndex << objectMemory shiftForWord)
- 	self longAt: where + (MethodIndex << objectMemory shiftForWord)
  		put: (objectMemory fetchPointer: MethodIndex ofObject: outerContext).
+ 	objectMemory longAt: where + (ClosureIndex << objectMemory shiftForWord)
- 	self longAt: where + (ClosureIndex << objectMemory shiftForWord)
  		put: theBlockClosure.
+ 	objectMemory longAt: where + (ReceiverIndex << objectMemory shiftForWord)
- 	self longAt: where + (ReceiverIndex << objectMemory shiftForWord)
  		put: (objectMemory fetchPointer: ReceiverIndex ofObject: outerContext).
  
  	"Copy the arguments..."
  	1 to: argumentCount do:
+ 		[:i | objectMemory longAt: where + ((ReceiverIndex+i) << objectMemory shiftForWord)
- 		[:i | self longAt: where + ((ReceiverIndex+i) << objectMemory shiftForWord)
  				put: (self stackValue: argumentCount-i)].
  
  	"Copy the copied values..."
  	where := newContext + objectMemory baseHeaderSize + ((ReceiverIndex + 1 + argumentCount) << objectMemory shiftForWord).
  	0 to: numCopied - 1 do:
+ 		[:i| objectMemory longAt: where + (i << objectMemory shiftForWord)
- 		[:i| self longAt: where + (i << objectMemory shiftForWord)
  				put: (objectMemory fetchPointer: i + ClosureFirstCopiedValueIndex
  						  ofObject: theBlockClosure)].
  
  	"The initial instructions in the block nil-out remaining temps."
  
  	self pop: argumentCount + 1.
  	self newActiveContext: newContext!

Item was changed:
  ----- Method: Interpreter>>activateNewMethod (in category 'message sending') -----
  activateNewMethod
  	| newContext methodHeader initialIP tempCount nilOop where |
  
  	methodHeader := self headerOf: newMethod.
  	newContext := objectMemory allocateOrRecycleContext: (methodHeader bitAnd: LargeContextBit).
  
  	initialIP := ((LiteralStart + (self literalCountOfHeader: methodHeader)) * objectMemory bytesPerWord) + 1.
  	tempCount := (methodHeader >> 19) bitAnd: 16r3F.
  
  	"Assume: newContext will be recorded as a root if necessary by the
  	 call to newActiveContext: below, so we can use unchecked stores."
  
  	where :=  newContext  + objectMemory baseHeaderSize.
+ 	objectMemory longAt: where + (SenderIndex << objectMemory shiftForWord) put: activeContext.
+ 	objectMemory longAt: where + (InstructionPointerIndex << objectMemory shiftForWord) put: (objectMemory integerObjectOf: initialIP).
+ 	objectMemory longAt: where + (StackPointerIndex << objectMemory shiftForWord) put: (objectMemory integerObjectOf: tempCount).
+ 	objectMemory longAt: where + (MethodIndex << objectMemory shiftForWord) put: newMethod.
+ 	objectMemory longAt: where + (ClosureIndex << objectMemory shiftForWord) put: objectMemory nilObj.
- 	self longAt: where + (SenderIndex << objectMemory shiftForWord) put: activeContext.
- 	self longAt: where + (InstructionPointerIndex << objectMemory shiftForWord) put: (objectMemory integerObjectOf: initialIP).
- 	self longAt: where + (StackPointerIndex << objectMemory shiftForWord) put: (objectMemory integerObjectOf: tempCount).
- 	self longAt: where + (MethodIndex << objectMemory shiftForWord) put: newMethod.
- 	self longAt: where + (ClosureIndex << objectMemory shiftForWord) put: objectMemory nilObj.
  
  	"Copy the receiver and arguments..."
  	0 to: argumentCount do:
+ 		[:i | objectMemory longAt: where + ((ReceiverIndex+i) << objectMemory shiftForWord) put: (self stackValue: argumentCount-i)].
- 		[:i | self longAt: where + ((ReceiverIndex+i) << objectMemory shiftForWord) put: (self stackValue: argumentCount-i)].
  
  	"clear remaining temps to nil in case it has been recycled"
  	nilOop := objectMemory nilObj.
  	argumentCount+1+ReceiverIndex to: tempCount+ReceiverIndex do:
+ 		[:i | objectMemory longAt: where + (i << objectMemory shiftForWord) put: nilOop].
- 		[:i | self longAt: where + (i << objectMemory shiftForWord) put: nilOop].
  
  	self pop: argumentCount + 1.
  	reclaimableContextCount := reclaimableContextCount + 1.
  	self newActiveContext: newContext.!

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

Item was removed:
- ----- Method: Interpreter>>byteSizeOf: (in category 'object format') -----
- byteSizeOf: oop
- 	| slots |
- self flag: #Dan.
- 	(objectMemory isIntegerObject: oop) ifTrue:[^0].
- 	slots := self slotSizeOf: oop.
- 	(objectMemory isBytesNonInt: oop)
- 		ifTrue:[^slots]
- 		ifFalse:[^slots * 4]!

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

Item was changed:
  ----- Method: Interpreter>>changeClassOf:to: (in category 'object access primitives') -----
  changeClassOf: rcvr to: argClass
  	"Change the class of the receiver into the class specified by the argument given that the format of the receiver matches the format of the argument. Fail if receiver or argument are SmallIntegers, or the receiver is an instance of a compact class and the argument isn't, or when the argument's class is compact and the receiver isn't, or when the format of the receiver is different from the format of the argument's class, or when the arguments class is fixed and the receiver's size differs from the size that an instance of the argument's class should have."
  	| classHdr sizeHiBits byteSize argFormat rcvrFormat ccIndex |
  	"Check what the format of the class says"
+ 	classHdr := objectMemory formatOfClass: argClass. "Low 2 bits are 0"
- 	classHdr := self formatOfClass: argClass. "Low 2 bits are 0"
  
  	"Compute the size of instances of the class (used for fixed field classes only)"
  	sizeHiBits := (classHdr bitAnd: 16r60000) >> 9.
  	classHdr := classHdr bitAnd: 16r1FFFF.
  	byteSize := (classHdr bitAnd: objectMemory sizeMask) + sizeHiBits. "size in bytes -- low 2 bits are 0"
  
  	"Check the receiver's format against that of the class"
  	argFormat := (classHdr >> 8) bitAnd: 16rF.
  	rcvrFormat := objectMemory formatOf: rcvr.
  	argFormat = rcvrFormat ifFalse:[^self primitiveFail]. "no way"
  
  	"For fixed field classes, the sizes must match.
  	Note: byteSize-4 because base header is included in class size."
+ 	argFormat < 2 ifTrue:[(byteSize - objectMemory baseHeaderSize) = (objectMemory byteSizeOf: rcvr) ifFalse:[^self primitiveFail]].
- 	argFormat < 2 ifTrue:[(byteSize - objectMemory baseHeaderSize) = (self byteSizeOf: rcvr) ifFalse:[^self primitiveFail]].
  
  	(objectMemory headerType: rcvr) = HeaderTypeShort
  		ifTrue:[ "Compact classes. Check if the arg's class is compact and exchange ccIndex"
  			ccIndex := classHdr bitAnd: CompactClassMask.
  			ccIndex = 0 ifTrue:[^self primitiveFail]. "class is not compact"
+ 			objectMemory longAt: rcvr put:
+ 				(((objectMemory longAt: rcvr) bitAnd: CompactClassMask bitInvert32)
- 			self longAt: rcvr put:
- 				(((self longAt: rcvr) bitAnd: CompactClassMask bitInvert32)
  					bitOr: ccIndex)]
  		ifFalse:["Exchange the class pointer, which could make rcvr a root for argClass"
+ 			objectMemory longAt: rcvr - objectMemory baseHeaderSize put: (argClass bitOr: (objectMemory headerType: rcvr)).
- 			self longAt: rcvr - objectMemory baseHeaderSize put: (argClass bitOr: (objectMemory headerType: rcvr)).
  			(objectMemory oop: rcvr isLessThan: objectMemory youngStart)
  				ifTrue: [objectMemory possibleRootStoreInto: rcvr value: argClass]].
  
  	"Flush cache because rcvr's class has changed"
  	self flushMethodCache.
  !

Item was added:
+ ----- Method: Interpreter>>characterTable (in category 'plugin support') -----
+ characterTable
+ 	^objectMemory splObj: CharacterTable!

Item was changed:
  ----- Method: Interpreter>>commonVariable:at:cacheIndex: (in category 'array primitive support') -----
  commonVariable: rcvr at: index cacheIndex: atIx 
  	"This code assumes the receiver has been identified at location atIx in the atCache."
  	| stSize fmt fixedFields result |
  
  	stSize := atCache at: atIx+AtCacheSize.
  	((objectMemory oop: index isGreaterThanOrEqualTo: 1)
  		and: [objectMemory oop: index isLessThanOrEqualTo: stSize])
  	ifTrue:
  		[fmt := atCache at: atIx+AtCacheFmt.
  		fmt <= 4 ifTrue:
  			[fixedFields := atCache at: atIx+AtCacheFixedFields.
  			^ objectMemory fetchPointer: index + fixedFields - 1 ofObject: rcvr].
  		fmt < 8 ifTrue:  "Bitmap"
  			[result := objectMemory fetchLong32: index - 1 ofObject: rcvr.
+ 			result := objectMemory positive32BitIntegerFor: result.
- 			result := self positive32BitIntegerFor: result.
  			^ result].
  		fmt >= 16  "Note fmt >= 16 is an artificial flag for strings"
  			ifTrue: "String"
  			[^ self characterForAscii: (objectMemory fetchByte: index - 1 ofObject: rcvr)]
  			ifFalse: "ByteArray"
  			[^ objectMemory integerObjectOf: (objectMemory fetchByte: index - 1 ofObject: rcvr)]].
  
  	self primitiveFail!

Item was changed:
  ----- Method: Interpreter>>commonVariableInternal:at:cacheIndex: (in category 'array primitive support') -----
  commonVariableInternal: rcvr at: index cacheIndex: atIx 
  	"This code assumes the receiver has been identified at location atIx in the atCache."
  	| stSize fmt fixedFields result |
  	<inline: true>
  
  	stSize := atCache at: atIx+AtCacheSize.
  	((objectMemory oop: index isGreaterThanOrEqualTo: 1)
  		and: [objectMemory oop: index isLessThanOrEqualTo: stSize])
  	ifTrue:
  		[fmt := atCache at: atIx+AtCacheFmt.
  		fmt <= 4 ifTrue:
  			[fixedFields := atCache at: atIx+AtCacheFixedFields.
  			^ objectMemory fetchPointer: index + fixedFields - 1 ofObject: rcvr].
  		fmt < 8 ifTrue:  "Bitmap"
  			[result := objectMemory fetchLong32: index - 1 ofObject: rcvr.
  			self externalizeIPandSP.
+ 			result := objectMemory positive32BitIntegerFor: result.
- 			result := self positive32BitIntegerFor: result.
  			self internalizeIPandSP.
  			^ result].
  		fmt >= 16  "Note fmt >= 16 is an artificial flag for strings"
  			ifTrue: "String"
  			[^ self characterForAscii: (objectMemory fetchByte: index - 1 ofObject: rcvr)]
  			ifFalse: "ByteArray"
  			[^ objectMemory integerObjectOf: (objectMemory fetchByte: index - 1 ofObject: rcvr)]].
  
  	self primitiveFail!

Item was changed:
  ----- Method: Interpreter>>externalizeIPandSP (in category 'utilities') -----
  externalizeIPandSP
  	"Copy the local instruction and stack pointer to global variables for use in primitives and other functions outside the interpret loop."
  
+ 	instructionPointer := objectMemory oopForPointer: localIP.
+ 	stackPointer := objectMemory oopForPointer: localSP.
- 	instructionPointer := self oopForPointer: localIP.
- 	stackPointer := self oopForPointer: localSP.
  	theHomeContext := localHomeContext.
  !

Item was changed:
  ----- Method: Interpreter>>fetchByte (in category 'interpreter shell') -----
  fetchByte
  	"This method uses the preIncrement builtin function which has no Smalltalk equivalent. Thus, it must be overridden in the simulator."
  
+ 	^ objectMemory byteAtPointer: localIP preIncrement!
- 	^ self byteAtPointer: localIP preIncrement!

Item was changed:
  ----- Method: Interpreter>>fetchContextRegisters: (in category 'contexts') -----
  fetchContextRegisters: activeCntx 
  	"Note: internalFetchContextRegisters: should track changes  to this method."
  	| tmp |
  	<inline: true>
  	tmp := objectMemory fetchPointer: MethodIndex ofObject: activeCntx.
  	(objectMemory isIntegerObject: tmp)
  		ifTrue: ["if the MethodIndex field is an integer, activeCntx is a block context"
  			tmp := objectMemory fetchPointer: HomeIndex ofObject: activeCntx.
  			(objectMemory oop: tmp isLessThan: objectMemory youngStart) ifTrue: [objectMemory beRootIfOld: tmp]]
  		ifFalse: ["otherwise, it is a method context and is its own home context "
  			tmp := activeCntx].
  	theHomeContext := tmp.
  	receiver := objectMemory fetchPointer: ReceiverIndex ofObject: tmp.
  	method := objectMemory fetchPointer: MethodIndex ofObject: tmp.
  
  	"the instruction pointer is a pointer variable equal to 
+ 	method oop + ip + objectMemory baseHeaderSize 
- 	method oop + ip + self baseHeaderSize 
  	-1 for 0-based addressing of fetchByte 
  	-1 because it gets incremented BEFORE fetching currentByte "
  	tmp := self quickFetchInteger: InstructionPointerIndex ofObject: activeCntx.
  	instructionPointer := method + tmp + objectMemory baseHeaderSize - 2.
  
  	"the stack pointer is a pointer variable also..."
  	tmp := self quickFetchInteger: StackPointerIndex ofObject: activeCntx.
  	stackPointer := activeCntx + objectMemory baseHeaderSize + (TempFrameStart + tmp - 1 * objectMemory bytesPerWord)!

Item was removed:
- ----- Method: Interpreter>>firstFixedField: (in category 'plugin support') -----
- firstFixedField: oop
- 
- 	<returnTypeC: 'char *'>
- 	^ self pointerForOop: oop + objectMemory baseHeaderSize!

Item was removed:
- ----- Method: Interpreter>>firstIndexableField: (in category 'plugin support') -----
- firstIndexableField: oop
- 	"NOTE: copied in InterpreterSimulator, so please duplicate any changes"
- 
- 	| hdr fmt totalLength fixedFields |
- 	<returnTypeC: 'char *'>
- 	hdr := objectMemory baseHeader: oop.
- 	fmt := (hdr >> 8) bitAnd: 16rF.
- 	totalLength := self lengthOf: oop baseHeader: hdr format: fmt.
- 	fixedFields := self fixedFieldsOf: oop format: fmt length: totalLength.
- 	fmt < 8 ifTrue:
- 		[fmt = 6 ifTrue:
- 			["32 bit field objects"
- 			^ self pointerForOop: oop + objectMemory baseHeaderSize + (fixedFields << 2)].
- 		"full word objects (pointer or bits)"
- 		^ self pointerForOop: oop + objectMemory baseHeaderSize + (fixedFields << objectMemory shiftForWord)]
- 	ifFalse:
- 		["Byte objects"
- 		^ self pointerForOop: oop + objectMemory baseHeaderSize + fixedFields]!

Item was removed:
- ----- Method: Interpreter>>fixedFieldsOf:format:length: (in category 'object format') -----
- fixedFieldsOf: oop format: fmt length: wordLength
- "
- 	NOTE: This code supports the backward-compatible extension to 8 bits of instSize.
- 	When we revise the image format, it should become...
- 	^ (classFormat >> 2 bitAnd: 16rFF) - 1
- "
- 	| class classFormat |
- 	<inline: true>
- 	((fmt > 4) or: [fmt = 2]) ifTrue: [^ 0].  "indexable fields only"
- 	fmt < 2 ifTrue: [^ wordLength].  "fixed fields only (zero or more)"
- 	
- 	"fmt = 3 or 4: mixture of fixed and indexable fields, so must look at class format word"
- 	class := objectMemory fetchClassOf: oop.
- 	classFormat := self formatOfClass: class.
- 	^ (classFormat >> 11 bitAnd: 16rC0) + (classFormat >> 2 bitAnd: 16r3F) - 1
- !

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

Item was removed:
- ----- Method: Interpreter>>formatOfClass: (in category 'object format') -----
- formatOfClass: classPointer
- 	"**should be in-lined**"
- 	"Note that, in Smalltalk, the instSpec will be equal to the inst spec
- 	part of the base header of an instance (without hdr type) shifted left 1.
- 	In this way, apart from the smallInt bit, the bits
- 	are just where you want them for the first header word."
- 	"Callers expect low 2 bits (header type) to be zero!!"
- 
- 	^ (objectMemory fetchPointer: InstanceSpecificationIndex ofObject: classPointer) - 1!

Item was changed:
  ----- Method: Interpreter>>getCurrentBytecode (in category 'interpreter shell') -----
  getCurrentBytecode
  	"currentBytecode will be private to the main dispatch loop in the generated code. This method allows the currentBytecode to be retrieved from global variables."
  
+ 	^ objectMemory byteAt: instructionPointer!
- 	^ self byteAt: instructionPointer!

Item was changed:
  ----- Method: Interpreter>>initialCleanup (in category 'initialization') -----
  initialCleanup
  	"Images written by VMs earlier than 3.6/3.7 will wrongly have the root bit set on the active context. Besides clearing the root bit, we treat this as a marker that these images also lack a cleanup of external primitives (which has been introduced at the same time when the root bit problem was fixed). In this case, we merely flush them from here."
  
+ 	((objectMemory longAt: activeContext) bitAnd: objectMemory rootBit) = 0 ifTrue:[^nil]. "root bit is clean"
- 	((self longAt: activeContext) bitAnd: objectMemory rootBit) = 0 ifTrue:[^nil]. "root bit is clean"
  	"Clean root bit of activeContext"
+ 	objectMemory longAt: activeContext put: ((objectMemory longAt: activeContext) bitAnd: objectMemory allButRootBit).
- 	self longAt: activeContext put: ((self longAt: activeContext) bitAnd: objectMemory allButRootBit).
  	"Clean external primitives"
  	self flushExternalPrimitives.!

Item was changed:
  ----- Method: Interpreter>>install:inAtCache:at:string: (in category 'indexing primitives') -----
  install: rcvr inAtCache: cache at: atIx string: stringy
  	"Install the oop of this object in the given cache (at or atPut), along with
  	its size, format and fixedSize"
  	| hdr fmt totalLength fixedFields |
  	<var: #cache type: 'sqInt *'>
  
  	hdr := objectMemory baseHeader: rcvr.
  	fmt := (hdr >> 8) bitAnd: 16rF.
  	(fmt = 3 and: [self isContextHeader: hdr]) ifTrue:
  		["Contexts must not be put in the atCache, since their size is not constant"
  		^ self primitiveFail].
  	totalLength := self lengthOf: rcvr baseHeader: hdr format: fmt.
+ 	fixedFields := objectMemory fixedFieldsOf: rcvr format: fmt length: totalLength.
- 	fixedFields := self fixedFieldsOf: rcvr format: fmt length: totalLength.
  
  	cache at: atIx+AtCacheOop put: rcvr.
  	stringy ifTrue: [cache at: atIx+AtCacheFmt put: fmt + 16]  "special flag for strings"
  			ifFalse: [cache at: atIx+AtCacheFmt put: fmt].
  	cache at: atIx+AtCacheFixedFields put: fixedFields.
  	cache at: atIx+AtCacheSize put: totalLength - fixedFields.
  !

Item was changed:
  ----- Method: Interpreter>>internalActivateNewMethod (in category 'message sending') -----
  internalActivateNewMethod
  	| methodHeader newContext tempCount argCount2 needsLarge where |
  	<inline: true>
  
  	methodHeader := self headerOf: newMethod.
  	needsLarge := methodHeader bitAnd: LargeContextBit.
  	(needsLarge = 0 and: [objectMemory freeContexts ~= objectMemory nilContext])
  		ifTrue: [newContext := objectMemory freeContexts.
  				objectMemory setFreeContextsAfter: newContext]
  		ifFalse: ["Slower call for large contexts or empty free list"
  				self externalizeIPandSP.
  				newContext := objectMemory allocateOrRecycleContext: needsLarge.
  				self internalizeIPandSP].
  	tempCount := (methodHeader >> 19) bitAnd: 16r3F.
  
  	"Assume: newContext will be recorded as a root if necessary by the
  	 call to newActiveContext: below, so we can use unchecked stores."
  	where :=   newContext + objectMemory baseHeaderSize.
+ 	objectMemory longAt: where + (SenderIndex << objectMemory shiftForWord) put: activeContext.
+ 	objectMemory longAt: where + (InstructionPointerIndex << objectMemory shiftForWord)
- 	self longAt: where + (SenderIndex << objectMemory shiftForWord) put: activeContext.
- 	self longAt: where + (InstructionPointerIndex << objectMemory shiftForWord)
  		put: (objectMemory integerObjectOf: (((LiteralStart + (self literalCountOfHeader: methodHeader)) * objectMemory bytesPerWord) + 1)).
+ 	objectMemory longAt: where + (StackPointerIndex << objectMemory shiftForWord) put: (objectMemory integerObjectOf: tempCount).
+ 	objectMemory longAt: where + (MethodIndex << objectMemory shiftForWord) put: newMethod.
+ 	objectMemory longAt: where + (ClosureIndex << objectMemory shiftForWord) put: objectMemory nilObj.
- 	self longAt: where + (StackPointerIndex << objectMemory shiftForWord) put: (objectMemory integerObjectOf: tempCount).
- 	self longAt: where + (MethodIndex << objectMemory shiftForWord) put: newMethod.
- 	self longAt: where + (ClosureIndex << objectMemory shiftForWord) put: objectMemory nilObj.
  
  	"Copy the receiver and arguments..."
  	argCount2 := argumentCount.
  	0 to: argCount2 do:
+ 		[:i | objectMemory longAt: where + ((ReceiverIndex+i) << objectMemory shiftForWord) put: (self internalStackValue: argCount2-i)].
- 		[:i | self longAt: where + ((ReceiverIndex+i) << objectMemory shiftForWord) put: (self internalStackValue: argCount2-i)].
  
  	"clear remaining temps to nil in case it has been recycled"
  	methodHeader := objectMemory nilObj.  "methodHeader here used just as faster (register?) temp"
  	argCount2+1+ReceiverIndex to: tempCount+ReceiverIndex do:
+ 		[:i | objectMemory longAt: where + (i << objectMemory shiftForWord) put: methodHeader].
- 		[:i | self longAt: where + (i << objectMemory shiftForWord) put: methodHeader].
  
  	self internalPop: argCount2 + 1.
  	reclaimableContextCount := reclaimableContextCount + 1.
  	self internalNewActiveContext: newContext.
   !

Item was changed:
  ----- Method: Interpreter>>internalFetchContextRegisters: (in category 'contexts') -----
  internalFetchContextRegisters: activeCntx
  	"Inlined into return bytecodes. The only difference between this method and fetchContextRegisters: is that this method sets the local IP and SP."
  
  	| tmp |
  	<inline: true>
  	tmp := objectMemory fetchPointer: MethodIndex ofObject: activeCntx.
  	(objectMemory isIntegerObject: tmp) ifTrue: [
  		"if the MethodIndex field is an integer, activeCntx is a block context"
  		tmp := objectMemory fetchPointer: HomeIndex ofObject: activeCntx.
  		(objectMemory oop: tmp isLessThan: objectMemory youngStart) ifTrue: [ objectMemory beRootIfOld: tmp ].
  	] ifFalse: [
  		"otherwise, it is a method context and is its own home context"
  		tmp := activeCntx.
  	].
  	localHomeContext := tmp.
  	receiver := objectMemory fetchPointer: ReceiverIndex ofObject: tmp.
  	method := objectMemory fetchPointer: MethodIndex ofObject: tmp.
  
  	"the instruction pointer is a pointer variable equal to
+ 		method oop + ip + objectMemory baseHeaderSize
- 		method oop + ip + self baseHeaderSize
  		  -1 for 0-based addressing of fetchByte
  		  -1 because it gets incremented BEFORE fetching currentByte"
  	tmp := self quickFetchInteger: InstructionPointerIndex ofObject: activeCntx.
+ 	localIP := objectMemory pointerForOop: method + tmp + objectMemory baseHeaderSize - 2.
- 	localIP := self pointerForOop: method + tmp + objectMemory baseHeaderSize - 2.
  
  	"the stack pointer is a pointer variable also..."
  	tmp := self quickFetchInteger: StackPointerIndex ofObject: activeCntx.
+ 	localSP := objectMemory pointerForOop: activeCntx + objectMemory baseHeaderSize + ((TempFrameStart + tmp - 1) * objectMemory bytesPerWord)!
- 	localSP := self pointerForOop: activeCntx + objectMemory baseHeaderSize + ((TempFrameStart + tmp - 1) * objectMemory bytesPerWord)!

Item was changed:
  ----- Method: Interpreter>>internalJustActivateNewMethod (in category 'message sending') -----
  internalJustActivateNewMethod
  	"Activate the new method but *do not* copy receiver or arguments from activeContext."
  	| methodHeader initialIP newContext tempCount needsLarge where |
  	<inline: true>
  
  	methodHeader := self headerOf: newMethod.
  	needsLarge := methodHeader bitAnd: LargeContextBit.
  	(needsLarge = 0 and: [objectMemory freeContexts ~= objectMemory  nilContext])
  		ifTrue: [newContext := objectMemory freeContexts.
  				objectMemory setFreeContextsAfter: newContext]
  		ifFalse: ["Slower call for large contexts or empty free list"
  				newContext := objectMemory allocateOrRecycleContext: needsLarge].
  	initialIP := ((LiteralStart + (self literalCountOfHeader: methodHeader)) * objectMemory bytesPerWord) + 1.
  	tempCount := (methodHeader >> 19) bitAnd: 16r3F.
  
  	"Assume: newContext will be recorded as a root if necessary by the
  	 call to newActiveContext: below, so we can use unchecked stores."
  	where := newContext + objectMemory baseHeaderSize.
+ 	objectMemory longAt: where + (SenderIndex << objectMemory shiftForWord) put: activeContext.
+ 	objectMemory longAt: where + (InstructionPointerIndex << objectMemory shiftForWord) put: (objectMemory integerObjectOf: initialIP).
+ 	objectMemory longAt: where + (StackPointerIndex << objectMemory shiftForWord) put: (objectMemory integerObjectOf: tempCount).
+ 	objectMemory longAt: where + (MethodIndex << objectMemory shiftForWord) put: newMethod.
- 	self longAt: where + (SenderIndex << objectMemory shiftForWord) put: activeContext.
- 	self longAt: where + (InstructionPointerIndex << objectMemory shiftForWord) put: (objectMemory integerObjectOf: initialIP).
- 	self longAt: where + (StackPointerIndex << objectMemory shiftForWord) put: (objectMemory integerObjectOf: tempCount).
- 	self longAt: where + (MethodIndex << objectMemory shiftForWord) put: newMethod.
  
  	"Set the receiver..."
+ 	objectMemory longAt: where + (ReceiverIndex << objectMemory shiftForWord) put: receiver.
- 	self longAt: where + (ReceiverIndex << objectMemory shiftForWord) put: receiver.
  
  	"clear all args and temps to nil in case it has been recycled"
  	needsLarge := objectMemory nilObj.  "needsLarge here used just as faster (register?) temp"
  	ReceiverIndex + 1 to: tempCount + ReceiverIndex do:
+ 		[:i | objectMemory longAt: where + (i << objectMemory shiftForWord) put: needsLarge].
- 		[:i | self longAt: where + (i << objectMemory shiftForWord) put: needsLarge].
  	reclaimableContextCount := reclaimableContextCount + 1.
  
  	activeContext := newContext.!

Item was changed:
  ----- Method: Interpreter>>internalPop:thenPush: (in category 'contexts') -----
  internalPop: nItems thenPush: oop
  
+ 	objectMemory longAtPointer: (localSP := localSP - ((nItems - 1) * objectMemory bytesPerWord)) put: oop.
- 	self longAtPointer: (localSP := localSP - ((nItems - 1) * objectMemory bytesPerWord)) put: oop.
  !

Item was changed:
  ----- Method: Interpreter>>internalPush: (in category 'contexts') -----
  internalPush: object
  
+ 	objectMemory longAtPointer: (localSP := localSP + objectMemory bytesPerWord) put: object.!
- 	self longAtPointer: (localSP := localSP + objectMemory bytesPerWord) put: object.!

Item was changed:
  ----- Method: Interpreter>>internalStackTop (in category 'contexts') -----
  internalStackTop
  
+ 	^ objectMemory longAtPointer: localSP!
- 	^ self longAtPointer: localSP!

Item was changed:
  ----- Method: Interpreter>>internalStackValue: (in category 'contexts') -----
  internalStackValue: offset
  
+ 	^ objectMemory longAtPointer: localSP - (offset * objectMemory bytesPerWord)!
- 	^ self longAtPointer: localSP - (offset * objectMemory bytesPerWord)!

Item was changed:
  ----- Method: Interpreter>>internalStoreContextRegisters: (in category 'contexts') -----
  internalStoreContextRegisters: activeCntx
  	"The only difference between this method and fetchContextRegisters: is that this method stores from the local IP and SP."
  
  	"InstructionPointer is a pointer variable equal to
+ 	method oop + ip + objectMemory baseHeaderSize
- 	method oop + ip + self baseHeaderSize
  		-1 for 0-based addressing of fetchByte
  		-1 because it gets incremented BEFORE fetching currentByte"
  
  	<inline: true>
  	objectMemory storePointerUnchecked: InstructionPointerIndex ofObject: activeCntx
  		withValue: (objectMemory integerObjectOf: 
+ 			((objectMemory oopForPointer: localIP) + 2 - (method + objectMemory baseHeaderSize))).
- 			((self oopForPointer: localIP) + 2 - (method + objectMemory baseHeaderSize))).
  	objectMemory storePointerUnchecked: StackPointerIndex		  ofObject: activeCntx
  		withValue: (objectMemory integerObjectOf:
+ 			((((objectMemory oopForPointer: localSP) - (activeCntx + objectMemory baseHeaderSize)) >> objectMemory shiftForWord) - TempFrameStart + 1)).
- 			((((self oopForPointer: localSP) - (activeCntx + objectMemory baseHeaderSize)) >> objectMemory shiftForWord) - TempFrameStart + 1)).
  !

Item was changed:
  ----- Method: Interpreter>>internalizeIPandSP (in category 'utilities') -----
  internalizeIPandSP
  	"Copy the local instruction and stack pointer to local variables for rapid access within the interpret loop."
  
+ 	localIP := objectMemory pointerForOop: instructionPointer.
+ 	localSP := objectMemory pointerForOop: stackPointer.
- 	localIP := self pointerForOop: instructionPointer.
- 	localSP := self pointerForOop: stackPointer.
  	localHomeContext := theHomeContext.
  !

Item was changed:
  ----- Method: Interpreter>>jump: (in category 'jump bytecodes') -----
  jump: offset
  
  	localIP := localIP + offset + 1.
+ 	currentBytecode := objectMemory byteAtPointer: localIP.
- 	currentBytecode := self byteAtPointer: localIP.
  !

Item was removed:
- ----- Method: Interpreter>>nonWeakFieldsOf: (in category 'object format') -----
- nonWeakFieldsOf: oop
- 	"Return the number of non-weak fields in oop (i.e. the number of fixed fields).
- 	Note: The following is copied from fixedFieldsOf:format:length: since we do know
- 	the format of the oop (e.g. format = 4) and thus don't need the length."
- 	| class classFormat |
- 	<inline: false> "No need to inline - we won't call this often"
- 
- 	(objectMemory isWeakNonInt: oop) ifFalse:[self error:'Called fixedFieldsOfWeak: with a non-weak oop'].
- 
- 	"fmt = 3 or 4: mixture of fixed and indexable fields, so must look at class format word"
- 	class := objectMemory fetchClassOf: oop.
- 	classFormat := self formatOfClass: class.
- 	^ (classFormat >> 11 bitAnd: 16rC0) + (classFormat >> 2 bitAnd: 16r3F) - 1
- !

Item was changed:
  ----- Method: Interpreter>>normalizeFloatOrderingInImage (in category 'image save/restore') -----
  normalizeFloatOrderingInImage
  	"Float objects were saved in platform word ordering. Reorder them into the
  	traditional object format."
  
  	<inline: false>
  	<var: #floatData type: 'unsigned int *'>
  	<var: #val type: 'unsigned int'>
  	self isBigEnder
  		ifFalse: [ | oop | "Swap words within Float objects, taking them out of native platform ordering"
  				oop := objectMemory firstAccessibleObject.
  				[oop = nil] whileFalse: [ | val |
  					(objectMemory isFreeObject: oop) ifFalse: [
  						(objectMemory fetchClassOf: oop) = objectMemory classFloat
  							ifTrue: [ | floatData |
+ 								floatData := self cCoerce: (objectMemory firstIndexableField: oop) to: 'unsigned int *'.
- 								floatData := self cCoerce: (self firstIndexableField: oop) to: 'unsigned int *'.
  								val := floatData at: 0.
  								floatData at: 0 put: (floatData at: 1).
  								floatData at: 1 put: val].
  						oop := objectMemory accessibleObjectAfter: oop]]]
  !

Item was changed:
  ----- Method: Interpreter>>okayFields: (in category 'debug support') -----
  okayFields: oop
  	"If this is a pointers object, check that its fields are all okay oops."
  
  	| i fieldOop c |
  	(oop = nil or: [oop = 0]) ifTrue: [ ^true ].
  	(objectMemory isIntegerObject: oop) ifTrue: [ ^true ].
+ 	objectMemory okayOop: oop.
- 	self okayOop: oop.
  	self oopHasOkayClass: oop.
  	(objectMemory isPointers: oop) ifFalse: [ ^true ].
  	c := objectMemory fetchClassOf: oop.
  	(c = (objectMemory splObj: ClassMethodContext)
  		or: [c = (objectMemory splObj: ClassBlockContext)])
  		ifTrue: [i := CtxtTempFrameStart + (self fetchStackPointerOf: oop) - 1]
  		ifFalse: [i := (self lengthOf: oop) - 1].
  	[i >= 0] whileTrue: [
  		fieldOop := objectMemory fetchPointer: i ofObject: oop.
  		(objectMemory isIntegerObject: fieldOop) ifFalse: [
+ 			objectMemory okayOop: fieldOop.
- 			self okayOop: fieldOop.
  			self oopHasOkayClass: fieldOop.
  		].
  		i := i - 1.
  	].!

Item was removed:
- ----- Method: Interpreter>>okayOop: (in category 'debug support') -----
- okayOop: signedOop
- 	"Verify that the given oop is legitimate. Check address, header, and size but not class."
- 
- 	| sz type fmt unusedBit oop |
- 	<var: #oop type: 'usqInt'>
- 	oop := self cCoerce: signedOop to: 'usqInt'.
- 
- 	"address and size checks"
- 	(objectMemory isIntegerObject: oop) ifTrue: [ ^true ].
- 	(oop < objectMemory endOfMemory)
- 		ifFalse: [ self error: 'oop is not a valid address' ].
- 	((oop \\ objectMemory bytesPerWord) = 0)
- 		ifFalse: [ self error: 'oop is not a word-aligned address' ].
- 	sz := objectMemory sizeBitsOf: oop.
- 	(oop + sz) < objectMemory endOfMemory
- 		ifFalse: [ self error: 'oop size would make it extend beyond the end of memory' ].
- 
- 	"header type checks"
- 	type := objectMemory headerType: oop.
- 	type = objectMemory headerTypeFree
- 		ifTrue:  [ self error: 'oop is a free chunk, not an object' ].
- 	type = HeaderTypeShort ifTrue: [
- 		(((objectMemory baseHeader: oop) >> 12) bitAnd: 16r1F) = 0
- 			ifTrue:  [ self error: 'cannot have zero compact class field in a short header' ].
- 	].
- 	type = objectMemory headerTypeClass ifTrue: [
- 		((oop >= objectMemory bytesPerWord) and: [(objectMemory headerType: oop - objectMemory bytesPerWord) = type])
- 			ifFalse: [ self error: 'class header word has wrong type' ].
- 	].
- 	type = HeaderTypeSizeAndClass ifTrue: [
- 		((oop >= (objectMemory bytesPerWord * 2)) and:
- 		 [(objectMemory headerType: oop - (objectMemory bytesPerWord * 2)) = type and:
- 		 [(objectMemory headerType: oop - objectMemory bytesPerWord) = type]])
- 			ifFalse: [ self error: 'class header word has wrong type' ].
- 	].
- 
- 	"format check"
- 	fmt := objectMemory formatOf: oop.
- 	((fmt = 5) | (fmt = 7))
- 		ifTrue:  [ self error: 'oop has an unknown format type' ].
- 
- 	"mark and root bit checks"
- 	unusedBit := 16r20000000.
- 	objectMemory bytesPerWord = 8
- 		ifTrue:
- 			[unusedBit := unusedBit << 16.
- 			 unusedBit := unusedBit << 16].
- 	((self longAt: oop) bitAnd: unusedBit) = 0
- 		ifFalse: [ self error: 'unused header bit 30 is set; should be zero' ].
- "xxx
- 	((self longAt: oop) bitAnd: MarkBit) = 0
- 		ifFalse: [ self error: 'mark bit should not be set except during GC' ].
- xxx"
- 	(((self longAt: oop) bitAnd: objectMemory rootBit) = 1 and:
- 	 [oop >= objectMemory youngStart])
- 		ifTrue: [ self error: 'root bit is set in a young object' ].
- 	^true
- !

Item was changed:
  ----- Method: Interpreter>>oopHasOkayClass: (in category 'debug support') -----
  oopHasOkayClass: signedOop
  	"Attempt to verify that the given oop has a reasonable behavior. The class must be a valid, non-integer oop and must not be nilObj. It must be a pointers object with three or more fields. Finally, the instance specification field of the behavior must match that of the instance."
  
  	| oop oopClass formatMask behaviorFormatBits oopFormatBits |
  	<var: #oop type: 'usqInt'>
  	<var: #oopClass type: 'usqInt'>
  
  	oop := self cCoerce: signedOop to: 'usqInt'.
+ 	objectMemory okayOop: oop.
- 	self okayOop: oop.
  	oopClass := self cCoerce: (objectMemory fetchClassOf: oop) to: 'usqInt'.
  
  	(objectMemory isIntegerObject: oopClass)
  		ifTrue: [ self error: 'a SmallInteger is not a valid class or behavior' ].
+ 	objectMemory okayOop: oopClass.
- 	self okayOop: oopClass.
  	((objectMemory isPointers: oopClass) and: [(self lengthOf: oopClass) >= 3])
  		ifFalse: [ self error: 'a class (behavior) must be a pointers object of size >= 3' ].
  	(objectMemory isBytes: oop)
  		ifTrue: [ formatMask := 16rC00 ]  "ignore extra bytes size bits"
  		ifFalse: [ formatMask := 16rF00 ].
  
+ 	behaviorFormatBits := (objectMemory formatOfClass: oopClass) bitAnd: formatMask.
- 	behaviorFormatBits := (self formatOfClass: oopClass) bitAnd: formatMask.
  	oopFormatBits := (objectMemory baseHeader: oop) bitAnd: formatMask.
  	behaviorFormatBits = oopFormatBits
  		ifFalse: [ self error: 'object and its class (behavior) formats differ' ].
  	^true!

Item was changed:
  ----- Method: Interpreter>>pop:thenPush: (in category 'contexts') -----
  pop: nItems thenPush: oop
  
  	| sp |
+ 	objectMemory longAt: (sp := stackPointer - ((nItems - 1) * objectMemory bytesPerWord)) put: oop.
- 	self longAt: (sp := stackPointer - ((nItems - 1) * objectMemory bytesPerWord)) put: oop.
  	stackPointer := sp.
  !

Item was changed:
  ----- Method: Interpreter>>pop:thenPushBool: (in category 'contexts') -----
  pop: nItems thenPushBool: trueOrFalse
  	"A few places pop a few items off the stack and then push a boolean. Make it convenient"
  	| sp |
+ 	objectMemory longAt: (sp := stackPointer - ((nItems - 1) * objectMemory bytesPerWord))
- 	self longAt: (sp := stackPointer - ((nItems - 1) * objectMemory bytesPerWord))
  		put:(trueOrFalse ifTrue: [objectMemory trueObj] ifFalse: [objectMemory falseObj]).
  	stackPointer := sp!

Item was changed:
  ----- Method: Interpreter>>pop:thenPushInteger: (in category 'contexts') -----
  pop: nItems thenPushInteger: integerVal
  "lots of places pop a few items off the stack and then push an integer. MAke it convenient"
  	| sp |
+ 	objectMemory longAt: (sp := stackPointer - ((nItems - 1) * objectMemory bytesPerWord)) put:(objectMemory integerObjectOf: integerVal).
- 	self longAt: (sp := stackPointer - ((nItems - 1) * objectMemory bytesPerWord)) put:(objectMemory integerObjectOf: integerVal).
  	stackPointer := sp.
  !

Item was changed:
  ----- Method: Interpreter>>popStack (in category 'contexts') -----
  popStack
  
  	| top |
+ 	top := objectMemory longAt: stackPointer.
- 	top := self longAt: stackPointer.
  	stackPointer := stackPointer - objectMemory bytesPerWord.
  	^ top!

Item was changed:
  ----- Method: Interpreter>>push: (in category 'contexts') -----
  push: object
  
  	| sp |
+ 	objectMemory longAt: (sp := stackPointer + objectMemory bytesPerWord) put: object.
- 	self longAt: (sp := stackPointer + objectMemory bytesPerWord) put: object.
  	stackPointer := sp.!

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

Item was changed:
  ----- Method: Interpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') -----
  readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset
  	"Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory."
  	"Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command."
  	"This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!"
  
  	| swapBytes headerStart headerSize dataSize oldBaseAddr minimumMemory memStart bytesRead bytesToShift heapSize |
  	<var: #f type: 'sqImageFile '>
  	<var: #desiredHeapSize type: 'usqInt'>
  	<var: #headerStart type: 'squeakFileOffsetType '>
  	<var: #dataSize type: 'size_t '>
  	<var: #imageOffset type: 'squeakFileOffsetType '>
  
  	swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
  	headerStart := (self sqImageFilePosition: f) - objectMemory bytesPerWord.  "record header start position"
  
  	headerSize			:= self getLongFromFile: f swap: swapBytes.
  	dataSize			:= self getLongFromFile: f swap: swapBytes.
  	oldBaseAddr		:= self getLongFromFile: f swap: swapBytes.
  	objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes).
  	objectMemory lastHash: (self getLongFromFile: f swap: swapBytes).
  	savedWindowSize	:= self getLongFromFile: f swap: swapBytes.
  	fullScreenFlag		:= self oldFormatFullScreenFlag: (self getLongFromFile: f swap: swapBytes).
  	extraVMMemory	:= self getLongFromFile: f swap: swapBytes.
  
  	objectMemory lastHash = 0 ifTrue: [
  		"lastHash wasn't stored (e.g. by the cloner); use 999 as the seed"
  		objectMemory lastHash: 999].
  
  	"decrease Squeak object heap to leave extra memory for the VM"
  	heapSize := self cCode: 'reserveExtraCHeapBytes(desiredHeapSize, extraVMMemory)'.
  
  	"compare memory requirements with availability".
  	minimumMemory := dataSize + 100000.  "need at least 100K of breathing room"
  	heapSize < minimumMemory ifTrue: [
  		self insufficientMemorySpecifiedError].
  
  	"allocate a contiguous block of memory for the Squeak heap"
  	(objectMemory allocateMemory: heapSize
  		minimum: minimumMemory
  		imageFile: f
  		headerSize: headerSize) = nil ifTrue: [self insufficientMemoryAvailableError].
  
  	memStart := objectMemory startOfMemory.
  	objectMemory memoryLimit: (memStart + heapSize) - 24.  "decrease memoryLimit a tad for safety"
  	objectMemory endOfMemory: memStart + dataSize.
  
  	"position file after the header"
  	self sqImageFile: f Seek: headerStart + headerSize.
  
  	"read in the image in bulk, then swap the bytes if necessary"
  	bytesRead := self
+ 		sqImage: (objectMemory pointerForOop: objectMemory memory)
- 		sqImage: (self pointerForOop: objectMemory memory)
  		read: f
  		size: (self cCode: 'sizeof(unsigned char)')
  		length: dataSize.
  	bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
  
  	objectMemory headerTypeBytes at: 0 put: objectMemory bytesPerWord * 2.	"3-word header (type 0)"	
  	objectMemory headerTypeBytes at: 1 put: objectMemory bytesPerWord.		"2-word header (type 1)"
  	objectMemory headerTypeBytes at: 2 put: 0.					"free chunk (type 2)"	
  	objectMemory headerTypeBytes at: 3 put: 0.					"1-word header (type 3)"
  
  	swapBytes ifTrue: [self reverseBytesInImage].
  
  	"compute difference between old and new memory base addresses"
  	bytesToShift := memStart - oldBaseAddr.
  	self initializeInterpreter: bytesToShift.  "adjusts all oops to new location"
  	self isBigEnder. "work out the machine endianness and cache the answer"
  	
  	(self imageFormatInitialVersion bitAnd: 1) = 1
  		ifTrue: ["Low order bit set, indicating that the image was saved from
  			a StackInterpreter (Cog) VM. Storage of all Float objects must be
  			returned to older object memory format."
  			self normalizeFloatOrderingInImage].
   
  	^ dataSize
  !

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

Item was changed:
  ----- Method: Interpreter>>sendInvokeCallback:Stack:Registers:Jmpbuf: (in category 'alien support') -----
  sendInvokeCallback: thunkPtr Stack: stackPtr Registers: regsPtr Jmpbuf: jmpBufPtr
  	"Send the 4 argument callback message invokeCallback:stack:registers:jmpbuf:
  	 to Alien class with the supplied args.  The arguments are raw C addresses
  	 and are converted to integer objects on the way."
  	| where |
  	<export: true>
  	objectMemory pushRemappableOop: (self positive32BitIntegerFor: jmpBufPtr).
  	objectMemory pushRemappableOop: (self positive32BitIntegerFor: regsPtr).
  	objectMemory pushRemappableOop: (self positive32BitIntegerFor: stackPtr).
  	objectMemory pushRemappableOop: (self positive32BitIntegerFor: thunkPtr).
  	receiver := objectMemory splObj: ClassAlien.
  	lkupClass := objectMemory fetchClassOfNonInt: receiver.
+ 	messageSelector := objectMemory splObj: objectMemory invokeCallbackSelector.
- 	messageSelector := objectMemory splObj: InvokeCallbackSelector.
  	(self lookupInMethodCacheSel: messageSelector class: lkupClass) ifFalse:
  	 	[(self lookupMethodNoMNUEtcInClass: lkupClass) ifFalse:
  			[^false]].
  	primitiveIndex ~= 0 ifTrue:
  		[^false].
  	self storeContextRegisters: activeContext.
  	self internalJustActivateNewMethod.
  	where := activeContext + objectMemory baseHeaderSize + (ReceiverIndex << objectMemory shiftForWord).
+ 	objectMemory longAt: where + (1 << objectMemory shiftForWord) put: objectMemory popRemappableOop.
+ 	objectMemory longAt: where + (2 << objectMemory shiftForWord) put: objectMemory popRemappableOop.
+ 	objectMemory longAt: where + (3 << objectMemory shiftForWord) put: objectMemory popRemappableOop.
+ 	objectMemory longAt: where + (4 << objectMemory shiftForWord) put: objectMemory popRemappableOop.
- 	self longAt: where + (1 << objectMemory shiftForWord) put: objectMemory popRemappableOop.
- 	self longAt: where + (2 << objectMemory shiftForWord) put: objectMemory popRemappableOop.
- 	self longAt: where + (3 << objectMemory shiftForWord) put: objectMemory popRemappableOop.
- 	self longAt: where + (4 << objectMemory shiftForWord) put: objectMemory popRemappableOop.
  	self fetchContextRegisters: activeContext.
  	self callInterpreter.
  	"not reached"
  	^true!

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

Item was removed:
- ----- Method: Interpreter>>slotSizeOf: (in category 'object format') -----
- slotSizeOf: oop
- 	"Returns the number of slots in the receiver.
- 	If the receiver is a byte object, return the number of bytes.
- 	Otherwise return the number of words."
- 	(objectMemory isIntegerObject: oop) ifTrue:[^0].
- 	^self lengthOf: oop!

Item was changed:
  ----- Method: Interpreter>>snapshotCleanUp (in category 'image save/restore') -----
  snapshotCleanUp
  	"Clean up right before saving an image, sweeping memory and:
  	* nilling out all fields of contexts above the stack pointer. 
  	* flushing external primitives 
  	* clearing the root bit of any object in the root table "
  	| oop header fmt sz |
  	oop := objectMemory firstObject.
  	[objectMemory oop: oop isLessThan: objectMemory endOfMemory]
  		whileTrue: [(objectMemory isFreeObject: oop)
+ 				ifFalse: [header := objectMemory longAt: oop.
- 				ifFalse: [header := self longAt: oop.
  					fmt := header >> 8 bitAnd: 15.
  					"Clean out context"
  					(fmt = 3 and: [self isContextHeader: header])
  						ifTrue: [sz := objectMemory sizeBitsOf: oop.
  							(objectMemory lastPointerOf: oop) + objectMemory bytesPerWord
  								to: sz - objectMemory baseHeaderSize by: objectMemory bytesPerWord
+ 								do: [:i | objectMemory longAt: oop + i put: objectMemory nilObj]].
- 								do: [:i | self longAt: oop + i put: objectMemory nilObj]].
  					"Clean out external functions"
  					fmt >= 12
  						ifTrue: ["This is a compiled method"
  							(self primitiveIndexOf: oop) = PrimitiveExternalCallIndex
  								ifTrue: ["It's primitiveExternalCall"
  									self flushExternalPrimitiveOf: oop]]].
  			oop := objectMemory objectAfter: oop].
  	objectMemory clearRootsTable!

Item was changed:
  ----- Method: Interpreter>>stObject:at: (in category 'array primitive support') -----
  stObject: array at: index
  	"Return what ST would return for <obj> at: index."
  
  	| hdr fmt totalLength fixedFields stSize |
  	<inline: false>
  	hdr := objectMemory baseHeader: array.
  	fmt := (hdr >> 8) bitAnd: 16rF.
  	totalLength := self lengthOf: array baseHeader: hdr format: fmt.
+ 	fixedFields := objectMemory fixedFieldsOf: array format: fmt length: totalLength.
- 	fixedFields := self fixedFieldsOf: array format: fmt length: totalLength.
  	(fmt = 3 and: [self isContextHeader: hdr])
  		ifTrue: [stSize := self fetchStackPointerOf: array]
  		ifFalse: [stSize := totalLength - fixedFields].
  	((objectMemory oop: index isGreaterThanOrEqualTo: 1)
  			and: [objectMemory oop: index isLessThanOrEqualTo: stSize])
  		ifTrue: [^ self subscript: array with: (index + fixedFields) format: fmt]
  		ifFalse: [self primitiveFail.  ^ 0].!

Item was changed:
  ----- Method: Interpreter>>stObject:at:put: (in category 'array primitive support') -----
  stObject: array at: index put: value
  	"Do what ST would return for <obj> at: index put: value."
  	| hdr fmt totalLength fixedFields stSize |
  	<inline: false>
  	hdr := objectMemory baseHeader: array.
  	fmt := (hdr >> 8) bitAnd: 16rF.
  	totalLength := self lengthOf: array baseHeader: hdr format: fmt.
+ 	fixedFields := objectMemory fixedFieldsOf: array format: fmt length: totalLength.
- 	fixedFields := self fixedFieldsOf: array format: fmt length: totalLength.
  	(fmt = 3 and: [self isContextHeader: hdr])
  		ifTrue: [stSize := self fetchStackPointerOf: array]
  		ifFalse: [stSize := totalLength - fixedFields].
  	((objectMemory oop: index isGreaterThanOrEqualTo: 1)
  			and: [objectMemory oop: index isLessThanOrEqualTo: stSize])
  		ifTrue: [self subscript: array with: (index + fixedFields) storing: value format: fmt]
  		ifFalse: [self primitiveFail]!

Item was changed:
  ----- Method: Interpreter>>stSizeOf: (in category 'array primitive support') -----
  stSizeOf: oop
  	"Return the number of indexable fields in the given object. (i.e., what Smalltalk would return for <obj> size)."
  	"Note: Assume oop is not a SmallInteger!!"
  
  	| hdr fmt totalLength fixedFields |
  	<inline: false>
  	hdr := objectMemory baseHeader: oop.
  	fmt := (hdr >> 8) bitAnd: 16rF.
  	totalLength := self lengthOf: oop baseHeader: hdr format: fmt.
+ 	fixedFields := objectMemory fixedFieldsOf: oop format: fmt length: totalLength.
- 	fixedFields := self fixedFieldsOf: oop format: fmt length: totalLength.
  	(fmt = 3 and: [self isContextHeader: hdr])
  		ifTrue: [^ self fetchStackPointerOf: oop]
  		ifFalse: [^ totalLength - fixedFields]!

Item was changed:
  ----- Method: Interpreter>>stackFloatValue: (in category 'contexts') -----
  stackFloatValue: offset
  	"Note: May be called by translated primitive code."
  	| result floatPointer |
  	<returnTypeC: 'double'>
  	<var: #result type: 'double '>
+ 	floatPointer := objectMemory longAt: stackPointer - (offset * objectMemory bytesPerWord).
- 	floatPointer := self longAt: stackPointer - (offset * objectMemory bytesPerWord).
  	(objectMemory fetchClassOf: floatPointer) = (objectMemory splObj: ClassFloat) 
  		ifFalse:[self primitiveFail. ^0.0].
  	self cCode: '' inSmalltalk: [result := Float new: 2].
  	self fetchFloatAt: floatPointer + objectMemory baseHeaderSize into: result.
  	^ result!

Item was changed:
  ----- Method: Interpreter>>stackIntegerValue: (in category 'contexts') -----
  stackIntegerValue: offset
  	| integerPointer |
+ 	integerPointer := objectMemory longAt: stackPointer - (offset * objectMemory bytesPerWord).
- 	integerPointer := self longAt: stackPointer - (offset * objectMemory bytesPerWord).
  	^self checkedIntegerValueOf: integerPointer!

Item was changed:
  ----- Method: Interpreter>>stackObjectValue: (in category 'contexts') -----
  stackObjectValue: offset
  	"Ensures that the given object is a real object, not a SmallInteger."
  
  	| oop |
+ 	oop := objectMemory longAt: stackPointer - (offset * objectMemory bytesPerWord).
- 	oop := self longAt: stackPointer - (offset * objectMemory bytesPerWord).
  	(objectMemory isIntegerObject: oop) ifTrue: [self primitiveFail. ^ nil].
  	^ oop
  !

Item was changed:
  ----- Method: Interpreter>>stackTop (in category 'contexts') -----
  stackTop
+ 	^objectMemory longAt: stackPointer!
- 	^self longAt: stackPointer!

Item was changed:
  ----- Method: Interpreter>>stackValue: (in category 'contexts') -----
  stackValue: offset
+ 	^ objectMemory longAt: stackPointer - (offset * objectMemory bytesPerWord)!
- 	^ self longAt: stackPointer - (offset * objectMemory bytesPerWord)!

Item was changed:
  ----- Method: Interpreter>>stackValue:put: (in category 'contexts') -----
  stackValue: offset put: oop
+ 	^objectMemory longAt: stackPointer - (offset * objectMemory bytesPerWord)
- 	^self longAt: stackPointer - (offset * objectMemory bytesPerWord)
  		put: oop!

Item was changed:
  ----- Method: Interpreter>>storeContextRegisters: (in category 'contexts') -----
  storeContextRegisters: activeCntx
  	"Note: internalStoreContextRegisters: should track changes to this method."
  
  	"InstructionPointer is a pointer variable equal to
+ 	method oop + ip + objectMemory baseHeaderSize
- 	method oop + ip + self baseHeaderSize
  		-1 for 0-based addressing of fetchByte
  		-1 because it gets incremented BEFORE fetching currentByte"
  
  	<inline: true>
  	objectMemory storePointerUnchecked: InstructionPointerIndex ofObject: activeCntx
  		withValue: (objectMemory integerObjectOf: (instructionPointer - method - (objectMemory baseHeaderSize - 2))).
  	objectMemory storePointerUnchecked: StackPointerIndex ofObject: activeCntx
  		withValue: (objectMemory integerObjectOf: (self stackPointerIndex - TempFrameStart + 1)).
  !

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

Item was changed:
  ----- Method: Interpreter>>transfer:from:to: (in category 'utilities') -----
  transfer: count from: src to: dst 
  	| in out lastIn |
  	<inline: true>
  	self flag: #Dan.  "Need to check all senders before converting this for 64 bits"
  	in := src - objectMemory bytesPerWord.
  	lastIn := in + (count * objectMemory bytesPerWord).
  	out := dst - objectMemory bytesPerWord.
  	[objectMemory oop: in isLessThan: lastIn]
  		whileTrue: [self
  				longAt: (out := out + objectMemory bytesPerWord)
+ 				put: (objectMemory longAt: (in := in + objectMemory bytesPerWord))]!
- 				put: (self longAt: (in := in + objectMemory bytesPerWord))]!

Item was changed:
  ----- Method: Interpreter>>transfer:fromIndex:ofObject:toIndex:ofObject: (in category 'utilities') -----
  transfer: count fromIndex: firstFrom ofObject: fromOop toIndex: firstTo ofObject: toOop
  	"Transfer the specified fullword fields, as from calling context to called context"
  	
  	"Assume: beRootIfOld: will be called on toOop."
  	| fromIndex toIndex lastFrom |
  	<inline: true>
  	self flag: #Dan.  "Need to check all senders before converting this for 64 bits"
  	fromIndex := fromOop + (firstFrom * objectMemory bytesPerWord).
  	toIndex := toOop + (firstTo * objectMemory bytesPerWord).
  	lastFrom := fromIndex + (count * objectMemory bytesPerWord).
  	[objectMemory oop: fromIndex isLessThan: lastFrom]
  		whileTrue: [fromIndex := fromIndex + objectMemory bytesPerWord.
  			toIndex := toIndex + objectMemory bytesPerWord.
+ 			objectMemory
- 			self
  				longAt: toIndex
+ 				put: (objectMemory longAt: fromIndex)]!
- 				put: (self longAt: fromIndex)]!

Item was changed:
  ----- Method: Interpreter>>verifyCleanHeaders (in category 'debug support') -----
  verifyCleanHeaders
  	| oop |
  	oop := objectMemory firstObject.
  	[objectMemory oop: oop isLessThan: objectMemory endOfMemory] whileTrue:
  		[(objectMemory isFreeObject: oop)
  			ifTrue: ["There should only be one free block at end of memory."
  					(objectMemory objectAfter: oop) = objectMemory endOfMemory
  						ifFalse: [self error: 'Invalid obj with HeaderTypeBits = Free.']]
+ 			ifFalse: [((objectMemory longAt: oop) bitAnd: objectMemory markBit) = 0
- 			ifFalse: [((self longAt: oop) bitAnd: objectMemory markBit) = 0
  						ifFalse: [self error: 'Invalid obj with MarkBit set.']].
  		oop := objectMemory objectAfter: oop]!

Item was removed:
- ----- Method: Interpreter>>wordSwapped: (in category 'image save/restore') -----
- wordSwapped: w
- 	"Return the given 64-bit integer with its halves in the reverse order."
- 
- 	<inline: true>
- 	self isDefinedTrueExpression: 'BYTES_PER_WORD == 8'
- 		inSmalltalk: [objectMemory bytesPerWord = 8]
- 		comment: 'swap 32-bit ends of a 64-bit object word'
- 		ifTrue: [^ ((w bitShift: objectMemory byte4ShiftNegated) bitAnd: objectMemory bytes3to0Mask)
- 	  					+ ((w bitShift: objectMemory byte4Shift) bitAnd: objectMemory bytes7to4Mask)]
- 		ifFalse: [self error: 'This cannot happen.']
- !

Item was changed:
  ----- Method: Interpreter>>writeImageFileIO: (in category 'image save/restore') -----
  writeImageFileIO: imageBytes
  
  	| headerStart headerSize f bytesWritten sCWIfn okToWrite |
  	<var: #f type: 'sqImageFile'>
  	<var: #headerStart type: 'squeakFileOffsetType '>
  	<var: #sCWIfn type: 'void *'>
  
  	"If the security plugin can be loaded, use it to check for write permission.
  	If not, assume it's ok"
  	sCWIfn := self ioLoadFunction: 'secCanWriteImage' From: 'SecurityPlugin'.
  	sCWIfn ~= 0 ifTrue:[okToWrite := self cCode: '((sqInt (*)(void))sCWIfn)()'.
  		okToWrite ifFalse:[^self primitiveFail]].
  	
  	"local constants"
  	headerStart := 0.  
  	headerSize := 16 * objectMemory bytesPerWord.  "header size in bytes; do not change!!"
  
  	f := self cCode: 'sqImageFileOpen(imageName, "wb")'.
  	f = nil ifTrue: [
  		"could not open the image file for writing"
  		self success: false.
  		^ nil].
  
  	headerStart := self cCode: 'sqImageFileStartLocation(f,imageName,headerSize+imageBytes)'.
  	self cCode: '/* Note: on Unix systems one could put an exec command here, padded to 512 bytes */'.
  	"position file to start of header"
  	self sqImageFile: f Seek: headerStart.
  
  	self putLong: (self imageFormatVersion) toFile: f.
  	self putLong: headerSize toFile: f.
  	self putLong: imageBytes toFile: f.
  	self putLong: (objectMemory startOfMemory) toFile: f.
  	self putLong: objectMemory specialObjectsOop toFile: f.
  	self putLong: objectMemory lastHash toFile: f.
  	self putLong: (self ioScreenSize) toFile: f.
  	self putLong: fullScreenFlag toFile: f.
  	self putLong: extraVMMemory toFile: f.
  	1 to: 7 do: [:i | self putLong: 0 toFile: f].  "fill remaining header words with zeros"
  	self successful ifFalse: [
  		"file write or seek failure"
  		self cCode: 'sqImageFileClose(f)'.
  		^ nil].
  
  	"position file after the header"
  	self sqImageFile: f Seek: headerStart + headerSize.
  
  	"write the image data"
  	bytesWritten := self
+ 		sqImage: (objectMemory pointerForOop: objectMemory memory)
- 		sqImage: (self pointerForOop: objectMemory memory)
  		write: f
  		size: (self cCode: 'sizeof(unsigned char)')
  		length: imageBytes.
  	self success: bytesWritten = imageBytes.
  	self cCode: 'sqImageFileClose(f)'.
  
  !

Item was added:
+ ----- Method: InterpreterPrimitives class>>initializeCodeGenerator: (in category 'translation') -----
+ initializeCodeGenerator: cg
+ 	"Load a code generator with classes in a manner suitable for generating
+ 	code for this class."
+ 
+ 	super initializeCodeGenerator: cg.
+ 	cg addClass: ObjectMemory asInstanceVariable: #objectMemory.
+ 	cg mapVar: #interpreter ofClass: ObjectMemory as: 'self'.
+ 	^cg
+ !

Item was changed:
  ----- Method: InterpreterPrimitives>>copyObj:toSegment:addr:stopAt:saveOopAt:headerAt: (in category 'image segment in/out') -----
  copyObj: oop toSegment: segmentWordArray addr: lastSeg stopAt: stopAddr saveOopAt: oopPtr headerAt: hdrPtr
  	"Copy this object into the segment beginning at lastSeg.
  	Install a forwarding pointer, and save oop and header.
  	Fail if out of space.  Return the next segmentAddr if successful."
  
  	"Copy the object..."
  	| extraSize bodySize hdrAddr |
  	self flag: #Dan.  "None of the imageSegment stuff has been updated for 64 bits"
  	self successful ifFalse: [^ lastSeg].
  	extraSize := objectMemory extraHeaderBytes: oop.
  	bodySize := objectMemory sizeBitsOf: oop.
  	(objectMemory oop: (lastSeg + extraSize + bodySize) isGreaterThanOrEqualTo: stopAddr)
  		ifTrue: [^ self primitiveFail].
  	self transfer: extraSize + bodySize // objectMemory bytesPerWord  "wordCount"
  		from: oop - extraSize
  		to: lastSeg + objectMemory bytesPerWord.
  
  	"Clear root and mark bits of all headers copied into the segment"
  	hdrAddr := lastSeg + objectMemory bytesPerWord + extraSize.
+ 	objectMemory longAt: hdrAddr put: ((objectMemory longAt: hdrAddr) bitAnd: objectMemory allButRootBit - objectMemory markBit).
- 	self longAt: hdrAddr put: ((self longAt: hdrAddr) bitAnd: objectMemory allButRootBit - objectMemory markBit).
  
  	objectMemory forward: oop to: (lastSeg + objectMemory bytesPerWord + extraSize - segmentWordArray)
  		savingOopAt: oopPtr andHeaderAt: hdrPtr.
  
  	"Return new end of segment"
  	^ lastSeg + extraSize + bodySize!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveCalloutToFFI (in category 'plugin primitives') -----
  primitiveCalloutToFFI
  	"Perform a function call to a foreign function.
  	Only invoked from method containing explicit external call spec.
  	Due to this we use the pluggable prim mechanism explicitly here
  	(the first literal of any FFI spec'ed method is an ExternalFunction
  	and not an array as used in the pluggable primitive mechanism)."
  
  	| function moduleName functionName |
  	<var: #function declareC: 'static void *function = 0'>
  	<var: #moduleName declareC: 'static char *moduleName = "SqueakFFIPrims"'>
  	<var: #functionName declareC: 'static char *functionName = "primitiveCallout"'>
  	function = 0 ifTrue: [
  		function := self
+ 			ioLoadExternalFunction: (objectMemory oopForPointer: functionName)
- 			ioLoadExternalFunction: (self oopForPointer: functionName)
  			OfLength: 16
+ 			FromModule: (objectMemory oopForPointer: moduleName)
- 			FromModule: (self oopForPointer: moduleName)
  			OfLength: 14.
  		function == 0 ifTrue: [^self primitiveFail]].
  	^self cCode: '((sqInt (*)(void))function)()'.
  !

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveConstantFill (in category 'indexing primitives') -----
  primitiveConstantFill
  	"Fill the receiver, which must be an indexable bytes or words 
  	objects, with the given integer value."
  	| fillValue rcvr rcvrIsBytes end i |
  	<var: #end type: 'usqInt'>
  	<var: #i type: 'usqInt'>
  	fillValue := self positive32BitValueOf: self stackTop.
  	rcvr := self stackValue: 1.
  	self success: (objectMemory isWordsOrBytes: rcvr).
  	rcvrIsBytes := objectMemory isBytes: rcvr.
  	rcvrIsBytes ifTrue: [self success: (fillValue >= 0 and: [fillValue <= 255])].
  	self successful
  		ifTrue: [end := rcvr + (objectMemory sizeBitsOf: rcvr).
  			i := rcvr + objectMemory baseHeaderSize.
  			rcvrIsBytes
  				ifTrue: [[i < end]
+ 						whileTrue: [objectMemory byteAt: i put: fillValue.
- 						whileTrue: [self byteAt: i put: fillValue.
  							i := i + 1]]
  				ifFalse: [[i < end]
+ 						whileTrue: [objectMemory long32At: i put: fillValue.
- 						whileTrue: [self long32At: i put: fillValue.
  							i := i + 4]].
  			self pop: 1]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveFailAfterCleanup: (in category 'image segment in/out') -----
  primitiveFailAfterCleanup: outPointerArray
  	"If the storeSegment primitive fails, it must clean up first."
  
  	| i lastAddr |   "Store nils throughout the outPointer array."
  	lastAddr := outPointerArray + (objectMemory lastPointerOf: outPointerArray).
  	i := outPointerArray + objectMemory baseHeaderSize.
  	[i <= lastAddr] whileTrue:
+ 		[objectMemory longAt: i put: objectMemory nilObj.
- 		[self longAt: i put: objectMemory nilObj.
  		i := i + objectMemory bytesPerWord].
  
  	DoAssertionChecks ifTrue: [self verifyCleanHeaders].
  	self primitiveFail!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveGetNextEvent (in category 'I/O primitives') -----
  primitiveGetNextEvent
  	"Primitive. Return the next input event from the VM event queue."
  	| evtBuf arg value eventTypeIs |
  	<var: #evtBuf declareC: 'int evtBuf[8] = { 0, 0, 0, 0, 0, 0, 0, 0 }'>
  	self cCode:'' inSmalltalk:[evtBuf := CArrayAccessor on: (IntegerArray new: 8)].
  	arg := self stackTop.
+ 	((objectMemory isArray: arg) and:[(objectMemory slotSizeOf: arg) = 8])  ifFalse:[^self primitiveFail].
- 	((objectMemory isArray: arg) and:[(self slotSizeOf: arg) = 8])  ifFalse:[^self primitiveFail].
  
  	self ioGetNextEvent: (self cCoerce: evtBuf to: 'sqInputEvent*').
  	self successful ifFalse:[^nil].
  
  	"Event type"
  	eventTypeIs := evtBuf at: 0.
  	self storeInteger: 0 ofObject: arg withValue: (evtBuf at: 0).
  	self successful ifFalse:[^nil].
  
  	"Event is Complex, assume evtBuf is populated correctly and return"
  	eventTypeIs = 6 ifTrue: 
  		[1 to: 7 do: [:i |
  			value := evtBuf at: i.
  			objectMemory storePointer: i ofObject: arg withValue: value]]
  	ifFalse: [
  		"Event time stamp"
  		self storeInteger: 1 ofObject: arg withValue: ((evtBuf at: 1) bitAnd: MillisecondClockMask).
  		self successful ifFalse:[^nil].
  
  		"Event arguments"
  		2 to: 7 do:[:i|
  			value := evtBuf at: i.
  			(objectMemory isIntegerValue: value)
  				ifTrue:[self storeInteger: i ofObject: arg withValue: value]
  				ifFalse:["Need to remap because allocation may cause GC"
  					objectMemory pushRemappableOop: arg.
  					value := self positive32BitIntegerFor: value.
  					arg := objectMemory popRemappableOop.
  					objectMemory storePointer: i ofObject: arg withValue: value]]].
  	self successful ifFalse:[^nil].
  	self pop: 1.!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveIncrementalGC (in category 'memory space primitives') -----
  primitiveIncrementalGC
  	"Do a quick, incremental garbage collection and return the number of bytes immediately available. (Note: more space may be made available by doing a full garbage collection."
  
  	self pop: 1.
  	objectMemory incrementalGC.
+ 	self push: (self positive64BitIntegerFor: (objectMemory bytesLeft: false))
- 	self push: (self positive64BitIntegerFor: (self bytesLeft: false))
  !

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveInstVarAt (in category 'object access primitives') -----
  primitiveInstVarAt
  	| index rcvr hdr fmt totalLength fixedFields value |
  	index := self stackIntegerValue: 0.
  	rcvr := self stackValue: 1.
  	self successful
  		ifTrue: [hdr := objectMemory baseHeader: rcvr.
  			fmt := hdr >> 8 bitAnd: 15.
  			totalLength := self lengthOf: rcvr baseHeader: hdr format: fmt.
+ 			fixedFields := objectMemory fixedFieldsOf: rcvr format: fmt length: totalLength.
- 			fixedFields := self fixedFieldsOf: rcvr format: fmt length: totalLength.
  			(index >= 1 and: [index <= fixedFields])
  				ifFalse: [self primitiveFail]].
  	self successful ifTrue: [value := self subscript: rcvr with: index format: fmt].
  	self successful ifTrue: [self pop: argumentCount + 1 thenPush: value]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveInstVarAtPut (in category 'object access primitives') -----
  primitiveInstVarAtPut
  	| newValue index rcvr hdr fmt totalLength fixedFields |
  	newValue := self stackTop.
  	index := self stackIntegerValue: 1.
  	rcvr := self stackValue: 2.
  	self successful
  		ifTrue: [hdr := objectMemory baseHeader: rcvr.
  			fmt := hdr >> 8 bitAnd: 15.
  			totalLength := self lengthOf: rcvr baseHeader: hdr format: fmt.
+ 			fixedFields := objectMemory fixedFieldsOf: rcvr format: fmt length: totalLength.
- 			fixedFields := self fixedFieldsOf: rcvr format: fmt length: totalLength.
  			(index >= 1 and: [index <= fixedFields]) ifFalse: [self primitiveFail]].
  	self successful ifTrue: [self subscript: rcvr with: index storing: newValue format: fmt].
  	self successful ifTrue: [self pop: argumentCount + 1 thenPush: newValue]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveIntegerAt (in category 'indexing primitives') -----
  primitiveIntegerAt
  	"Return the 32bit signed integer contents of a words receiver"
  
  	| index rcvr sz addr value intValue |
  	<var: #intValue type: 'int'>
  	index := self stackIntegerValue: 0.
  	rcvr := self stackValue: 1.
  	(objectMemory isIntegerObject: rcvr) ifTrue: [^self success: false].
  	(objectMemory isWords: rcvr) ifFalse: [^self success: false].
  	sz := self lengthOf: rcvr.  "number of fields"
  	self success: ((index >= 1) and: [index <= sz]).
  	self successful ifTrue: [
  		addr := rcvr + objectMemory baseHeaderSize - 4 "for zero indexing" + (index * 4).
+ 		value := objectMemory intAt: addr.
- 		value := self intAt: addr.
  		self pop: 2.  "pop rcvr, index"
  		"push element value"
  		(objectMemory isIntegerValue: value)
  			ifTrue: [self pushInteger: value]
  			ifFalse: [
  				intValue := value. "32 bit int may have been stored in 32 or 64 bit sqInt"
  				self push: (self signed32BitIntegerFor: intValue)]. "intValue may be sign extended to 64 bit sqInt"
  	].!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveIntegerAtPut (in category 'indexing primitives') -----
  primitiveIntegerAtPut
  	"Return the 32bit signed integer contents of a words receiver"
  	| index rcvr sz addr value valueOop |
  	valueOop := self stackValue: 0.
  	index := self stackIntegerValue: 1.
  	rcvr := self stackValue: 2.
  	(objectMemory isIntegerObject: rcvr) ifTrue:[^self success: false].
  	(objectMemory isWords: rcvr) ifFalse:[^self success: false].
  	sz := self lengthOf: rcvr.  "number of fields"
  	((index >= 1) and: [index <= sz]) ifFalse:[^self success: false].
  	(objectMemory isIntegerObject: valueOop)
  		ifTrue:[value := objectMemory integerValueOf: valueOop]
+ 		ifFalse:[value := objectMemory signed32BitValueOf: valueOop].
- 		ifFalse:[value := self signed32BitValueOf: valueOop].
  	self successful ifTrue:[
  		addr := rcvr + objectMemory baseHeaderSize - 4 "for zero indexing" + (index * 4).
+ 		value := objectMemory intAt: addr put: value.
- 		value := self intAt: addr put: value.
  		self pop: 3 thenPush: valueOop. "pop all; return value"
  	].
  !

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveLoadImageSegment (in category 'image segment in/out') -----
  primitiveLoadImageSegment
  	"This primitive is called from Squeak as...
  		<imageSegment> loadSegmentFrom: aWordArray outPointers: anArray."
  
  "This primitive will load a binary image segment created by primitiveStoreImageSegment.  It expects the outPointer array to be of the proper size, and the wordArray to be well formed.  It will return as its value the original array of roots, and the erstwhile segmentWordArray will have been truncated to a size of zero.  If this primitive should fail, the segmentWordArray will, sadly, have been reduced to an unrecognizable and unusable jumble.  But what more could you have done with it anyway?"
  
  	| outPointerArray segmentWordArray endSeg segOop fieldPtr fieldOop doingClass lastPtr extraSize mapOop lastOut outPtr hdrTypeBits header data |
  
  	<var: #endSeg type: 'usqInt'>
  	<var: #segOop type: 'usqInt'>
  	<var: #fieldPtr type: 'usqInt'>
  	<var: #lastOut type: 'usqInt'>
  	<var: #outPtr type: 'usqInt'>
  	<var: #lastPtr type: 'usqInt'>
  
  	DoAssertionChecks ifTrue: [self verifyCleanHeaders].
  	outPointerArray := self stackTop.
  	lastOut := outPointerArray + (objectMemory lastPointerOf: outPointerArray).
  	segmentWordArray := self stackValue: 1.
  	endSeg := segmentWordArray + (objectMemory sizeBitsOf: segmentWordArray) - objectMemory baseHeaderSize.
  
  	"Essential type checks"
  	((objectMemory formatOf: outPointerArray) = 2				"Must be indexable pointers"
  		and: [(objectMemory formatOf: segmentWordArray) = 6])	"Must be indexable words"
  		ifFalse: [^ self primitiveFail].
  
  	"Version check.  Byte order of the WordArray now"
+ 	data := objectMemory longAt: segmentWordArray + objectMemory baseHeaderSize.
- 	data := self longAt: segmentWordArray + objectMemory baseHeaderSize.
  	(self readableFormat: (data bitAnd: 16rFFFF "low 2 bytes")) ifFalse: [
  		"Not readable -- try again with reversed bytes..."
  		objectMemory reverseBytesFrom: segmentWordArray + objectMemory baseHeaderSize to: endSeg + objectMemory bytesPerWord.
+ 		data := objectMemory longAt: segmentWordArray + objectMemory baseHeaderSize.
- 		data := self longAt: segmentWordArray + objectMemory baseHeaderSize.
  		(self readableFormat: (data bitAnd: 16rFFFF "low 2 bytes")) ifFalse: [
  			"Still NG -- put things back and fail"
  			objectMemory reverseBytesFrom: segmentWordArray + objectMemory baseHeaderSize to: endSeg + objectMemory bytesPerWord.
  			DoAssertionChecks ifTrue: [self verifyCleanHeaders].
  			^ self primitiveFail]].
  	"Reverse the Byte type objects if the is data from opposite endian machine."
  	"Test top byte.  $d on the Mac or $s on the PC.  Rest of word is equal."
  	(data >> 16) = (objectMemory imageSegmentVersion >> 16) ifFalse: [
  		"Reverse the byte-type objects once"
  		segOop := objectMemory oopFromChunk: segmentWordArray + objectMemory baseHeaderSize + objectMemory bytesPerWord.
  			 "Oop of first embedded object"
  		self byteSwapByteObjectsFrom: segOop to: endSeg + objectMemory bytesPerWord].
  
  	"Proceed through the segment, remapping pointers..."
  	segOop := objectMemory oopFromChunk: segmentWordArray + objectMemory baseHeaderSize + objectMemory bytesPerWord.
  	[segOop <= endSeg] whileTrue:
  		[(objectMemory headerType: segOop) <= 1
  			ifTrue: ["This object has a class field (type = 0 or 1) -- start with that."
  					fieldPtr := segOop - objectMemory bytesPerWord.  doingClass := true]
  			ifFalse: ["No class field -- start with first data field"
  					fieldPtr := segOop + objectMemory baseHeaderSize.  doingClass := false].
  		lastPtr := segOop + (objectMemory lastPointerOf: segOop).	"last field"
  		lastPtr > endSeg ifTrue: [
  			DoAssertionChecks ifTrue: [self verifyCleanHeaders].
  			^ self primitiveFail "out of bounds"].
  
  		"Go through all oops, remapping them..."
  		[fieldPtr > lastPtr] whileFalse:
  			["Examine each pointer field"
+ 			fieldOop := objectMemory longAt: fieldPtr.
- 			fieldOop := self longAt: fieldPtr.
  			doingClass ifTrue:
  				[hdrTypeBits := objectMemory headerType: fieldPtr.
  				fieldOop := fieldOop - hdrTypeBits].
  			(objectMemory isIntegerObject: fieldOop)
  				ifTrue:
  					["Integer -- nothing to do"
  					fieldPtr := fieldPtr + objectMemory bytesPerWord]
  				ifFalse:
  					[(fieldOop bitAnd: 3) = 0 ifFalse: [^ self primitiveFail "bad oop"].
  					(fieldOop bitAnd: 16r80000000) = 0
  						ifTrue: ["Internal pointer -- add segment offset"
  								mapOop := fieldOop + segmentWordArray]
  						ifFalse: ["External pointer -- look it up in outPointers"
  								outPtr := outPointerArray + (fieldOop bitAnd: 16r7FFFFFFF).
  								outPtr > lastOut ifTrue: [^ self primitiveFail "out of bounds"].
+ 								mapOop := objectMemory longAt: outPtr].
- 								mapOop := self longAt: outPtr].
  					doingClass
+ 						ifTrue: [objectMemory longAt: fieldPtr put: mapOop + hdrTypeBits.
- 						ifTrue: [self longAt: fieldPtr put: mapOop + hdrTypeBits.
  								fieldPtr := fieldPtr + 8.
  								doingClass := false]
+ 						ifFalse: [objectMemory longAt: fieldPtr put: mapOop.
- 						ifFalse: [self longAt: fieldPtr put: mapOop.
  								fieldPtr := fieldPtr + objectMemory bytesPerWord].
  					segOop < objectMemory youngStart
  						ifTrue: [objectMemory possibleRootStoreInto: segOop value: mapOop].
  					]].
  		segOop := objectMemory objectAfter: segOop].
  
  	"Again, proceed through the segment checking consistency..."
  	segOop := objectMemory oopFromChunk: segmentWordArray + objectMemory baseHeaderSize + objectMemory bytesPerWord.
  	[segOop <= endSeg] whileTrue:
  		[(objectMemory oopHasAcceptableClass: segOop) ifFalse: [^ self primitiveFail "inconsistency"].
  		fieldPtr := segOop + objectMemory baseHeaderSize.		"first field"
  		lastPtr := segOop + (objectMemory lastPointerOf: segOop).	"last field"
  		"Go through all oops, remapping them..."
  		[fieldPtr > lastPtr] whileFalse:
  			["Examine each pointer field"
+ 			fieldOop := objectMemory longAt: fieldPtr.
- 			fieldOop := self longAt: fieldPtr.
  			(objectMemory oopHasAcceptableClass: fieldOop) ifFalse: [^ self primitiveFail "inconsistency"].
  			fieldPtr := fieldPtr + objectMemory bytesPerWord].
  		segOop := objectMemory objectAfter: segOop].
  
+ 	"Truncate the segment word array to size = objectMemory bytesPerWord (vers stamp only)"
- 	"Truncate the segment word array to size = self bytesPerWord (vers stamp only)"
  	extraSize := objectMemory extraHeaderBytes: segmentWordArray.
  	hdrTypeBits := objectMemory headerType: segmentWordArray.
  	extraSize = 8
+ 		ifTrue: [objectMemory longAt: segmentWordArray-extraSize put: objectMemory baseHeaderSize + objectMemory bytesPerWord + hdrTypeBits]
+ 		ifFalse: [header := objectMemory longAt: segmentWordArray.
+ 				objectMemory longAt: segmentWordArray
- 		ifTrue: [self longAt: segmentWordArray-extraSize put: objectMemory baseHeaderSize + objectMemory bytesPerWord + hdrTypeBits]
- 		ifFalse: [header := self longAt: segmentWordArray.
- 				self longAt: segmentWordArray
  					put: header - (header bitAnd: objectMemory sizeMask) + objectMemory baseHeaderSize + objectMemory bytesPerWord].	
  	"and return the roots array which was first in the segment"
  	DoAssertionChecks ifTrue: [self verifyCleanHeaders].
  	self pop: 3 thenPush: (objectMemory oopFromChunk: segmentWordArray + objectMemory baseHeaderSize + objectMemory bytesPerWord).
  !

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveObjectPointsTo (in category 'object access primitives') -----
  primitiveObjectPointsTo
  	| rcvr thang lastField |
  	thang := self popStack.
  	rcvr := self popStack.
  	(objectMemory isIntegerObject: rcvr) ifTrue: [^self pushBool: false].
  
  	lastField := objectMemory lastPointerOf: rcvr.
  	objectMemory baseHeaderSize to: lastField by: objectMemory bytesPerWord do:
+ 		[:i | (objectMemory longAt: rcvr + i) = thang
- 		[:i | (self longAt: rcvr + i) = thang
  			ifTrue: [^ self pushBool: true]].
  	self pushBool: false.!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveScanCharacters (in category 'I/O primitives') -----
  primitiveScanCharacters
  	"The character scanner primitive."
  	| kernDelta stops sourceString scanStopIndex scanStartIndex rcvr scanDestX scanLastIndex scanXTable scanMap maxGlyph ascii stopReason glyphIndex sourceX sourceX2 nextDestX scanRightX nilOop |
  
  	self methodArgumentCount = 6
  		ifFalse: [^ self primitiveFail].
  
  	"Load the arguments"
  	kernDelta := self stackIntegerValue: 0.
  	stops := self stackObjectValue: 1.
  	(objectMemory isArray: stops) ifFalse: [^ self primitiveFail].
+ 	(objectMemory slotSizeOf: stops) >= 258 ifFalse: [^ self primitiveFail].
- 	(self slotSizeOf: stops) >= 258 ifFalse: [^ self primitiveFail].
  	scanRightX := self stackIntegerValue: 2.
  	sourceString := self stackObjectValue: 3.
  	(objectMemory isBytes: sourceString) ifFalse: [^ self primitiveFail].
  	scanStopIndex := self stackIntegerValue: 4.
  	scanStartIndex := self stackIntegerValue: 5.
+ 	(scanStartIndex > 0 and: [scanStopIndex > 0 and: [scanStopIndex <= (objectMemory byteSizeOf: sourceString)]])
- 	(scanStartIndex > 0 and: [scanStopIndex > 0 and: [scanStopIndex <= (self byteSizeOf: sourceString)]])
  		ifFalse: [^ self primitiveFail].
  
  	"Load receiver and required instVars"
  	rcvr := self stackObjectValue: 6.
+ 	((objectMemory isPointers: rcvr) and: [(objectMemory slotSizeOf: rcvr) >= 4]) ifFalse: [^ self primitiveFail].
- 	((objectMemory isPointers: rcvr) and: [(self slotSizeOf: rcvr) >= 4]) ifFalse: [^ self primitiveFail].
  	scanDestX := self fetchInteger: 0 ofObject: rcvr.
  	scanLastIndex := self fetchInteger: 1 ofObject: rcvr.
  	scanXTable := objectMemory fetchPointer: 2 ofObject: rcvr.
  	scanMap := objectMemory fetchPointer: 3 ofObject: rcvr.
  	((objectMemory isArray: scanXTable) and: [objectMemory isArray: scanMap]) ifFalse: [^ self primitiveFail].
+ 	(objectMemory slotSizeOf: scanMap) = 256 ifFalse: [^ self primitiveFail].
- 	(self slotSizeOf: scanMap) = 256 ifFalse: [^ self primitiveFail].
  	self successful ifFalse: [^ nil].
+ 	maxGlyph := (objectMemory slotSizeOf: scanXTable) - 2.
- 	maxGlyph := (self slotSizeOf: scanXTable) - 2.
  
  	"Okay, here we go. We have eliminated nearly all failure 
  	conditions, to optimize the inner fetches."
  	scanLastIndex := scanStartIndex.
  	nilOop := objectMemory nilObject.
  	[scanLastIndex <= scanStopIndex]
  		whileTrue: [
  			"Known to be okay since scanStartIndex > 0 and scanStopIndex <= sourceString size"
  			ascii := objectMemory fetchByte: scanLastIndex - 1 ofObject: sourceString.
  			"Known to be okay since stops size >= 258"
  			(stopReason := objectMemory fetchPointer: ascii ofObject: stops) = nilOop
  				ifFalse: ["Store everything back and get out of here since some stop conditionn needs to be checked"
  					(objectMemory isIntegerValue: scanDestX) ifFalse: [^ self primitiveFail].
  					self storeInteger: 0 ofObject: rcvr withValue: scanDestX.
  					self storeInteger: 1 ofObject: rcvr withValue: scanLastIndex.
  					self pop: 7. "args+rcvr"
  					^ self push: stopReason].
  			"Known to be okay since scanMap size = 256"
  			glyphIndex := self fetchInteger: ascii ofObject: scanMap.
  			"fail if the glyphIndex is out of range"
  			(self failed or: [glyphIndex < 0 	or: [glyphIndex > maxGlyph]]) ifTrue: [^ self primitiveFail].
  			sourceX := self fetchInteger: glyphIndex ofObject: scanXTable.
  			sourceX2 := self fetchInteger: glyphIndex + 1 ofObject: scanXTable.
  			"Above may fail if non-integer entries in scanXTable"
  			self failed ifTrue: [^ nil].
  			nextDestX := scanDestX + sourceX2 - sourceX.
  			nextDestX > scanRightX
  				ifTrue: ["Store everything back and get out of here since we got to the right edge"
  					(objectMemory isIntegerValue: scanDestX) ifFalse: [^ self primitiveFail].
  					self storeInteger: 0 ofObject: rcvr withValue: scanDestX.
  					self storeInteger: 1 ofObject: rcvr withValue: scanLastIndex.
  					self pop: 7. "args+rcvr"
  					^ self push: (objectMemory fetchPointer: CrossedX - 1 ofObject: stops)].
  			scanDestX := nextDestX + kernDelta.
  			scanLastIndex := scanLastIndex + 1].
  	(objectMemory isIntegerValue: scanDestX) ifFalse: [^ self primitiveFail].
  	self storeInteger: 0 ofObject: rcvr withValue: scanDestX.
  	self storeInteger: 1 ofObject: rcvr withValue: scanStopIndex.
  	self pop: 7. "args+rcvr"
  	^ self push: (objectMemory fetchPointer: EndOfRun - 1 ofObject: stops)!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveShortAt (in category 'indexing primitives') -----
  primitiveShortAt
  	"Treat the receiver, which can be indexible by either bytes or words, as an array of signed 16-bit values. Return the contents of the given index. Note that the index specifies the i-th 16-bit entry, not the i-th byte or word."
  
  	| index rcvr sz addr value |
  	index := self stackIntegerValue: 0.
  	rcvr := self stackValue: 1.
  	self success: ((objectMemory isIntegerObject: rcvr) not and: [objectMemory isWordsOrBytes: rcvr]).
  	self successful ifFalse: [ ^ nil ].
  	sz := ((objectMemory sizeBitsOf: rcvr) - objectMemory baseHeaderSize) // 2.  "number of 16-bit fields"
  	self success: ((index >= 1) and: [index <= sz]).
  	self successful ifTrue: [
  		addr := rcvr + objectMemory baseHeaderSize + (2 * (index - 1)).
+ 		value := objectMemory shortAt: addr.
- 		value := self shortAt: addr.
  		self pop: 2 thenPushInteger: value. 
  	]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveShortAtPut (in category 'indexing primitives') -----
  primitiveShortAtPut
  	"Treat the receiver, which can be indexible by either bytes or words, as an array of signed 16-bit values. Set the contents of the given index to the given value. Note that the index specifies the i-th 16-bit entry, not the i-th byte or word."
  
  	| index rcvr sz addr value |
  	value := self stackIntegerValue: 0.
  	index := self stackIntegerValue: 1.
  	rcvr := self stackValue: 2.
  	self success: ((objectMemory isIntegerObject: rcvr) not and: [objectMemory isWordsOrBytes: rcvr]).
  	self successful ifFalse: [ ^ nil ].
  	sz := ((objectMemory sizeBitsOf: rcvr) - objectMemory baseHeaderSize) // 2.  "number of 16-bit fields"
  	self success: ((index >= 1) and: [index <= sz]).
  	self success: ((value >= -32768) and: [value <= 32767]).
  	self successful ifTrue: [
  		addr := rcvr + objectMemory baseHeaderSize + (2 * (index - 1)).
+ 		objectMemory shortAt: addr put: value.
- 		self shortAt: addr put: value.
  		self pop: 2.  "pop index and value; leave rcvr on stack"
  	]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveStoreImageSegment (in category 'image segment in/out') -----
(excessive size, no diff calculated)

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveStringReplace (in category 'indexing primitives') -----
  primitiveStringReplace
  	" 
  	<array> primReplaceFrom: start to: stop with: replacement 
  	startingAt: repStart  
  	<primitive: 105>
  	"
  	| array start stop repl replStart hdr arrayFmt totalLength arrayInstSize replFmt replInstSize srcIndex |
  	array := self stackValue: 4.
  	start := self stackIntegerValue: 3.
  	stop := self stackIntegerValue: 2.
  	repl := self stackValue: 1.
  	replStart := self stackIntegerValue: 0.
  
  	self successful ifFalse: [^ self primitiveFail].
  	(objectMemory isIntegerObject: repl) ifTrue: ["can happen in LgInt copy"
  			^ self primitiveFail].
  
  	hdr := objectMemory baseHeader: array.
  	arrayFmt := hdr >> 8 bitAnd: 15.
  	totalLength := self lengthOf: array baseHeader: hdr format: arrayFmt.
+ 	arrayInstSize := objectMemory fixedFieldsOf: array format: arrayFmt length: totalLength.
- 	arrayInstSize := self fixedFieldsOf: array format: arrayFmt length: totalLength.
  	(start >= 1 and: [start - 1 <= stop and: [stop + arrayInstSize <= totalLength]])
  		ifFalse: [^ self primitiveFail].
  
  	hdr := objectMemory baseHeader: repl.
  	replFmt := hdr >> 8 bitAnd: 15.
  	totalLength := self lengthOf: repl baseHeader: hdr format: replFmt.
+ 	replInstSize := objectMemory fixedFieldsOf: repl format: replFmt length: totalLength.
- 	replInstSize := self fixedFieldsOf: repl format: replFmt length: totalLength.
  	(replStart >= 1 and: [stop - start + replStart + replInstSize <= totalLength])
  		ifFalse: [^ self primitiveFail].
  
  	"Array formats (without byteSize bits, if bytes array) must be same "
  	arrayFmt < 8
  		ifTrue: [arrayFmt = replFmt
  				ifFalse: [^ self primitiveFail]]
  		ifFalse: [(arrayFmt bitAnd: 12) = (replFmt bitAnd: 12)
  				ifFalse: [^ self primitiveFail]].
  
  	srcIndex := replStart + replInstSize - 1.
  	"- 1 for 0-based access"
  
  	arrayFmt <= 4
  		ifTrue: ["pointer type objects"
  			start + arrayInstSize - 1 to: stop + arrayInstSize - 1 do: [:i |
  				objectMemory storePointer: i ofObject: array withValue: (objectMemory fetchPointer: srcIndex ofObject: repl).
  					srcIndex := srcIndex + 1]]
  		ifFalse: [arrayFmt < 8
  				ifTrue: ["32-bit-word type objects"
  					start + arrayInstSize - 1 to: stop + arrayInstSize - 1
  						do: [:i | objectMemory storeLong32: i ofObject: array withValue: (objectMemory fetchLong32: srcIndex ofObject: repl).
  							srcIndex := srcIndex + 1]]
  				ifFalse: ["byte-type objects"
  					start + arrayInstSize - 1 to: stop + arrayInstSize - 1
  						do: [:i |  objectMemory storeByte: i ofObject: array withValue: (objectMemory fetchByte: srcIndex ofObject: repl).
  							srcIndex := srcIndex + 1]]].
  	"We might consider  comparing stop - start to some value here and using forceInterruptCheck"
  
  	self pop: argumentCount "leave rcvr on stack"!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveUnloadModule (in category 'plugin primitives') -----
  primitiveUnloadModule
  	"Primitive. Unload the module with the given name."
  	"Reloading of the module will happen *later* automatically, when a 
  	function from it is called. This is ensured by invalidating current sessionID."
  	| moduleName |
  	self methodArgumentCount = 1 ifFalse:[^self primitiveFail].
  	moduleName := self stackTop.
  	(objectMemory isIntegerObject: moduleName) ifTrue:[^self primitiveFail].
  	(objectMemory isBytes: moduleName) ifFalse:[^self primitiveFail].
+ 	(self ioUnloadModule: (objectMemory oopForPointer: (objectMemory firstIndexableField: moduleName))
+ 		OfLength: (objectMemory byteSizeOf: moduleName)) ifFalse:[^self primitiveFail].
- 	(self ioUnloadModule: (self oopForPointer: (self firstIndexableField: moduleName))
- 		OfLength: (self byteSizeOf: moduleName)) ifFalse:[^self primitiveFail].
  	self flushExternalPrimitives.
  	self forceInterruptCheck.
  	self pop: 1 "pop moduleName; return receiver"!

Item was changed:
  ----- Method: InterpreterSimulator class>>new (in category 'instance creation') -----
  new
+ 	| objectMemory |
+ 	objectMemory := self == InterpreterSimulator
+ 		ifTrue: [SmalltalkImage current endianness == #big
+ 				ifTrue: [ObjectMemorySimulatorMSB basicNew]
+ 				ifFalse: [ObjectMemorySimulatorLSB basicNew]].
+ 	^ self on: objectMemory
- 	^ self on: ObjectMemory new
  !

Item was changed:
  ----- Method: InterpreterSimulator class>>on: (in category 'instance creation') -----
  on: objectMemory
  	| interp |
  	interp := self == InterpreterSimulator
  		ifTrue: [SmalltalkImage current endianness == #big
  				ifTrue: [InterpreterSimulatorMSB basicNew]
  				ifFalse: [InterpreterSimulatorLSB basicNew]]
  		ifFalse: [super basicNew].
  	interp objectMemory: objectMemory.
+ 	objectMemory interpreter: interp.
  	^ interp initialize
  !

Item was removed:
- ----- Method: InterpreterSimulator>>baseHeaderSize (in category 'memory access') -----
- baseHeaderSize
- 	"Answer the size of an object memory header word in bytes."
- 
- 	^self bytesPerWord!

Item was removed:
- ----- Method: InterpreterSimulator>>byteAt: (in category 'memory access') -----
- byteAt: byteAddress
- 	^self subclassResponsibility!

Item was removed:
- ----- Method: InterpreterSimulator>>byteAt:put: (in category 'memory access') -----
- byteAt: byteAddress put: byte
- 	^self subclassResponsibility!

Item was removed:
- ----- Method: InterpreterSimulator>>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, and byte is an 8-bit quantity."
- 
- 	^ self byteAt: pointer!

Item was removed:
- ----- Method: InterpreterSimulator>>byteAtPointer:put: (in category 'memory access') -----
- byteAtPointer: pointer put: byteValue
- 	"This gets implemented by Macros in C, where its types will also be checked.
- 	pointer is a raw address, and byteValue is an 8-bit quantity."
- 
- 	^ self byteAt: pointer  put: byteValue!

Item was changed:
  ----- Method: InterpreterSimulator>>bytesPerWord (in category 'memory access') -----
  bytesPerWord
+ 	^bytesPerWord!
- 	"BytesPerWord was a class variable in ObjectMemory, permitting each object
- 	memory to have its own word size."
- 
- 	^ bytesPerWord ifNil: [bytesPerWord := 4]!

Item was removed:
- ----- Method: InterpreterSimulator>>bytesPerWord: (in category 'memory access') -----
- bytesPerWord: fourOrEight
- 	"BytesPerWord was a class variable in ObjectMemory, permitting each object
- 	memory to have its own word size."
- 
- 	bytesPerWord := fourOrEight!

Item was changed:
  ----- Method: InterpreterSimulator>>clipboardRead:Into:At: (in category 'I/O primitives') -----
  clipboardRead: sz Into: actualAddress At: zeroBaseIndex
  	| str |
  	str := Clipboard clipboardText.
  	1 to: sz do:
+ 		[:i | objectMemory byteAt: actualAddress + zeroBaseIndex + i - 1 put: (str at: i) asciiValue]!
- 		[:i | self byteAt: actualAddress + zeroBaseIndex + i - 1 put: (str at: i) asciiValue]!

Item was changed:
  ----- Method: InterpreterSimulator>>fetchByte (in category 'interpreter shell') -----
  fetchByte
  
+ 	^ objectMemory byteAt: (localIP := localIP + 1).!
- 	^ self byteAt: (localIP := localIP + 1).!

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

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

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

Item was removed:
- ----- Method: InterpreterSimulator>>firstIndexableField: (in category 'memory access') -----
- firstIndexableField: oop
- 	"NOTE: overridden from Interpreter to add coercion to CArray"
- 
- 	| hdr fmt totalLength fixedFields |
- 	self returnTypeC: 'void *'.
- 	hdr := objectMemory baseHeader: oop.
- 	fmt := (hdr >> 8) bitAnd: 16rF.
- 	totalLength := self lengthOf: oop baseHeader: hdr format: fmt.
- 	fixedFields := self fixedFieldsOf: oop format: fmt length: totalLength.
- 	fmt < 8 ifTrue:
- 		[fmt = 6 ifTrue:
- 			["32 bit field objects"
- 			^ self cCoerce: (self pointerForOop: oop + objectMemory baseHeaderSize + (fixedFields << 2)) to: 'int *'].
- 		"full word objects (pointer or bits)"
- 		^ self cCoerce: (self pointerForOop: oop + objectMemory baseHeaderSize + (fixedFields << objectMemory shiftForWord)) to: 'oop *']
- 		ifFalse:
- 		["Byte objects"
- 		^ self cCoerce: (self pointerForOop: oop + objectMemory baseHeaderSize + fixedFields) to: 'char *']!

Item was removed:
- ----- Method: InterpreterSimulator>>halfWordHighInLong32: (in category 'memory access') -----
- halfWordHighInLong32: long32
- 	^self subclassResponsibility!

Item was removed:
- ----- Method: InterpreterSimulator>>halfWordLowInLong32: (in category 'memory access') -----
- halfWordLowInLong32: long32
- 	^self subclassResponsibility!

Item was changed:
  ----- Method: InterpreterSimulator>>hexDump100: (in category 'debug support') -----
  hexDump100: oop
  	| byteSize val |
  	^ String streamContents:
  		[:strm |
  		byteSize := 256.
  		(self headerStart: oop) to: byteSize by: 4 do:
+ 			[:a | val := objectMemory longAt: oop+a.
- 			[:a | val := self longAt: oop+a.
  			strm cr; nextPutAll: (oop+a) hex8; space; space; 
  				nextPutAll: (a<16 ifTrue: [' ', a hex] ifFalse: [a hex]); 
  				space; space; space; nextPutAll: val hex8;
  				space; space.
  			strm nextPutAll: (self charsOfLong: val).
  			strm space; space; nextPutAll: (oop+a) printString]]!

Item was changed:
  ----- Method: InterpreterSimulator>>hexDump: (in category 'debug support') -----
  hexDump: oop
  	| byteSize val |
  	(objectMemory isIntegerObject: oop) ifTrue: [^ self shortPrint: oop].
  	^ String streamContents:
  		[:strm |
  		byteSize := 256 min: (objectMemory sizeBitsOf: oop)-4.
  		(self headerStart: oop) to: byteSize by: 4 do:
+ 			[:a | val := objectMemory longAt: oop+a.
- 			[:a | val := self longAt: oop+a.
  			strm cr; nextPutAll: (a<16 ifTrue: [' ', a hex] ifFalse: [a hex]); 
  				space; space; space; nextPutAll: val hex8;
  				space; space.
  			a=0
  				ifTrue: [strm nextPutAll: (self dumpHeader: val)]
  				ifFalse: [strm nextPutAll: (self charsOfLong: val)]]]!

Item was changed:
  ----- Method: InterpreterSimulator>>imageFormatVersion (in category 'initialization') -----
  imageFormatVersion
  	"The imageFormatVersionNumber variable is initialized in Interpreter class>>declareCVarsIn:
  	so provide the value here for simulation."
  
  	^ imageFormatVersionNumber
+ 		ifNil: [imageFormatVersionNumber := objectMemory bytesPerWord == 4
- 		ifNil: [imageFormatVersionNumber := self bytesPerWord == 4
  						ifTrue: [6502]
  						ifFalse: [68000]]!

Item was changed:
  ----- Method: InterpreterSimulator>>initialize (in category 'initialization') -----
  initialize
  
  	"Initialize the InterpreterSimulator when running the interpreter inside
  	Smalltalk. The primary responsibility of this method is to allocate
  	Smalltalk Arrays for variables that will be declared as statically-allocated
  	global arrays in the translated code."
  
+ 	"copy of bytesPerWord to avoid extra indirection that may affect performance"
+ 	bytesPerWord := objectMemory bytesPerWord.
+ 
  	"initialize class variables"
  	ObjectMemory initializeConstants.
  	Interpreter initialize.
  
  	"Note: we must initialize ConstMinusOne differently for simulation,
  		due to the fact that the simulator works only with +ve 32-bit values"
+ 	ConstMinusOne := objectMemory integerObjectOf: -1.
- 	ConstMinusOne := self integerObjectOf: -1.
  
  	methodCache := Array new: MethodCacheSize.
  	atCache := Array new: AtCacheTotalSize.
  	self flushMethodCache.
  	objectMemory rootTable: (Array new: ObjectMemory rootTableSize).
  	objectMemory weakRoots: (Array new: ObjectMemory rootTableSize + ObjectMemory remapBufferSize + 100).
  	objectMemory remapBuffer: (Array new: ObjectMemory remapBufferSize).
  	semaphoresUseBufferA := true.
  	semaphoresToSignalA := Array new: SemaphoresToSignalSize.
  	semaphoresToSignalB := Array new: SemaphoresToSignalSize.
  	externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
  	primitiveTable := self class primitiveTable.
  	pluginList := #().
  	mappedPluginEntries := #().
  
  	"initialize InterpreterSimulator variables used for debugging"
  	byteCount := 0.
  	sendCount := 0.
  	quitBlock := [^ self].
  	traceOn := true.
  	myBitBlt := BitBltSimulator new setInterpreter: self.
  	filesOpen := OrderedCollection new.
+ 	objectMemory headerTypeBytes: (CArrayAccessor on: (Array with: bytesPerWord * 2 with: bytesPerWord with: 0 with: 0)).
- 	objectMemory headerTypeBytes: (CArrayAccessor on: (Array with: self bytesPerWord * 2 with: self bytesPerWord with: 0 with: 0)).
  	transcript := Transcript.
+ 	objectMemory transcript: Transcript.
  	displayForm := 'Display has not yet been installed' asDisplayText form.
  	!

Item was removed:
- ----- Method: InterpreterSimulator>>integerAt: (in category 'memory access') -----
- integerAt: byteAddress
- 	"Note: Adjusted for Smalltalk's 1-based array indexing."
- 
- 	^objectMemory memory integerAt: (byteAddress // 4) + 1!

Item was removed:
- ----- Method: InterpreterSimulator>>integerAt:put: (in category 'memory access') -----
- integerAt: byteAddress put: a32BitValue
- 	"Note: Adjusted for Smalltalk's 1-based array indexing."
- 
- 	^objectMemory memory integerAt: (byteAddress // 4) + 1 put: a32BitValue!

Item was removed:
- ----- Method: InterpreterSimulator>>integerObjectOf: (in category 'memory access') -----
- integerObjectOf: value
- 	"The simulator works with strictly positive bit patterns"
- 	value < 0
- 		ifTrue: [^ ((16r80000000 + value) << 1) + 1]
- 		ifFalse: [^ (value << 1) + 1]!

Item was changed:
  ----- Method: InterpreterSimulator>>ioLoadExternalFunction:OfLength:FromModule:OfLength: (in category 'plugin support') -----
  ioLoadExternalFunction: functionName OfLength: functionLength FromModule: moduleName OfLength: moduleLength
  	"Load and return the requested function from a module"
  	| pluginString functionString |
  	pluginString := String new: moduleLength.
+ 	1 to: moduleLength do:[:i| pluginString byteAt: i put: (objectMemory byteAt: moduleName+i-1)].
- 	1 to: moduleLength do:[:i| pluginString byteAt: i put: (self byteAt: moduleName+i-1)].
  	functionString := String new: functionLength.
+ 	1 to: functionLength do:[:i| functionString byteAt: i put: (objectMemory byteAt: functionName+i-1)].
- 	1 to: functionLength do:[:i| functionString byteAt: i put: (self byteAt: functionName+i-1)].
  	functionString := functionString asSymbol.
  	^self ioLoadFunction: functionString From: pluginString!

Item was removed:
- ----- Method: InterpreterSimulator>>isIntegerValue: (in category 'interpreter shell') -----
- isIntegerValue: valueWord 
- 	^ valueWord >= 16r-40000000 and: [valueWord <= 16r3FFFFFFF]!

Item was changed:
  ----- Method: InterpreterSimulator>>logOfBytesVerify:fromFileNamed:fromStart: (in category 'testing') -----
  logOfBytesVerify: nBytes fromFileNamed: fileName fromStart: loggingStart
  	"Verify a questionable interpreter against a successful run"
  	"self logOfBytesVerify: 10000 fromFileNamed: 'clone32Bytecodes.log' "
  	
  	| logFile rightByte prevCtxt |
  	logFile := (FileStream readOnlyFileNamed: fileName) binary.
  	logging := loggingStart.
  	transcript clear.
  	byteCount := 0.
  	quitBlock := [^ self].
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	prevCtxt := 0.  prevCtxt := prevCtxt.
  	[byteCount < nBytes] whileTrue:
  		[
  "
  byteCount > 14560 ifTrue:
  [self externalizeIPandSP.
  prevCtxt = activeContext ifFalse:
   [prevCtxt := activeContext.
   transcript cr; nextPutAll: (self printTop: 2); endEntry].
  transcript cr; print: byteCount; nextPutAll: ': ' , (activeContext hex); space;
   print: (instructionPointer - method - (BaseHeaderSize - 2));
+  nextPutAll: ': <' , (objectMemory byteAt: localIP) hex , '>'; space;
-  nextPutAll: ': <' , (self byteAt: localIP) hex , '>'; space;
   nextPutAll: (self symbolic: currentBytecode at: localIP inMethod: method); space;
   print: (self stackPointerIndex - TempFrameStart + 1); endEntry.
  byteCount = 14590 ifTrue: [self halt]].
  "
  		logging ifTrue: [rightByte := logFile next.
  						currentBytecode = rightByte ifFalse: [self halt]].
  		self dispatchOn: currentBytecode in: BytecodeTable.
  		byteCount := byteCount + 1.
  		byteCount \\ 10000 = 0 ifTrue: [self fullDisplayUpdate]].
  	self externalizeIPandSP.
  	logFile close.
  	self inform: nBytes printString , ' bytecodes verfied.'!

Item was changed:
  ----- Method: InterpreterSimulator>>logOfSendsVerify:fromFileNamed:fromStart: (in category 'testing') -----
  logOfSendsVerify: nSends fromFileNamed: fileName fromStart: loggingStart
  	"Write a log file for testing a flaky interpreter on the same image"
  	"self logOfSendsWrite: 10000 toFileNamed: 'clone32Messages.log' "
  	
  	| logFile priorContext rightSelector prevCtxt |
  	logFile := FileStream readOnlyFileNamed: fileName.
  	logging := loggingStart.
  	transcript clear.
  	byteCount := 0.
  	sendCount := 0.
  	priorContext := activeContext.
  	quitBlock := [^ self].
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	prevCtxt := 0.  prevCtxt := prevCtxt.
  	[sendCount < nSends] whileTrue:
  		[
  "
  byteCount>500 ifTrue:
  [byteCount>550 ifTrue: [self halt].
  self externalizeIPandSP.
  prevCtxt = activeContext ifFalse:
   [prevCtxt := activeContext.
   transcript cr; nextPutAll: (self printTop: 2); endEntry].
  transcript cr; print: byteCount; nextPutAll: ': ' , (activeContext hex); space;
   print: (instructionPointer - method - (BaseHeaderSize - 2));
+  nextPutAll: ': <' , (objectMemory byteAt: localIP) hex , '>'; space;
-  nextPutAll: ': <' , (self byteAt: localIP) hex , '>'; space;
   nextPutAll: (self symbolic: currentBytecode at: localIP inMethod: method); space;
   print: (self stackPointerIndex - TempFrameStart + 1); endEntry.
  ].
  "
  		self dispatchOn: currentBytecode in: BytecodeTable.
  		activeContext == priorContext ifFalse:
  			[sendCount := sendCount + 1.
  			logging ifTrue: [rightSelector := logFile nextLine.
  							(self stringOf: messageSelector) = rightSelector ifFalse: [self halt]].
  			priorContext := activeContext].
  		byteCount := byteCount + 1.
  		byteCount \\ 10000 = 0 ifTrue: [self fullDisplayUpdate]].
  	self externalizeIPandSP.
  	logFile close.
  	self inform: nSends printString , ' sends verfied.'!

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

Item was removed:
- ----- Method: InterpreterSimulator>>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 removed:
- ----- Method: InterpreterSimulator>>longAt: (in category 'memory access') -----
- longAt: byteAddress
- 	"Note: Adjusted for Smalltalk's 1-based array indexing."
- 
- 	^objectMemory memory at: (byteAddress // 4) + 1!

Item was removed:
- ----- Method: InterpreterSimulator>>longAt:put: (in category 'memory access') -----
- longAt: byteAddress put: a32BitValue
- 	"Note: Adjusted for Smalltalk's 1-based array indexing."
- 
- 	^objectMemory memory at: (byteAddress // 4) + 1 put: a32BitValue!

Item was removed:
- ----- Method: InterpreterSimulator>>longAtPointer: (in category 'memory access') -----
- longAtPointer: pointer
- 	"This gets implemented by Macros in C, where its types will also be checked.
- 	pointer is a raw address, and the result is the width of a machine word."
- 
- 	^ self longAt: pointer!

Item was removed:
- ----- Method: InterpreterSimulator>>longAtPointer:put: (in category 'memory access') -----
- longAtPointer: pointer put: longValue
- 	"This gets implemented by Macros in C, where its types will also be checked.
- 	pointer is a raw address, and longValue is the width of a machine word."
- 
- 	^ self longAt: pointer put: longValue!

Item was changed:
  ----- Method: InterpreterSimulator>>longPrint: (in category 'debug support') -----
  longPrint: oop
  	| lastPtr val lastLong hdrType prevVal |
  	(objectMemory isIntegerObject: oop) ifTrue: [^ self shortPrint: oop].
  	^ String streamContents:
  		[:strm |
  		lastPtr := 64 * bytesPerWord min: (objectMemory lastPointerOf: oop).
  		hdrType := objectMemory headerType: oop.
  		hdrType = 2 ifTrue: [lastPtr := 0].
  		prevVal := 0.
  		(self headerStart: oop) to: lastPtr by: bytesPerWord do:
+ 			[:a | val := objectMemory longAt: oop+a.
- 			[:a | val := self longAt: oop+a.
  			(a > 0 and: [(val = prevVal) & (a ~= lastPtr)])
  			ifTrue:
+ 			[prevVal = (objectMemory longAt: oop + a - (bytesPerWord * 2)) ifFalse: [strm cr; nextPutAll: '        ...etc...']]
- 			[prevVal = (self longAt: oop + a - (bytesPerWord * 2)) ifFalse: [strm cr; nextPutAll: '        ...etc...']]
  			ifFalse:
  			[strm cr; nextPutAll: (a<16 ifTrue: [' ', a hex] ifFalse: [a hex]); 
  				space; space; space; nextPutAll: val hex8; space; space.
  			a = (bytesPerWord * 2) negated ifTrue:
  				[strm nextPutAll: 'size = ' , (val - hdrType) hex].
  			a = bytesPerWord negated ifTrue:
  				[strm nextPutAll: '<' , (self nameOfClass: (val - hdrType)) , '>'].
  			a = 0 ifTrue: [strm cr; tab; nextPutAll: (self dumpHeader: val)].
  			a > 0 ifTrue: [strm nextPutAll: (self shortPrint: val)].
  			a = bytesPerWord ifTrue:
  				[(objectMemory fetchClassOf: oop) = (objectMemory splObj: ClassCompiledMethod) ifTrue:
  							[strm cr; tab; nextPutAll: (self dumpMethodHeader: val)]]].
  			prevVal := val].
  		lastLong := 256 min: (objectMemory sizeBitsOf: oop) - objectMemory baseHeaderSize.
  		hdrType = 2
  			ifTrue:
+ 			["free" strm cr; nextPutAll: (oop+(objectMemory longAt: oop)-2) hex;
+ 			space; space; nextPutAll: (oop+(objectMemory longAt: oop)-2) printString]
- 			["free" strm cr; nextPutAll: (oop+(self longAt: oop)-2) hex;
- 			space; space; nextPutAll: (oop+(self longAt: oop)-2) printString]
  			ifFalse:
  			[(objectMemory formatOf: oop) = 3
  			ifTrue:
  				[strm cr; tab; nextPutAll: '/ next 3 fields are above SP... /'.
  				lastPtr + bytesPerWord to: lastPtr+(3 * bytesPerWord) by: bytesPerWord do:
+ 					[:a | val := objectMemory longAt: oop+a.
- 					[:a | val := self longAt: oop+a.
  					strm cr; nextPutAll: a hex; 
  						space; space; space; nextPutAll: val hex8; space; space.
  					(self validOop: val) ifTrue: [strm nextPutAll: (self shortPrint: val)]]]
  			ifFalse:
  			[lastPtr + bytesPerWord to: lastLong by: bytesPerWord do:
+ 				[:a | val := objectMemory longAt: oop+a.
- 				[:a | val := self longAt: oop+a.
  				strm cr; nextPutAll: (a<16 ifTrue: [' ', a hex] ifFalse: [a hex]); 
  					space; space; space.
  				strm nextPutAll: val hex8; space; space;
  						nextPutAll: (self charsOfLong: val)]]].
  	]!

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

Item was changed:
  ----- Method: InterpreterSimulator>>nextLongFrom:swap: (in category 'initialization') -----
  nextLongFrom: aStream swap: swapFlag
  	swapFlag 
+ 		ifTrue: [^ objectMemory byteSwapped: (self nextLongFrom: aStream)]
- 		ifTrue: [^ self byteSwapped: (self nextLongFrom: aStream)]
  		ifFalse: [^ self nextLongFrom: aStream]!

Item was changed:
+ ----- Method: InterpreterSimulator>>objectMemory: (in category 'initialization') -----
- ----- Method: InterpreterSimulator>>objectMemory: (in category 'memory access') -----
  objectMemory: anObjectMemory
  	objectMemory := anObjectMemory!

Item was removed:
- ----- Method: InterpreterSimulator>>oopForPointer: (in category 'memory access') -----
- oopForPointer: pointer
- 	"This gets implemented by Macros in C, where its types will also be checked.
- 	oop is the width of a machine word, and pointer is a raw address."
- 
- 	^ pointer!

Item was removed:
- ----- Method: InterpreterSimulator>>pointerForOop: (in category 'memory access') -----
- pointerForOop: oop
- 	"This gets implemented by Macros in C, where its types will also be checked.
- 	oop is the width of a machine word, and pointer is a raw address."
- 
- 	^ oop!

Item was changed:
  ----- Method: InterpreterSimulator>>printTop: (in category 'debug support') -----
  printTop: n
  	"Print important fields of the top n contexts"
  	| ctxt classAndSel home top ip sp |
  	ctxt := activeContext.
  	^ String streamContents:
  		[:strm | 1 to: n do:
  			[:i |
  			home := (objectMemory fetchClassOf: ctxt) = (objectMemory splObj: ClassBlockContext)
  				ifTrue: [objectMemory fetchPointer: HomeIndex ofObject: ctxt]
  				ifFalse: [ctxt].
  			classAndSel := self
  				classAndSelectorOfMethod: (objectMemory fetchPointer: MethodIndex ofObject: home)
  				forReceiver: (objectMemory fetchPointer: ReceiverIndex ofObject: home).
  			strm cr; nextPutAll: ctxt hex8.
  			ctxt = home ifFalse: [strm nextPutAll: ' [] in'].
  			strm space; nextPutAll: (self nameOfClass: classAndSel first).
  			strm nextPutAll: '>>'; nextPutAll: (self shortPrint: classAndSel last).
  			ctxt = activeContext
  				ifTrue: [ip := instructionPointer - method - (objectMemory baseHeaderSize - 2).
  						sp := self stackPointerIndex - TempFrameStart + 1.
  						top := self stackTop]
  				ifFalse: [ip := objectMemory integerValueOf:
  							(objectMemory fetchPointer: InstructionPointerIndex ofObject: ctxt).
  						sp := objectMemory integerValueOf:
  							(objectMemory fetchPointer: StackPointerIndex ofObject: ctxt).
+ 						top := objectMemory longAt: ctxt + (objectMemory lastPointerOf: ctxt)].
- 						top := self longAt: ctxt + (objectMemory lastPointerOf: ctxt)].
  			strm cr; tab; nextPutAll: 'ip = '; print: ip.
  			strm cr; tab; nextPutAll: 'sp = '; print: sp.
  			strm cr; tab; nextPutAll: 'top = '; nextPutAll: (self shortPrint: top).
  			(ctxt := (objectMemory fetchPointer: SenderIndex ofObject: ctxt)) = objectMemory nilObj
  				ifTrue: [^strm contents].
  			].
  		]!

Item was changed:
  ----- Method: InterpreterSimulator>>readableFormat: (in category 'image save/restore') -----
  readableFormat: imageVersion
  	"Anwer true if images of the given format are readable by this interpreter. Allows
  	a virtual machine to accept selected older image formats.  In our case we can
  	select a newer (closure) image format as well as the existing format. Images with
  	platform-ordered floats (StackInterpreter and Cog format) are readable but will be
  	converted to traditional word ordering."
  
+ 	bytesPerWord = 4
- 	self bytesPerWord = 4
  		ifTrue: [^ (imageVersion = 6502	"Original 32-bit Squeak image format"
  			or: [imageVersion = 6504])		"32-bit with closures"
  			or: [imageVersion = 6505]]		"32-bit with closures and platform-ordered floats"
  		ifFalse: [^ (imageVersion = 68000	"Original 64-bit Squeak image format"
  			or: [imageVersion = 68002])	"64-bit with closures"
  			or: [imageVersion = 68003]]	"64-bit with closures and platform-ordered floats"
  !

Item was removed:
- ----- Method: InterpreterSimulator>>shortAt: (in category 'memory access') -----
- shortAt: byteAddress
-     "Return the half-word at byteAddress which must be even."
- 	^self subclassResponsibility!

Item was removed:
- ----- Method: InterpreterSimulator>>shortAt:put: (in category 'memory access') -----
- shortAt: byteAddress put: a16BitValue
- 	^ self subclassResponsibility!

Item was changed:
  ----- Method: InterpreterSimulator>>shortPrint: (in category 'debug support') -----
  shortPrint: oop
  	| name classOop |
  	(objectMemory isIntegerObject: oop) ifTrue: [^ '=' , (objectMemory integerValueOf: oop) printString , 
  		' (' , (objectMemory integerValueOf: oop) hex , ')'].
  	classOop := objectMemory fetchClassOf: oop.
  	(objectMemory sizeBitsOf: classOop) = (Metaclass instSize + 1 * bytesPerWord) ifTrue: [
  		^ 'class ' , (self nameOfClass: oop)].
  	name := self nameOfClass: classOop.
  	name size = 0 ifTrue: [name := '??'].
  	name = 'String' ifTrue: [^ (self stringOf: oop) printString].
  	name = 'Symbol' ifTrue: [^ '#' , (self stringOf: oop)].
  	name = 'Character' ifTrue: [^ '=' , (Character value: (objectMemory integerValueOf: 
  				(objectMemory fetchPointer: 0 ofObject: oop))) printString].
  	name = 'UndefinedObject' ifTrue: [^ 'nil'].
  	name = 'False' ifTrue: [^ 'false'].
  	name = 'True' ifTrue: [^ 'true'].
  	name = 'Float' ifTrue: [self initPrimCall. ^ '=' , (self floatValueOf: oop) printString].
  	name = 'Association' ifTrue: [^ '(' ,
+ 				(self shortPrint: (objectMemory longAt: oop + objectMemory baseHeaderSize)) ,
- 				(self shortPrint: (self longAt: oop + objectMemory baseHeaderSize)) ,
  				' -> ' ,
+ 				(objectMemory longAt: oop + objectMemory baseHeaderSize + bytesPerWord) hex8 , ')'].
- 				(self longAt: oop + objectMemory baseHeaderSize + bytesPerWord) hex8 , ')'].
  	('AEIOU' includes: name first)
  		ifTrue: [^ 'an ' , name]
  		ifFalse: [^ 'a ' , name]!

Item was changed:
  ----- Method: InterpreterSimulator>>sqFile:Read:Into:At: (in category 'file primitives') -----
  sqFile: file Read: count Into: byteArrayIndex At: startIndex
  
  	startIndex to: (startIndex + count - 1) do: [ :i |
  		file atEnd ifTrue: [ ^ i - startIndex ].
+ 		objectMemory byteAt: byteArrayIndex + i put: file next.
- 		self byteAt: byteArrayIndex + i put: file next.
  	].
  	^ count!

Item was changed:
  ----- Method: InterpreterSimulator>>sqFile:Write:From:At: (in category 'file primitives') -----
  sqFile: file Write: count From: byteArrayIndex At: startIndex
  
  	startIndex to: (startIndex + count - 1) do: [ :i |
+ 		file nextPut: (objectMemory byteAt: byteArrayIndex + i).
- 		file nextPut: (self byteAt: byteArrayIndex + i).
  	].
  	^ count!

Item was removed:
- ----- Method: InterpreterSimulator>>sqGrowMemory:By: (in category 'memory access') -----
- sqGrowMemory: oldLimit By: delta
- 
- 	transcript show: 'grow memory from ', oldLimit printString, ' by ', delta printString; cr.
- 	objectMemory memory: objectMemory memory , (objectMemory memory class new: delta // 4).
- 	^ objectMemory memory size * 4!

Item was removed:
- ----- Method: InterpreterSimulator>>sqMemoryExtraBytesLeft: (in category 'memory access') -----
- sqMemoryExtraBytesLeft: includingSwap
- 	^0!

Item was removed:
- ----- Method: InterpreterSimulator>>sqShrinkMemory:By: (in category 'memory access') -----
- sqShrinkMemory: oldLimit By: delta
- 	transcript show: 'shrink memory from ', oldLimit printString, ' by ', delta printString, ' remember it doesn''t actually shrink in simulation'; cr.
- 
- 	^ oldLimit!

Item was removed:
- ----- Method: InterpreterSimulator>>startOfMemory (in category 'initialization') -----
- startOfMemory
- 	"Return the start of object memory."
- 
- 	^ 0!

Item was changed:
  ----- Method: InterpreterSimulator>>stats (in category 'testing') -----
  stats
  	| oop fieldAddr fieldOop last stats v d |
  	stats := Bag new.
  	oop := objectMemory firstObject.
  
  'Scanning the image...' displayProgressAt: Sensor cursorPoint
  	from: oop to: objectMemory endOfMemory
  	during: [:bar |
  
  	[oop < objectMemory endOfMemory] whileTrue:
  		[(objectMemory isFreeObject: oop) ifFalse:
  			[stats add: #objects.
  			fieldAddr := oop + (objectMemory lastPointerOf: oop).
  			[fieldAddr > oop] whileTrue:
+ 				[fieldOop := objectMemory longAt: fieldAddr.
- 				[fieldOop := self longAt: fieldAddr.
  				(objectMemory isIntegerObject: fieldOop)
  					ifTrue: [v := objectMemory integerValueOf: fieldOop.
  							(v between: -16000 and: 16000)
  								ifTrue: [stats add: #ints32k]
  								ifFalse: [stats add: #intsOther]]
  					ifFalse: [fieldOop = objectMemory nilObj ifTrue: [stats add: #nil]
  							ifFalse:
  							[d := fieldOop - oop.
  							(d between: -16000 and: 16000)
  								ifTrue: [stats add: #oops32k]
  								ifFalse: [stats add: #oopsOther]]].
  				fieldAddr := fieldAddr - bytesPerWord]].
  		bar value: oop.
  		last := oop.
  		last := last.
  		oop := objectMemory objectAfter: oop]].
  	^ stats sortedElements!

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

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

Item was changed:
  ----- Method: InterpreterSimulator>>symbolicExtensions:at:inMethod: (in category 'debug printing') -----
  symbolicExtensions: offset at: ip inMethod: meth
  	| type offset2 byte2 byte3 |
  	offset <=6 ifTrue: 
  		["Extended op codes 128-134"
+ 		byte2 := objectMemory byteAt: ip+1.
- 		byte2 := self byteAt: ip+1.
  		offset <= 2 ifTrue:
  			["128-130:  extended pushes and pops"
  			type := byte2 // 64.
  			offset2 := byte2 \\ 64.
  			offset = 0 ifTrue: 
  				[type = 0 ifTrue: [^ 'pushRcvr ' , offset2 printString].
  				type = 1 ifTrue: [^ 'pushTemp ' , offset2 printString].
  				type = 2  ifTrue: [^ 'pushLit ' , (offset2 + 1) printString].
  				type = 3 ifTrue: [^ 'pushLitVar ' , (offset2 + 1) printString]].
  			offset = 1 ifTrue: 
  				[type = 0 ifTrue: [^ 'storeIntoRcvr ' , offset2 printString].
  				type = 1 ifTrue: [^ 'storeIntoTemp ' , offset2 printString].
  				type = 2 ifTrue: [^ 'illegalStore'].
  				type = 3 ifTrue: [^ 'storeIntoLitVar ' , (offset2 + 1) printString]].
  			offset = 2 ifTrue: 
  				[type = 0 ifTrue: [^ 'storePopRcvr ' , offset2 printString].
  				type = 1 ifTrue: [^ 'storePopTemp ' , offset2 printString].
  				type = 2 ifTrue: [^ 'illegalStore'].
  				type = 3  ifTrue: [^ 'storePopLitVar ' , (offset2 + 1) printString]]].
  		"131-134: extended sends"
  		offset = 3 ifTrue:  "Single extended send"
  			[^ 'send ' , (self stringOf: (self literal: byte2 \\ 32))].
  		offset = 4 ifTrue:    "Double extended do-anything"
+ 			[byte3 := objectMemory byteAt: ip+2.
- 			[byte3 := self byteAt: ip+2.
  			type := byte2 // 32.
  			type = 0 ifTrue: [^ 'send ' , (self stringOf: (self literal: byte3))].
  			type = 1 ifTrue: [^ 'superSend ' , (self stringOf: (self literal: byte3))].
  			type = 2 ifTrue: [^ 'pushRcvr ' , byte3 printString].
  			type = 3 ifTrue: [^ 'pushLit ' , byte3 printString].
  			type = 4 ifTrue: [^ 'pushLitVar ' , byte3 printString].
  			type = 5 ifTrue: [^ 'storeIntoRcvr ' , byte3 printString].
  			type = 6 ifTrue: [^ 'storePopRcvr ' , byte3 printString].
  			type = 7 ifTrue: [^ 'storeIntoLitVar ' , byte3 printString]].
  		offset = 5 ifTrue:  "Single extended send to super"
  			[^ 'superSend ' , (self stringOf: (self literal: byte2 \\ 32))].
  		offset = 6 ifTrue:   "Second extended send"
  			[^ 'send ' , (self stringOf: (self literal: byte2 \\ 64))]].
  	offset = 7 ifTrue: [^ 'doPop'].
  	offset = 8 ifTrue: [^ 'doDup'].
  	offset = 9 ifTrue: [^ 'pushActiveContext'].
  	^ 'unusedBytecode'!

Item was changed:
  ----- Method: InterpreterSimulator>>validOop: (in category 'testing') -----
  validOop: oop
  	" Return true if oop appears to be valid "
  	(oop bitAnd: 1) = 1 ifTrue: [^ true].  "Integer"
  	(oop bitAnd: 3) = 0 ifFalse: [^ false].  "Uneven address"
  	oop >= objectMemory endOfMemory ifTrue: [^ false].  "Out of range"
  	"could test if within the first large freeblock"
+ 	(objectMemory longAt: oop) = 4 ifTrue: [^ false].
- 	(self longAt: oop) = 4 ifTrue: [^ false].
  	(objectMemory headerType: oop) = 2 ifTrue: [^ false].	"Free object"
  	^ true!

Item was changed:
  ----- Method: InterpreterSimulator>>validate: (in category 'testing') -----
  validate: oop
  	| header type cc sz fmt nextChunk | 
+ 	header := objectMemory longAt: oop.
- 	header := self longAt: oop.
  	type := header bitAnd: 3.
  	type = 2 ifFalse: [type = (objectMemory rightType: header) ifFalse: [self halt]].
  	sz := (header bitAnd: objectMemory sizeMask) >> 2.
  	(objectMemory isFreeObject: oop)
  		ifTrue: [ nextChunk := oop + (objectMemory sizeOfFree: oop) ]
  		ifFalse: [  nextChunk := oop + (objectMemory sizeBitsOf: oop) ].
  	nextChunk > objectMemory endOfMemory
  		ifTrue: [oop = objectMemory endOfMemory ifFalse: [self halt]].
  	(objectMemory headerType: nextChunk) = 0 ifTrue: [
  		(objectMemory headerType: (nextChunk + (bytesPerWord * 2))) = 0 ifFalse: [self halt]].
  	(objectMemory headerType: nextChunk) = 1 ifTrue: [
  		(objectMemory headerType: (nextChunk + bytesPerWord)) = 1 ifFalse: [self halt]].
  	type = 2 ifTrue:
  		["free block" ^ self].
  	fmt := (header >> 8) bitAnd: 16rF.
  	cc := (header >> 12) bitAnd: 31.
  	cc > 16 ifTrue: [self halt].	"up to 32 are legal, but not used"
  	type = 0 ifTrue:
  		["three-word header"
+ 		((objectMemory longAt: oop - bytesPerWord) bitAnd: 3) = type ifFalse: [self halt].
+ 		((objectMemory longAt: oop-(bytesPerWord * 2)) bitAnd: 3) = type ifFalse: [self halt].
+ 		((objectMemory longAt: oop - bytesPerWord) = type) ifTrue: [self halt].	"Class word is 0"
- 		((self longAt: oop - bytesPerWord) bitAnd: 3) = type ifFalse: [self halt].
- 		((self longAt: oop-(bytesPerWord * 2)) bitAnd: 3) = type ifFalse: [self halt].
- 		((self longAt: oop - bytesPerWord) = type) ifTrue: [self halt].	"Class word is 0"
  		sz = 0 ifFalse: [self halt]].
  	type = 1 ifTrue:
  		["two-word header"
+ 		((objectMemory longAt: oop - bytesPerWord) bitAnd: 3) = type ifFalse: [self halt].
- 		((self longAt: oop - bytesPerWord) bitAnd: 3) = type ifFalse: [self halt].
  		cc > 0 ifTrue: [sz = 1 ifFalse: [self halt]].
  		sz = 0 ifTrue: [self halt]].
  	type = 3 ifTrue:
  		["one-word header"
  		cc = 0 ifTrue: [self halt]].
  	fmt = 5 ifTrue: [self halt].
  	fmt = 7 ifTrue: [self halt].
  	fmt >= 12 ifTrue:
  		["CompiledMethod -- check for integer header"
+ 		(objectMemory isIntegerObject: (objectMemory longAt: oop + bytesPerWord)) ifFalse: [self halt]].!
- 		(objectMemory isIntegerObject: (self longAt: oop + bytesPerWord)) ifFalse: [self halt]].!

Item was changed:
  ----- Method: InterpreterSimulator>>validateOopsIn: (in category 'testing') -----
  validateOopsIn: object
  	| fieldPtr limit former header | 
  	"for each oop in me see if it is legal"
  	fieldPtr := object + objectMemory baseHeaderSize.	"first field"
  	limit := object + (objectMemory lastPointerOf: object).	"a good field"
  	[fieldPtr > limit] whileFalse: [
+ 		former := objectMemory longAt: fieldPtr.
- 		former := self longAt: fieldPtr.
  		(self validOop: former) ifFalse: [self error: 'invalid oop in pointers object'].
  		fieldPtr := fieldPtr + bytesPerWord].
  	"class"
  	header := objectMemory baseHeader: object.
  	(header bitAnd: CompactClassMask) = 0 ifTrue: [	
  		former := (objectMemory classHeader: object) bitAnd: objectMemory allButTypeMask.
  		(self validOop: former) ifFalse: [self halt]].!

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

Item was removed:
- ----- Method: InterpreterSimulatorLSB>>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 removed:
- ----- Method: InterpreterSimulatorLSB>>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.
- !

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

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

Item was removed:
- ----- Method: InterpreterSimulatorLSB>>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 removed:
- ----- Method: InterpreterSimulatorLSB>>shortAt:put: (in category 'memory access') -----
- shortAt: byteAddress put: a16BitValue
-     "Return the half-word at byteAddress which must be even."
- 	| lowBits long longAddress |
- 	lowBits := byteAddress bitAnd: 2.
- 	lowBits = 0
- 		ifTrue:
- 		[ "storing into LS word"
- 		long := self longAt: byteAddress.
- 		self longAt: byteAddress
- 				put: ((long bitAnd: 16rFFFF0000) bitOr: a16BitValue)
- 		]
- 		ifFalse:
- 		[longAddress := byteAddress - 2.
- 		long := self longAt: longAddress.
- 		self longAt: longAddress
- 				put: ((long bitAnd: 16rFFFF) bitOr: (a16BitValue bitShift: 16))
- 		]!

Item was removed:
- ----- Method: InterpreterSimulatorLSB64>>byteSwapped: (in category 'memory access') -----
- byteSwapped: w
- 	"Return the given integer with its bytes in the reverse order."
- 
- 	^ (super byteSwapped: ((w bitShift: -32) bitAnd: 16rFFFFFFFF)) +
- 	  ((super byteSwapped: (w bitAnd: 16rFFFFFFFF)) bitShift: 32)!

Item was changed:
  ----- Method: InterpreterSimulatorLSB64>>initialize (in category 'initialization') -----
  initialize
  
+ 	objectMemory bytesPerWord: 8; initialize.
- 	bytesPerWord := 8.
  	super initialize!

Item was removed:
- ----- Method: InterpreterSimulatorLSB64>>long32At: (in category 'memory access') -----
- long32At: byteAddress
- 
- 	"Return the 32-bit word at byteAddress which must be 0 mod 4."
- 	| lowBits long |
- 	lowBits := byteAddress bitAnd: 4.
- 	long := self longAt: byteAddress - lowBits.
- 	^ lowBits = 4
- 		ifTrue: [ long bitShift: -32 ]
- 		ifFalse: [ long bitAnd: 16rFFFFFFFF ].
- !

Item was removed:
- ----- Method: InterpreterSimulatorLSB64>>long32At:put: (in category 'memory access') -----
- long32At: byteAddress put: a32BitValue
- 	"Store the 32-bit value at byteAddress which must be 0 mod 4."
- 	| lowBits long64 longAddress |
- 	lowBits := byteAddress bitAnd: 4.
- 	lowBits = 0
- 		ifTrue:
- 		[ "storing into LS word"
- 		long64 := self longAt: byteAddress.
- 		self longAt: byteAddress
- 				put: ((long64 bitAnd: 16rFFFFFFFF00000000) bitOr: a32BitValue)
- 		]
- 		ifFalse:
- 		[longAddress := byteAddress - 4.
- 		long64 := self longAt: longAddress.
- 		self longAt: longAddress
- 				put: ((long64 bitAnd: 16rFFFFFFFF) bitOr: (a32BitValue bitShift: 32))
- 		]!

Item was removed:
- ----- Method: InterpreterSimulatorLSB64>>longAt: (in category 'memory access') -----
- longAt: byteAddress
- 	"Note: Adjusted for Smalltalk's 1-based array indexing."
- 
- 	^ (super longAt: byteAddress) bitOr: ((super longAt: byteAddress + 4) bitShift: 32)!

Item was removed:
- ----- Method: InterpreterSimulatorLSB64>>longAt:put: (in category 'memory access') -----
- longAt: byteAddress put: a64BitValue
- 	"Note: Adjusted for Smalltalk's 1-based array indexing."
- 
- 	super longAt: byteAddress + 4 put: (a64BitValue bitShift: -32).
- 	super longAt: byteAddress put: (a64BitValue bitAnd: 16rFFFFFFFF).
- 	^ a64BitValue!

Item was removed:
- ----- Method: InterpreterSimulatorMSB>>byteAt: (in category 'memory access') -----
- byteAt: byteAddress
- 	| lowBits bpwMinus1 |
- 	bpwMinus1 := bytesPerWord - 1.
- 	lowBits := byteAddress bitAnd: bpwMinus1.
- 	^ ((self longAt: byteAddress - lowBits)
- 		bitShift: (lowBits - bpwMinus1) * 8)
- 		bitAnd: 16rFF!

Item was removed:
- ----- Method: InterpreterSimulatorMSB>>byteAt:put: (in category 'memory access') -----
- byteAt: byteAddress put: byte
- 	| longWord shift lowBits bpwMinus1 longAddress |
- 	bpwMinus1 := bytesPerWord - 1.
- 	lowBits := byteAddress bitAnd: bpwMinus1.
- 	longAddress := byteAddress - lowBits.
- 	longWord := self longAt: longAddress.
- 	shift := (bpwMinus1 - lowBits) * 8.
- 	longWord := longWord
- 				- (longWord bitAnd: (16rFF bitShift: shift))
- 				+ (byte bitShift: shift).
- 	self longAt: longAddress put: longWord!

Item was removed:
- ----- Method: InterpreterSimulatorMSB>>halfWordHighInLong32: (in category 'memory access') -----
- halfWordHighInLong32: long32
- 	"Used by Balloon"
- 
- 	^ long32 bitShift: -16!

Item was removed:
- ----- Method: InterpreterSimulatorMSB>>halfWordLowInLong32: (in category 'memory access') -----
- halfWordLowInLong32: long32
- 	"Used by Balloon"
- 
- 	^ long32 bitAnd: 16rFFFF!

Item was removed:
- ----- Method: InterpreterSimulatorMSB>>shortAt: (in category 'memory access') -----
- shortAt: byteAddress
-     "Return the half-word at byteAddress which must be even."
- 	| lowBits bpwMinus2 |
- 	bpwMinus2 := bytesPerWord - 2.
- 	lowBits := byteAddress bitAnd: bpwMinus2.
- 	^ ((self longAt: byteAddress - lowBits)
- 		bitShift: (lowBits - bpwMinus2) * 8)
- 		bitAnd: 16rFFFF
- !

Item was removed:
- ----- Method: InterpreterSimulatorMSB>>shortAt:put: (in category 'memory access') -----
- shortAt: byteAddress put: a16BitValue
-     "Return the half-word at byteAddress which must be even."
- 	| longWord shift lowBits bpwMinus2 longAddress |
- 	bpwMinus2 := bytesPerWord - 2.
- 	lowBits := byteAddress bitAnd: bpwMinus2.
- 	longAddress := byteAddress - lowBits.
- 	longWord := self longAt: longAddress.
- 	shift := (bpwMinus2 - lowBits) * 8.
- 	longWord := longWord
- 				- (longWord bitAnd: (16rFFFF bitShift: shift))
- 				+ (a16BitValue bitShift: shift).
- 	self longAt: longAddress put: longWord
- !

Item was removed:
- ----- Method: InterpreterSimulatorMSB64>>byteSwapped: (in category 'memory access') -----
- byteSwapped: w
- 	"Return the given integer with its bytes in the reverse order."
- 
- 	^ (super byteSwapped: ((w bitShift: -32) bitAnd: 16rFFFFFFFF)) +
- 	  ((super byteSwapped: (w bitAnd: 16rFFFFFFFF)) bitShift: 32)!

Item was changed:
  ----- Method: InterpreterSimulatorMSB64>>initialize (in category 'initialization') -----
  initialize
  
+ 	objectMemory bytesPerWord: 8; initialize.
- 	bytesPerWord := 8.
  	super initialize!

Item was removed:
- ----- Method: InterpreterSimulatorMSB64>>long32At: (in category 'memory access') -----
- long32At: byteAddress
- 	"Return the 32-bit word at byteAddress which must be 0 mod 4."
- 
- 	^ super longAt: byteAddress!

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

Item was removed:
- ----- Method: InterpreterSimulatorMSB64>>longAt: (in category 'memory access') -----
- longAt: byteAddress
- 	"Note: Adjusted for Smalltalk's 1-based array indexing."
- 
- 	^ ((super longAt: byteAddress) bitShift: 32) bitOr: (super longAt: byteAddress + 4)!

Item was removed:
- ----- Method: InterpreterSimulatorMSB64>>longAt:put: (in category 'memory access') -----
- longAt: byteAddress put: a64BitValue
- 	"Note: Adjusted for Smalltalk's 1-based array indexing."
- 
- 	super longAt: byteAddress put: (a64BitValue bitShift: -32).
- 	super longAt: byteAddress + 4 put: (a64BitValue bitAnd: 16rFFFFFFFF).
- 	^ a64BitValue!

Item was changed:
  VMClass subclass: #ObjectMemory
+ 	instanceVariableNames: 'interpreter memory youngStart endOfMemory memoryLimit nilObj falseObj trueObj specialObjectsOop rootTable rootTableCount extraRoots extraRootCount weakRoots weakRootCount child field parentField freeBlock lastHash allocationCount lowSpaceThreshold signalLowSpace compStart compEnd fwdTableNext fwdTableLast remapBuffer remapBufferCount allocationsBetweenGCs tenuringThreshold gcSemaphoreIndex gcBiasToGrow gcBiasToGrowGCLimit gcBiasToGrowThreshold statFullGCs statFullGCMSecs statFullGCUsecs statIncrGCs statIncrGCMSecs statIncrGCUsecs statIGCDeltaUsecs statTenures statRootTableOverflows freeContexts freeLargeContexts totalObjectCount shrinkThreshold growHeadroom headerTypeBytes youngStartLocal statMarkCount statSweepCount statMkFwdCount statCompMoveCount statGrowMemory statShrinkMemory statRootTableCount statAllocationCount statSurvivorCount statGCTime statSpecialMarkCount statIGCDeltaTime statpendingFinalizationSignals forceTenureFlag gcStartUsecs'
- 	instanceVariableNames: 'memory youngStart endOfMemory memoryLimit nilObj falseObj trueObj specialObjectsOop rootTable rootTableCount extraRoots extraRootCount weakRoots weakRootCount child field parentField freeBlock lastHash allocationCount lowSpaceThreshold signalLowSpace compStart compEnd fwdTableNext fwdTableLast remapBuffer remapBufferCount allocationsBetweenGCs tenuringThreshold gcSemaphoreIndex gcBiasToGrow gcBiasToGrowGCLimit gcBiasToGrowThreshold statFullGCs statFullGCMSecs statFullGCUsecs statIncrGCs statIncrGCMSecs statIncrGCUsecs statIGCDeltaUsecs statTenures statRootTableOverflows freeContexts freeLargeContexts totalObjectCount shrinkThreshold growHeadroom headerTypeBytes youngStartLocal statMarkCount statSweepCount statMkFwdCount statCompMoveCount statGrowMemory statShrinkMemory statRootTableCount statAllocationCount statSurvivorCount statGCTime statSpecialMarkCount statIGCDeltaTime statpendingFinalizationSignals forceTenureFlag gcStartUsecs'
  	classVariableNames: 'Byte0Mask Byte0Shift Byte1Mask Byte1Shift Byte1ShiftNegated Byte2Mask Byte2Shift Byte3Mask Byte3Shift Byte3ShiftNegated Byte4Mask Byte4Shift Byte4ShiftNegated Byte5Mask Byte5Shift Byte5ShiftNegated Byte6Mask Byte6Shift Byte7Mask Byte7Shift Byte7ShiftNegated Bytes3to0Mask Bytes7to4Mask ClassPseudoContext ClassTranslatedMethod ContextFixedSizePlusHeader Done ExtraRootSize GCTopMarker HashBits HeaderTypeClass HeaderTypeFree HeaderTypeGC InvokeCallbackSelector NilContext RemapBufferSize RootTableRedZone RootTableSize StartField StartObj Upward'
  	poolDictionaries: 'VMBasicConstants VMObjectIndices VMSqueakV3BytecodeConstants VMSqueakV3ObjectRepresentationConstants'
  	category: 'VMMaker-Interpreter'!
  
  !ObjectMemory commentStamp: '<historical>' prior: 0!
  This class describes a 32-bit direct-pointer object memory for Smalltalk.  The model is very simple in principle:  a pointer is either a SmallInteger or a 32-bit direct object pointer.
  
  SmallIntegers are tagged with a low-order bit equal to 1, and an immediate 31-bit 2s-complement signed value in the rest of the word.
  
  All object pointers point to a header, which may be followed by a number of data fields.  This object memory achieves considerable compactness by using a variable header size (the one complexity of the design).  The format of the 0th header word is as follows:
  
  	3 bits	reserved for gc (mark, root, unused)
  	12 bits	object hash (for HashSets)
  	5 bits	compact class index
  	4 bits	object format
  	6 bits	object size in 32-bit words
  	2 bits	header type (0: 3-word, 1: 2-word, 2: forbidden, 3: 1-word)
  
  If a class is in the compact class table, then this is the only header information needed.  If it is not, then it will have another header word at offset -4 bytes with its class in the high 30 bits, and the header type repeated in its low 2 bits.  It the objects size is greater than 255 bytes, then it will have yet another header word at offset -8 bytes with its full word size in the high 30 bits and its header type repeated in the low two bits.
  
  The object format field provides the remaining information as given in the formatOf: method (including isPointers, isVariable, isBytes, and the low 2 size bits of byte-sized objects).
  
  This implementation includes incremental (2-generation) and full garbage collection, each with compaction and rectification of direct pointers.  It also supports a bulk-become (exchange object identity) feature that allows many objects to be becomed at once, as when all instances of a class must be grown or shrunk.
  
  There is now a simple 64-bit version of the object memory.  It is the simplest possible change that could work.  It merely sign-extends all integer oops, and extends all object headers and oops by adding 32 zeroes in the high bits.  The format of the base header word is changed in one minor, not especially elegant, way.  Consider the old 32-bit header:
  	ggghhhhhhhhhhhhcccccffffsssssstt
  The 64-bit header is almost identical, except that the size field (now being in units of 8 bytes, has a zero in its low-order bit.  At the same time, the byte-size residue bits for byte objects, which are in the low order bits of formats 8-11 and 12-15, are now in need of another bit of residue.  So, the change is as follows:
  	ggghhhhhhhhhhhhcccccffffsssssrtt
  where bit r supplies the 4's bit of the byte size residue for byte objects.  Oh, yes, this is also needed now for 'variableWord' objects, since their size in 32-bit words requires a low-order bit.
  
  See the comment in formatOf: for the change allowing for 64-bit wide bitmaps, now dubbed 'variableLong'.!

Item was changed:
  ----- Method: ObjectMemory>>allocate:headerSize:h1:h2:h3:doFill:with: (in category 'allocation') -----
  allocate: byteSize headerSize: hdrSize h1: baseHeader h2: classOop h3: extendedSize doFill: doFill with: fillWord 
  	"Allocate a new object of the given size and number of header words. (Note: byteSize already includes space for the base header word.) Initialize the header fields of the new object and fill the remainder of the object with the given value.
  	May cause a GC"
  
  	| newObj remappedClassOop end i |
  	<inline: true>
  	<var: #i type: 'usqInt'>
  	<var: #end type: 'usqInt'>
  	"remap classOop in case GC happens during allocation"
  	hdrSize > 1 ifTrue: [self pushRemappableOop: classOop].
  	newObj := self allocateChunk: byteSize + (hdrSize - 1 * self bytesPerWord).
  	hdrSize > 1 ifTrue: [remappedClassOop := self popRemappableOop].
  
  	hdrSize = 3
  		ifTrue: [self longAt: newObj put: (extendedSize bitOr: HeaderTypeSizeAndClass).
  			self longAt: newObj + self bytesPerWord put: (remappedClassOop bitOr: HeaderTypeSizeAndClass).
  			self longAt: newObj + (self bytesPerWord*2) put: (baseHeader bitOr: HeaderTypeSizeAndClass).
  			newObj := newObj + (self bytesPerWord*2)].
  
  	hdrSize = 2
  		ifTrue: [self longAt: newObj put: (remappedClassOop bitOr: HeaderTypeClass).
  			self longAt: newObj + self bytesPerWord put: (baseHeader bitOr: HeaderTypeClass).
  			newObj := newObj + self bytesPerWord].
  
  	hdrSize = 1
  		ifTrue: [self longAt: newObj put: (baseHeader bitOr: HeaderTypeShort)].
  	"clear new object"
  	doFill ifTrue: [end := newObj + byteSize.
  			i := newObj + self bytesPerWord.
  			[i < end] whileTrue: [self longAt: i put: fillWord.
  					i := i + self bytesPerWord]].
  	DoAssertionChecks
  		ifTrue: [self okayOop: newObj.
+ 			interpreter oopHasOkayClass: newObj.
- 			self oopHasOkayClass: newObj.
  			(self objectAfter: newObj) = freeBlock
  				ifFalse: [self error: 'allocate bug: did not set header of new oop correctly'].
  			(self objectAfter: freeBlock) = endOfMemory
  				ifFalse: [self error: 'allocate bug: did not set header of freeBlock correctly']].
  
  	^newObj!

Item was changed:
  ----- Method: ObjectMemory>>allocateChunk: (in category 'allocation') -----
  allocateChunk: byteSize 
  	"Allocate a chunk of the given size. Sender must be sure that  the requested size includes enough space for the header  word(s). " 
  	"Details: To limit the time per incremental GC, do one every so many allocations. The number is settable via primitiveVMParameter to tune your memory system"
  	| enoughSpace newFreeSize newChunk |
  	<inline: true>
  
  	allocationCount >= allocationsBetweenGCs
  		ifTrue: ["do an incremental GC every so many allocations to  keep pauses short"
  			self incrementalGC].
  
  	enoughSpace := self sufficientSpaceToAllocate: byteSize.
  	enoughSpace
  		ifFalse: ["signal that space is running low, but proceed with allocation if possible"
  			signalLowSpace := true.
  			lowSpaceThreshold := 0. "disable additional interrupts until lowSpaceThreshold is reset by image"
+ 			interpreter saveProcessSignalingLowSpace.
+ 			interpreter forceInterruptCheck].
- 			self saveProcessSignalingLowSpace.
- 			self forceInterruptCheck].
  	(self oop: (self sizeOfFree: freeBlock) isLessThan: byteSize + self baseHeaderSize)
  		ifTrue: [self error: 'out of memory'].
  
  	"if we get here, there is enough space for allocation to  succeed "
  	newFreeSize := (self sizeOfFree: freeBlock) - byteSize.
  	newChunk := freeBlock.
  	freeBlock := freeBlock + byteSize.
  
  	"Assume: client will initialize object header of free chunk, so following is not needed:"
  	"self setSizeOfFree: newChunk to: byteSize."
  	self setSizeOfFree: freeBlock to: newFreeSize.
  	allocationCount := allocationCount + 1.
  	^newChunk!

Item was changed:
  ----- Method: ObjectMemory>>become:with:twoWay:copyHash: (in category 'become') -----
  become: array1 with: array2 twoWay: twoWayFlag copyHash: copyHashFlag 
  	"All references to each object in array1 are swapped with all references to the corresponding object in array2. That is, all pointers to one object are replaced with with pointers to the other. The arguments must be arrays of the same length. 
  	Returns true if the primitive succeeds."
  	"Implementation: Uses forwarding blocks to update references as done in compaction."
  	(self isArray: array1) ifFalse: [^false].
  	(self isArray: array2) ifFalse: [^false].
  	(self lastPointerOf: array1) = (self lastPointerOf: array2) ifFalse: [^false].
  	(self containOnlyOops: array1 and: array2) ifFalse: [^false].
  
  	(self prepareForwardingTableForBecoming: array1 with: array2 twoWay: twoWayFlag) ifFalse: [^false]. "fail; not enough space for forwarding table"
  
  	(self allYoung: array1 and: array2)
  		ifTrue: ["sweep only the young objects plus the roots"
  			self mapPointersInObjectsFrom: youngStart to: endOfMemory]
  		ifFalse: ["sweep all objects"
  			self mapPointersInObjectsFrom: self startOfMemory to: endOfMemory].
  	twoWayFlag
  		ifTrue: [self restoreHeadersAfterBecoming: array1 with: array2]
  		ifFalse: [self restoreHeadersAfterForwardBecome: copyHashFlag].
  
  	self initializeMemoryFirstFree: freeBlock. "re-initialize memory used for forwarding table"
  	
+ 	interpreter forceInterruptCheck. "pretty much guaranteed to take a long time, so check for timers etc ASAP"
- 	self forceInterruptCheck. "pretty much guaranteed to take a long time, so check for timers etc ASAP"
  
  	^true "success"!

Item was added:
+ ----- Method: ObjectMemory>>byteSizeOf: (in category 'object format') -----
+ byteSizeOf: oop
+ 	| slots |
+ self flag: #Dan.
+ 	(self isIntegerObject: oop) ifTrue:[^0].
+ 	slots := self slotSizeOf: oop.
+ 	(self isBytesNonInt: oop)
+ 		ifTrue:[^slots]
+ 		ifFalse:[^slots * 4]!

Item was removed:
- ----- Method: ObjectMemory>>characterTable (in category 'plugin support') -----
- characterTable
- 	^self splObj: CharacterTable!

Item was changed:
  ----- Method: ObjectMemory>>finalizeReference: (in category 'finalization') -----
  finalizeReference: oop 
  	"During sweep phase we have encountered a weak reference. 
  	Check if  its object has gone away (or is about to) and if so, signal a 
  	semaphore. "
  	"Do *not* inline this in sweepPhase - it is quite an unlikely 
  	case to run into a weak reference"
  	| weakOop oopGone chunk firstField lastField nonWeakCnt  |
  	<inline: false>
  	<var: #oop type: 'usqInt'>
  	<var: #weakOop type: 'usqInt'>
  	nonWeakCnt := self nonWeakFieldsOf: oop.
  	firstField := self baseHeaderSize + (nonWeakCnt << self shiftForWord).
  	lastField := self lastPointerOf: oop.
  	firstField to: lastField by: self bytesPerWord do: [:i | 
  			weakOop := self longAt: oop + i.
  			"ar 1/18/2005: Added oop < youngStart test to make sure we're not testing
  			objects in non-GCable region. This could lead to a forward reference in
  			old space with the oop pointed to not being marked and thus treated as free."
  			(weakOop == nilObj or: [(self isIntegerObject: weakOop) or:[weakOop < youngStart]])
  
  				ifFalse: ["Check if the object is being collected. 
  					If the weak reference points  
  					* backward: check if the weakOops chunk is free
  					* forward: check if the weakOoop has been marked by GC"
  					weakOop < oop
  						ifTrue: [chunk := self chunkFromOop: weakOop.
  							oopGone := ((self longAt: chunk) bitAnd: TypeMask) = HeaderTypeFree]
  						ifFalse: [oopGone := ((self baseHeader: weakOop) bitAnd: self markBit) = 0].
  					oopGone ifTrue: ["Store nil in the pointer and signal the  interpreter "
  							self longAt: oop + i put: nilObj.
  							nonWeakCnt >= 2 ifTrue: [ self weakFinalizerCheck: oop ].
+ 							interpreter signalFinalization: oop]]]!
- 							self signalFinalization: oop]]]!

Item was added:
+ ----- Method: ObjectMemory>>firstFixedField: (in category 'plugin support') -----
+ firstFixedField: oop
+ 
+ 	<returnTypeC: 'char *'>
+ 	^ self pointerForOop: oop + self baseHeaderSize!

Item was added:
+ ----- Method: ObjectMemory>>firstIndexableField: (in category 'plugin support') -----
+ firstIndexableField: oop
+ 	"NOTE: copied in InterpreterSimulator, so please duplicate any changes"
+ 
+ 	| hdr fmt totalLength fixedFields |
+ 	<returnTypeC: 'char *'>
+ 	hdr := self baseHeader: oop.
+ 	fmt := (hdr >> 8) bitAnd: 16rF.
+ 	totalLength := self lengthOf: oop baseHeader: hdr format: fmt.
+ 	fixedFields := self fixedFieldsOf: oop format: fmt length: totalLength.
+ 	fmt < 8 ifTrue:
+ 		[fmt = 6 ifTrue:
+ 			["32 bit field objects"
+ 			^ self pointerForOop: oop + self baseHeaderSize + (fixedFields << 2)].
+ 		"full word objects (pointer or bits)"
+ 		^ self pointerForOop: oop + self baseHeaderSize + (fixedFields << self shiftForWord)]
+ 	ifFalse:
+ 		["Byte objects"
+ 		^ self pointerForOop: oop + self baseHeaderSize + fixedFields]!

Item was added:
+ ----- Method: ObjectMemory>>fixedFieldsOf:format:length: (in category 'object format') -----
+ fixedFieldsOf: oop format: fmt length: wordLength
+ "
+ 	NOTE: This code supports the backward-compatible extension to 8 bits of instSize.
+ 	When we revise the image format, it should become...
+ 	^ (classFormat >> 2 bitAnd: 16rFF) - 1
+ "
+ 	| class classFormat |
+ 	<inline: true>
+ 	((fmt > 4) or: [fmt = 2]) ifTrue: [^ 0].  "indexable fields only"
+ 	fmt < 2 ifTrue: [^ wordLength].  "fixed fields only (zero or more)"
+ 	
+ 	"fmt = 3 or 4: mixture of fixed and indexable fields, so must look at class format word"
+ 	class := self fetchClassOf: oop.
+ 	classFormat := self formatOfClass: class.
+ 	^ (classFormat >> 11 bitAnd: 16rC0) + (classFormat >> 2 bitAnd: 16r3F) - 1
+ !

Item was added:
+ ----- Method: ObjectMemory>>formatOfClass: (in category 'object format') -----
+ formatOfClass: classPointer
+ 	"**should be in-lined**"
+ 	"Note that, in Smalltalk, the instSpec will be equal to the inst spec
+ 	part of the base header of an instance (without hdr type) shifted left 1.
+ 	In this way, apart from the smallInt bit, the bits
+ 	are just where you want them for the first header word."
+ 	"Callers expect low 2 bits (header type) to be zero!!"
+ 
+ 	^ (self fetchPointer: InstanceSpecificationIndex ofObject: classPointer) - 1!

Item was changed:
  ----- Method: ObjectMemory>>fullGC (in category 'garbage collection') -----
  fullGC
  	"Do a mark/sweep garbage collection of the entire object memory. Free inaccessible objects but do not move them."
  
  	| startTime |
  	<inline: false>
  	<var: #startTime type: 'sqLong'>
+ 	DoAssertionChecks ifTrue: [interpreter reverseDisplayFrom: 0 to: 7].
+ 	interpreter preGCAction: true.
+ 	startTime := interpreter ioMicroSecondClock.
- 	DoAssertionChecks ifTrue: [self reverseDisplayFrom: 0 to: 7].
- 	self preGCAction: true.
- 	startTime := self ioMicroSecondClock.
  	statSweepCount := statMarkCount := statMkFwdCount := statCompMoveCount := 0.
  	self clearRootsTable.
  	youngStart := self startOfMemory.  "process all of memory"
  	self markPhase.
  	"Sweep phase returns the number of survivors.
  	Use the up-to-date version instead the one from startup."
  	totalObjectCount := self sweepPhase.
  	self fullCompaction.
  	allocationCount := 0.
  	statFullGCs := statFullGCs + 1.
+ 	statGCTime := interpreter ioMicroSecondClock.
- 	statGCTime := self ioMicroSecondClock.
  	statFullGCMSecs := statFullGCMSecs + (statGCTime - startTime).
+ 	interpreter capturePendingFinalizationSignals.
- 	self capturePendingFinalizationSignals.
  
  	youngStart := freeBlock.  "reset the young object boundary"
+ 	interpreter postGCAction.
+ 	DoAssertionChecks ifTrue: [interpreter reverseDisplayFrom: 0 to: 7].
- 	self postGCAction.
- 	DoAssertionChecks ifTrue: [self reverseDisplayFrom: 0 to: 7].
  !

Item was changed:
  ----- Method: ObjectMemory>>imageSegmentVersion (in category 'image segment in/out') -----
  imageSegmentVersion
  	| wholeWord |
  	"a more complex version that tells both the word reversal and the endianness of the machine it came from.  Low half of word is 6502.  Top byte is top byte of #doesNotUnderstand: on this machine. ($d on the Mac or $s on the PC)"
  
  	wholeWord := self longAt: (self splObj: SelectorDoesNotUnderstand) + self baseHeaderSize.
  		"first data word, 'does' "
+ 	^ interpreter imageFormatVersion bitOr: (wholeWord bitAnd: 16rFF000000)!
- 	^ self imageFormatVersion bitOr: (wholeWord bitAnd: 16rFF000000)!

Item was changed:
  ----- Method: ObjectMemory>>incrementalGC (in category 'garbage collection') -----
  incrementalGC
  	"Do a mark/sweep garbage collection of just the young object 
  	area of object memory (i.e., objects above youngStart), using 
  	the root table to identify objects containing pointers to 
  	young objects from the old object area."
  	| survivorCount startTime weDidGrow |
  	<inline: false>
  	<var: #startTime type: 'sqLong'>
  	rootTableCount >= RootTableSize
  		ifTrue: ["root table overflow; cannot do an incremental GC (this should be very rare)"
  			statRootTableOverflows := statRootTableOverflows + 1.
  			^ self fullGC].
  	DoAssertionChecks
+ 		ifTrue: [interpreter reverseDisplayFrom: 8 to: 15.
- 		ifTrue: [self reverseDisplayFrom: 8 to: 15.
  			self validateRoots; validate].
  
+ 	interpreter preGCAction: false.
- 	self preGCAction: false.
  	"incremental GC and compaction"
  
+ 	startTime := interpreter ioMicroSecondClock.
- 	startTime := self ioMicroSecondClock.
  	weakRootCount := 0.
  	statSweepCount := statMarkCount := statMkFwdCount := statCompMoveCount := 0.
  	self markPhase.
  	1 to: weakRootCount do:[:i| self finalizeReference: (weakRoots at: i)].
  	survivorCount := self sweepPhase.
  	self incrementalCompaction.
  	statAllocationCount := allocationCount.
  	allocationCount := 0.
  	statIncrGCs := statIncrGCs + 1.
+ 	statGCTime := interpreter ioMicroSecondClock.
- 	statGCTime := self ioMicroSecondClock.
  	statIGCDeltaTime := statGCTime - startTime.
  	statIncrGCMSecs := statIncrGCMSecs + statIGCDeltaTime.
+ 	interpreter capturePendingFinalizationSignals.
- 	self capturePendingFinalizationSignals.
  
+ 	interpreter forceInterruptCheck. "Force an an interrupt check ASAP.We could choose to be clever here and only do this under certain time conditions. Keep it simple for now"
- 	self forceInterruptCheck. "Force an an interrupt check ASAP.We could choose to be clever here and only do this under certain time conditions. Keep it simple for now"
  	
  	statRootTableCount  := rootTableCount.
  	statSurvivorCount := survivorCount.
  	weDidGrow := false.
  	(((survivorCount > tenuringThreshold)
  			or: [rootTableCount >= RootTableRedZone])
  			or: [forceTenureFlag == true])
  		ifTrue: ["move up the young space boundary if 
  			* there are too many survivors: 
  			this limits the number of objects that must be 
  			processed on future incremental GC's 
  			* we're about to overflow the roots table 
  			this limits the number of full GCs that may be caused 
  			by root table overflows in the near future"
  			forceTenureFlag := false.
  			statTenures := statTenures + 1.
  			self clearRootsTable.
  			(freeBlock < growHeadroom and: 
  				[gcBiasToGrow > 0]) 
  				ifTrue: [self biasToGrow.
  						weDidGrow := true].
  			youngStart := freeBlock].
+ 	interpreter postGCAction.
- 	self postGCAction.
  	DoAssertionChecks
  		ifTrue: [self validateRoots; validate.
+ 			interpreter reverseDisplayFrom: 8 to: 15].
- 			self reverseDisplayFrom: 8 to: 15].
  	weDidGrow ifTrue: [self biasToGrowCheckGCLimit]!

Item was added:
+ ----- Method: ObjectMemory>>interpreter: (in category 'accessing') -----
+ interpreter: anInterpreter
+ 	interpreter := anInterpreter!

Item was added:
+ ----- Method: ObjectMemory>>invokeCallbackSelector (in category 'accessing') -----
+ invokeCallbackSelector
+ 	^InvokeCallbackSelector!

Item was changed:
  ----- Method: ObjectMemory>>lastPointerOf: (in category 'object enumeration') -----
  lastPointerOf: oop 
  	"Return the byte offset of the last pointer field of the given object.  
  	Works with CompiledMethods, as well as ordinary objects. 
  	Can be used even when the type bits are not correct."
  	| fmt sz methodHeader header contextSize |
  	<inline: true>
  	header := self baseHeader: oop.
  	fmt := header >> 8 bitAnd: 15.
+ 	fmt <= 4 ifTrue: [(fmt = 3 and: [interpreter isContextHeader: header])
- 	fmt <= 4 ifTrue: [(fmt = 3 and: [self isContextHeader: header])
  					ifTrue: ["contexts end at the stack pointer"
+ 						contextSize := interpreter fetchStackPointerOf: oop.
- 						contextSize := self fetchStackPointerOf: oop.
  						^ CtxtTempFrameStart + contextSize * self bytesPerWord].
  				sz := self sizeBitsOfSafe: oop.
  				^ sz - self baseHeaderSize  "all pointers"].
  	fmt < 12 ifTrue: [^ 0]. "no pointers"
  
  	"CompiledMethod: contains both pointers and bytes:"
  	methodHeader := self longAt: oop + self baseHeaderSize.
  	^ (methodHeader >> 10 bitAnd: 255) * self bytesPerWord + self baseHeaderSize!

Item was changed:
  ----- Method: ObjectMemory>>lastPointerWhileForwarding: (in category 'gc -- compaction') -----
  lastPointerWhileForwarding: oop 
  	"The given object may have its header word in a forwarding block. Find  
  	the offset of the last pointer in the object in spite of this obstacle. "
  	| header fwdBlock fmt size methodHeader contextSize |
  	<inline: true>
  	header := self longAt: oop.
  	(header bitAnd: self markBit) ~= 0
  		ifTrue: ["oop is forwarded; get its real header from its forwarding table entry"
  			fwdBlock := (header bitAnd: self allButMarkBitAndTypeMask) << 1.
  			DoAssertionChecks
  				ifTrue: [self fwdBlockValidate: fwdBlock].
  			header := self longAt: fwdBlock + self bytesPerWord].
  	fmt := header >> 8 bitAnd: 15.
  	fmt <= 4
+ 		ifTrue: [(fmt = 3 and: [interpreter isContextHeader: header])
- 		ifTrue: [(fmt = 3 and: [self isContextHeader: header])
  				ifTrue: ["contexts end at the stack pointer"
+ 					contextSize := interpreter fetchStackPointerOf: oop.
- 					contextSize := self fetchStackPointerOf: oop.
  					^ CtxtTempFrameStart + contextSize * self bytesPerWord].
  			"do sizeBitsOf: using the header we obtained"
  			(header bitAnd: TypeMask) = HeaderTypeSizeAndClass
  				ifTrue: [size := (self sizeHeader: oop) bitAnd: self allButTypeMask]
  				ifFalse: [size := header bitAnd: self sizeMask].
  			^ size - self baseHeaderSize].
  	fmt < 12 ifTrue: [^ 0]. "no pointers"
  	methodHeader := self longAt: oop + self baseHeaderSize.
  	^ (methodHeader >> 10 bitAnd: 255) * self bytesPerWord + self baseHeaderSize!

Item was changed:
  ----- Method: ObjectMemory>>mapPointersInObjectsFrom:to: (in category 'gc -- compaction') -----
  mapPointersInObjectsFrom: memStart to: memEnd
  	"Use the forwarding table to update the pointers of all non-free objects in the given range of memory. Also remap pointers in root objects which may contains pointers into the given memory range, and don't forget to flush the method cache based on the range"
  	| oop |
  	<inline: false>
+ 	interpreter compilerMapHookFrom: memStart to: memEnd.
- 	self compilerMapHookFrom: memStart to: memEnd.
  	"update interpreter variables"
+ 	interpreter mapInterpreterOops.
- 	self mapInterpreterOops.
  	1 to: extraRootCount do:[:i |
  		oop := (extraRoots at: i) at: 0.
  		(self isIntegerObject: oop) ifFalse:[(extraRoots at: i) at: 0 put: (self remap: oop)]].
+ 	interpreter flushMethodCacheFrom: memStart to: memEnd.
- 	self flushMethodCacheFrom: memStart to: memEnd.
  	self updatePointersInRootObjectsFrom: memStart to: memEnd.
  	self updatePointersInRangeFrom: memStart to: memEnd.
  !

Item was changed:
  ----- Method: ObjectMemory>>markPhase (in category 'gc -- mark and sweep') -----
  markPhase
  	"Mark phase of the mark and sweep garbage collector. Set 
  	the mark bits of all reachable objects. Free chunks are 
  	untouched by this process."
  	"Assume: All non-free objects are initially unmarked. Root 
  	objects were unmarked when they were made roots. (Make 
  	sure this stays true!!!!)."
  	| oop |
  	<inline: false>
  	"clear the recycled context lists"
  	freeContexts := NilContext.
  	freeLargeContexts := NilContext.
  	"trace the interpreter's objects, including the active stack 
  	and special objects array"
+ 	interpreter markAndTraceInterpreterOops.
- 	self markAndTraceInterpreterOops.
  	statSpecialMarkCount := statMarkCount.
  	"trace the roots"
  	1 to: rootTableCount do: [:i | 
  			oop := rootTable at: i.
  			self markAndTrace: oop].
  	1 to: extraRootCount do:[:i|
  			oop := (extraRoots at: i) at: 0.
  			(self isIntegerObject: oop) ifFalse:[self markAndTrace: oop]].
  !

Item was added:
+ ----- Method: ObjectMemory>>nonWeakFieldsOf: (in category 'object format') -----
+ nonWeakFieldsOf: oop
+ 	"Return the number of non-weak fields in oop (i.e. the number of fixed fields).
+ 	Note: The following is copied from fixedFieldsOf:format:length: since we do know
+ 	the format of the oop (e.g. format = 4) and thus don't need the length."
+ 	| class classFormat |
+ 	<inline: false> "No need to inline - we won't call this often"
+ 
+ 	(self isWeakNonInt: oop) ifFalse:[self error:'Called fixedFieldsOfWeak: with a non-weak oop'].
+ 
+ 	"fmt = 3 or 4: mixture of fixed and indexable fields, so must look at class format word"
+ 	class := self fetchClassOf: oop.
+ 	classFormat := self formatOfClass: class.
+ 	^ (classFormat >> 11 bitAnd: 16rC0) + (classFormat >> 2 bitAnd: 16r3F) - 1
+ !

Item was added:
+ ----- Method: ObjectMemory>>okayOop: (in category 'debug support') -----
+ okayOop: signedOop
+ 	"Verify that the given oop is legitimate. Check address, header, and size but not class."
+ 
+ 	| sz type fmt unusedBit oop |
+ 	<var: #oop type: 'usqInt'>
+ 	oop := self cCoerce: signedOop to: 'usqInt'.
+ 
+ 	"address and size checks"
+ 	(self isIntegerObject: oop) ifTrue: [ ^true ].
+ 	(oop < endOfMemory)
+ 		ifFalse: [ self error: 'oop is not a valid address' ].
+ 	((oop \\ self bytesPerWord) = 0)
+ 		ifFalse: [ self error: 'oop is not a word-aligned address' ].
+ 	sz := self sizeBitsOf: oop.
+ 	(oop + sz) < endOfMemory
+ 		ifFalse: [ self error: 'oop size would make it extend beyond the end of memory' ].
+ 
+ 	"header type checks"
+ 	type := self headerType: oop.
+ 	type = HeaderTypeFree
+ 		ifTrue:  [ self error: 'oop is a free chunk, not an object' ].
+ 	type = HeaderTypeShort ifTrue: [
+ 		(((self baseHeader: oop) >> 12) bitAnd: 16r1F) = 0
+ 			ifTrue:  [ self error: 'cannot have zero compact class field in a short header' ].
+ 	].
+ 	type = HeaderTypeClass ifTrue: [
+ 		((oop >= self bytesPerWord) and: [(self headerType: oop - self bytesPerWord) = type])
+ 			ifFalse: [ self error: 'class header word has wrong type' ].
+ 	].
+ 	type = HeaderTypeSizeAndClass ifTrue: [
+ 		((oop >= (self bytesPerWord * 2)) and:
+ 		 [(self headerType: oop - (self bytesPerWord * 2)) = type and:
+ 		 [(self headerType: oop - self bytesPerWord) = type]])
+ 			ifFalse: [ self error: 'class header word has wrong type' ].
+ 	].
+ 
+ 	"format check"
+ 	fmt := self formatOf: oop.
+ 	((fmt = 5) | (fmt = 7))
+ 		ifTrue:  [ self error: 'oop has an unknown format type' ].
+ 
+ 	"mark and root bit checks"
+ 	unusedBit := 16r20000000.
+ 	self bytesPerWord = 8
+ 		ifTrue:
+ 			[unusedBit := unusedBit << 16.
+ 			 unusedBit := unusedBit << 16].
+ 	((self longAt: oop) bitAnd: unusedBit) = 0
+ 		ifFalse: [ self error: 'unused header bit 30 is set; should be zero' ].
+ "xxx
+ 	((self longAt: oop) bitAnd: MarkBit) = 0
+ 		ifFalse: [ self error: 'mark bit should not be set except during GC' ].
+ xxx"
+ 	(((self longAt: oop) bitAnd: self rootBit) = 1 and:
+ 	 [oop >= youngStart])
+ 		ifTrue: [ self error: 'root bit is set in a young object' ].
+ 	^true
+ !

Item was changed:
  ----- Method: ObjectMemory>>oopHasAcceptableClass: (in category 'image segment in/out') -----
  oopHasAcceptableClass: signedOop
  	"Similar to oopHasOkayClass:, except that it only returns true or false."
  
  	| oopClass formatMask behaviorFormatBits oopFormatBits oop |
  	<var: #oop type: 'usqInt'>
  	<var: #oopClass type: 'usqInt'>
  
  	(self isIntegerObject: signedOop) ifTrue: [^ true].
  
  	oop := self cCoerce: signedOop to: 'usqInt'.
  
  	oop < endOfMemory ifFalse: [^ false].
  	((oop \\ self bytesPerWord) = 0) ifFalse: [^ false].
  	(oop + (self sizeBitsOf: oop)) < endOfMemory ifFalse: [^ false].
  	oopClass := self cCoerce: (self fetchClassOf: oop) to: 'usqInt'.
  
  	(self isIntegerObject: oopClass) ifTrue: [^ false].
  	(oopClass < endOfMemory) ifFalse: [^ false].
  	((oopClass \\ self bytesPerWord) = 0) ifFalse: [^ false].
  	(oopClass + (self sizeBitsOf: oopClass)) < endOfMemory ifFalse: [^ false].
+ 	((self isPointers: oopClass) and: [(interpreter lengthOf: oopClass) >= 3]) ifFalse: [^ false].
- 	((self isPointers: oopClass) and: [(self lengthOf: oopClass) >= 3]) ifFalse: [^ false].
  	(self isBytes: oop)
  		ifTrue: [ formatMask := 16rC00 ]  "ignore extra bytes size bits"
  		ifFalse: [ formatMask := 16rF00 ].
  
  	behaviorFormatBits := (self formatOfClass: oopClass) bitAnd: formatMask.
  	oopFormatBits := (self baseHeader: oop) bitAnd: formatMask.
  	behaviorFormatBits = oopFormatBits ifFalse: [^ false].
  	^ true!

Item was changed:
  ----- Method: ObjectMemory>>recycleContextIfPossible: (in category 'allocation') -----
  recycleContextIfPossible: cntxOop 
  	"If possible, save the given context on a list of free contexts to 
  	be recycled."
  	"Note: The context is not marked free, so it can be reused 
  	with minimal fuss. The recycled context lists are cleared at 
  	every garbage collect."
  	| header |
  	<inline: true>
  	"only recycle young contexts (which should be most of them)"
  	(self oop: cntxOop isGreaterThanOrEqualTo: youngStart)
  		ifTrue: [header := self baseHeader: cntxOop.
+ 			(interpreter isMethodContextHeader: header)
- 			(self isMethodContextHeader: header)
  				ifTrue: ["It's a young context, alright."
  					(header bitAnd: self sizeMask) = self smallContextSize
  						ifTrue: ["Recycle small contexts"
  							self storePointerUnchecked: 0 ofObject: cntxOop withValue: freeContexts.
  							freeContexts := cntxOop].
  					(header bitAnd: self sizeMask) = self largeContextSize
  						ifTrue: ["Recycle large contexts"
  							self storePointerUnchecked: 0 ofObject: cntxOop withValue: freeLargeContexts.
  							freeLargeContexts := cntxOop]]]!

Item was added:
+ ----- Method: ObjectMemory>>slotSizeOf: (in category 'object format') -----
+ slotSizeOf: oop
+ 	"Returns the number of slots in the receiver.
+ 	If the receiver is a byte object, return the number of bytes.
+ 	Otherwise return the number of words."
+ 	(self isIntegerObject: oop) ifTrue:[^0].
+ 	^interpreter lengthOf: oop!

Item was added:
+ ----- Method: ObjectMemory>>wordSwapped: (in category 'image save/restore') -----
+ wordSwapped: w
+ 	"Return the given 64-bit integer with its halves in the reverse order."
+ 
+ 	<inline: true>
+ 	self isDefinedTrueExpression: 'BYTES_PER_WORD == 8'
+ 		inSmalltalk: [self bytesPerWord = 8]
+ 		comment: 'swap 32-bit ends of a 64-bit object word'
+ 		ifTrue: [^ ((w bitShift: self byte4ShiftNegated) bitAnd: self bytes3to0Mask)
+ 	  					+ ((w bitShift: self byte4Shift) bitAnd: self bytes7to4Mask)]
+ 		ifFalse: [self error: 'This cannot happen.']
+ !

Item was added:
+ ObjectMemory subclass: #ObjectMemorySimulator
+ 	instanceVariableNames: 'bytesPerWord transcript'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-InterpreterSimulation'!
+ 
+ !ObjectMemorySimulator commentStamp: 'dtl 2/15/2012 20:12' prior: 0!
+ This class defines basic memory access and primitive simulation so that the Interpreter can run simulated in the Squeak environment.  It also defines a number of handy object viewing methods to facilitate pawing around in the object memory.!

Item was added:
+ ----- Method: ObjectMemorySimulator>>baseHeaderSize (in category 'memory access') -----
+ baseHeaderSize
+ 	"Answer the size of an object memory header word in bytes."
+ 
+ 	^bytesPerWord!

Item was added:
+ ----- Method: ObjectMemorySimulator>>byteAt: (in category 'memory access') -----
+ byteAt: byteAddress
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: ObjectMemorySimulator>>byteAt:put: (in category 'memory access') -----
+ byteAt: byteAddress put: byte
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: ObjectMemorySimulator>>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, and byte is an 8-bit quantity."
+ 
+ 	^ self byteAt: pointer!

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

Item was added:
+ ----- Method: ObjectMemorySimulator>>bytesPerWord (in category 'memory access') -----
+ bytesPerWord
+ 	"BytesPerWord was a class variable in ObjectMemory, permitting each object
+ 	memory to have its own word size."
+ 
+ 	^ bytesPerWord ifNil: [bytesPerWord := 4]!

Item was added:
+ ----- Method: ObjectMemorySimulator>>bytesPerWord: (in category 'memory access') -----
+ bytesPerWord: fourOrEight
+ 	"BytesPerWord was a class variable in ObjectMemory, permitting each object
+ 	memory to have its own word size."
+ 
+ 	bytesPerWord := fourOrEight!

Item was added:
+ ----- Method: ObjectMemorySimulator>>cCoerce:to: (in category 'memory access') -----
+ cCoerce: value to: cTypeString
+ 	"Type coercion for translation only; just return the value when running in Smalltalk."
+ 
+ 	^value == nil
+ 		ifTrue: [value]
+ 		ifFalse: [value coerceTo: cTypeString sim: self]!

Item was added:
+ ----- Method: ObjectMemorySimulator>>firstIndexableField: (in category 'memory access') -----
+ firstIndexableField: oop
+ 	"NOTE: overridden from Interpreter to add coercion to CArray"
+ 
+ 	| hdr fmt totalLength fixedFields |
+ 	self returnTypeC: 'void *'.
+ 	hdr := self baseHeader: oop.
+ 	fmt := (hdr >> 8) bitAnd: 16rF.
+ 	totalLength := self lengthOf: oop baseHeader: hdr format: fmt.
+ 	fixedFields := self fixedFieldsOf: oop format: fmt length: totalLength.
+ 	fmt < 8 ifTrue:
+ 		[fmt = 6 ifTrue:
+ 			["32 bit field objects"
+ 			^ self cCoerce: (self pointerForOop: oop + self baseHeaderSize + (fixedFields << 2)) to: 'int *'].
+ 		"full word objects (pointer or bits)"
+ 		^ self cCoerce: (self pointerForOop: oop + self baseHeaderSize + (fixedFields << self shiftForWord)) to: 'oop *']
+ 		ifFalse:
+ 		["Byte objects"
+ 		^ self cCoerce: (self pointerForOop: oop + self baseHeaderSize + fixedFields) to: 'char *']!

Item was added:
+ ----- Method: ObjectMemorySimulator>>halfWordHighInLong32: (in category 'memory access') -----
+ halfWordHighInLong32: long32
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: ObjectMemorySimulator>>halfWordLowInLong32: (in category 'memory access') -----
+ halfWordLowInLong32: long32
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: ObjectMemorySimulator>>integerAt: (in category 'memory access') -----
+ integerAt: byteAddress
+ 	"Note: Adjusted for Smalltalk's 1-based array indexing."
+ 
+ 	^memory integerAt: (byteAddress // 4) + 1!

Item was added:
+ ----- Method: ObjectMemorySimulator>>integerAt:put: (in category 'memory access') -----
+ integerAt: byteAddress put: a32BitValue
+ 	"Note: Adjusted for Smalltalk's 1-based array indexing."
+ 
+ 	^memory integerAt: (byteAddress // 4) + 1 put: a32BitValue!

Item was added:
+ ----- Method: ObjectMemorySimulator>>integerObjectOf: (in category 'memory access') -----
+ integerObjectOf: value
+ 	"The simulator works with strictly positive bit patterns"
+ 	value < 0
+ 		ifTrue: [^ ((16r80000000 + value) << 1) + 1]
+ 		ifFalse: [^ (value << 1) + 1]!

Item was added:
+ ----- Method: ObjectMemorySimulator>>isIntegerValue: (in category 'interpreter shell') -----
+ isIntegerValue: valueWord 
+ 	^ valueWord >= 16r-40000000 and: [valueWord <= 16r3FFFFFFF]!

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

Item was added:
+ ----- Method: ObjectMemorySimulator>>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: ObjectMemorySimulator>>longAt: (in category 'memory access') -----
+ longAt: byteAddress
+ 	"Note: Adjusted for Smalltalk's 1-based array indexing."
+ 
+ 	^memory at: (byteAddress // 4) + 1!

Item was added:
+ ----- Method: ObjectMemorySimulator>>longAt:put: (in category 'memory access') -----
+ longAt: byteAddress put: a32BitValue
+ 	"Note: Adjusted for Smalltalk's 1-based array indexing."
+ 
+ 	^memory at: (byteAddress // 4) + 1 put: a32BitValue!

Item was added:
+ ----- Method: ObjectMemorySimulator>>longAtPointer: (in category 'memory access') -----
+ longAtPointer: pointer
+ 	"This gets implemented by Macros in C, where its types will also be checked.
+ 	pointer is a raw address, and the result is the width of a machine word."
+ 
+ 	^ self longAt: pointer!

Item was added:
+ ----- Method: ObjectMemorySimulator>>longAtPointer:put: (in category 'memory access') -----
+ longAtPointer: pointer put: longValue
+ 	"This gets implemented by Macros in C, where its types will also be checked.
+ 	pointer is a raw address, and longValue is the width of a machine word."
+ 
+ 	^ self longAt: pointer put: longValue!

Item was added:
+ ----- Method: ObjectMemorySimulator>>oopForPointer: (in category 'memory access') -----
+ oopForPointer: pointer
+ 	"This gets implemented by Macros in C, where its types will also be checked.
+ 	oop is the width of a machine word, and pointer is a raw address."
+ 
+ 	^ pointer!

Item was added:
+ ----- Method: ObjectMemorySimulator>>pointerForOop: (in category 'memory access') -----
+ pointerForOop: oop
+ 	"This gets implemented by Macros in C, where its types will also be checked.
+ 	oop is the width of a machine word, and pointer is a raw address."
+ 
+ 	^ oop!

Item was added:
+ ----- Method: ObjectMemorySimulator>>shortAt: (in category 'memory access') -----
+ shortAt: byteAddress
+     "Return the half-word at byteAddress which must be even."
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: ObjectMemorySimulator>>shortAt:put: (in category 'memory access') -----
+ shortAt: byteAddress put: a16BitValue
+ 	^ self subclassResponsibility!

Item was added:
+ ----- Method: ObjectMemorySimulator>>sqGrowMemory:By: (in category 'memory access') -----
+ sqGrowMemory: oldLimit By: delta
+ 
+ 	transcript show: 'grow memory from ', oldLimit printString, ' by ', delta printString; cr.
+ 	memory := memory , (memory class new: delta // 4).
+ 	^ memory size * 4!

Item was added:
+ ----- Method: ObjectMemorySimulator>>sqMemoryExtraBytesLeft: (in category 'memory access') -----
+ sqMemoryExtraBytesLeft: includingSwap
+ 	^0!

Item was added:
+ ----- Method: ObjectMemorySimulator>>sqShrinkMemory:By: (in category 'memory access') -----
+ sqShrinkMemory: oldLimit By: delta
+ 	transcript show: 'shrink memory from ', oldLimit printString, ' by ', delta printString, ' remember it doesn''t actually shrink in simulation'; cr.
+ 
+ 	^ oldLimit!

Item was added:
+ ----- Method: ObjectMemorySimulator>>startOfMemory (in category 'initialization') -----
+ startOfMemory
+ 	"Return the start of object memory."
+ 
+ 	^ 0!

Item was added:
+ ----- Method: ObjectMemorySimulator>>transcript: (in category 'initialization') -----
+ transcript: aTranscript
+ 	transcript := aTranscript
+ !

Item was added:
+ ObjectMemorySimulator subclass: #ObjectMemorySimulatorLSB
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-InterpreterSimulation'!
+ 
+ !ObjectMemorySimulatorLSB commentStamp: 'dtl 2/15/2012 20:12' prior: 0!
+ This class overrides a few methods in ObjectMemorySimulator required for simulation to work on little-endian architectures (such as the x86 family of processors).!

Item was added:
+ ----- Method: ObjectMemorySimulatorLSB>>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: ObjectMemorySimulatorLSB>>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.
+ !

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

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

Item was added:
+ ----- Method: ObjectMemorySimulatorLSB>>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: ObjectMemorySimulatorLSB>>shortAt:put: (in category 'memory access') -----
+ shortAt: byteAddress put: a16BitValue
+     "Return the half-word at byteAddress which must be even."
+ 	| lowBits long longAddress |
+ 	lowBits := byteAddress bitAnd: 2.
+ 	lowBits = 0
+ 		ifTrue:
+ 		[ "storing into LS word"
+ 		long := self longAt: byteAddress.
+ 		self longAt: byteAddress
+ 				put: ((long bitAnd: 16rFFFF0000) bitOr: a16BitValue)
+ 		]
+ 		ifFalse:
+ 		[longAddress := byteAddress - 2.
+ 		long := self longAt: longAddress.
+ 		self longAt: longAddress
+ 				put: ((long bitAnd: 16rFFFF) bitOr: (a16BitValue bitShift: 16))
+ 		]!

Item was added:
+ ----- Method: ObjectMemorySimulatorLSB>>vmEndianness (in category 'memory access') -----
+ vmEndianness
+ 	"return 0 for little endian, 1 for big endian"
+ 	^0!

Item was added:
+ ObjectMemorySimulatorLSB subclass: #ObjectMemorySimulatorLSB64
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-InterpreterSimulation'!

Item was added:
+ ----- Method: ObjectMemorySimulatorLSB64>>byteSwapped: (in category 'memory access') -----
+ byteSwapped: w
+ 	"Return the given integer with its bytes in the reverse order."
+ 
+ 	^ (super byteSwapped: ((w bitShift: -32) bitAnd: 16rFFFFFFFF)) +
+ 	  ((super byteSwapped: (w bitAnd: 16rFFFFFFFF)) bitShift: 32)!

Item was added:
+ ----- Method: ObjectMemorySimulatorLSB64>>long32At: (in category 'memory access') -----
+ long32At: byteAddress
+ 
+ 	"Return the 32-bit word at byteAddress which must be 0 mod 4."
+ 	| lowBits long |
+ 	lowBits := byteAddress bitAnd: 4.
+ 	long := self longAt: byteAddress - lowBits.
+ 	^ lowBits = 4
+ 		ifTrue: [ long bitShift: -32 ]
+ 		ifFalse: [ long bitAnd: 16rFFFFFFFF ].
+ !

Item was added:
+ ----- Method: ObjectMemorySimulatorLSB64>>long32At:put: (in category 'memory access') -----
+ long32At: byteAddress put: a32BitValue
+ 	"Store the 32-bit value at byteAddress which must be 0 mod 4."
+ 	| lowBits long64 longAddress |
+ 	lowBits := byteAddress bitAnd: 4.
+ 	lowBits = 0
+ 		ifTrue:
+ 		[ "storing into LS word"
+ 		long64 := self longAt: byteAddress.
+ 		self longAt: byteAddress
+ 				put: ((long64 bitAnd: 16rFFFFFFFF00000000) bitOr: a32BitValue)
+ 		]
+ 		ifFalse:
+ 		[longAddress := byteAddress - 4.
+ 		long64 := self longAt: longAddress.
+ 		self longAt: longAddress
+ 				put: ((long64 bitAnd: 16rFFFFFFFF) bitOr: (a32BitValue bitShift: 32))
+ 		]!

Item was added:
+ ----- Method: ObjectMemorySimulatorLSB64>>longAt: (in category 'memory access') -----
+ longAt: byteAddress
+ 	"Note: Adjusted for Smalltalk's 1-based array indexing."
+ 
+ 	^ (super longAt: byteAddress) bitOr: ((super longAt: byteAddress + 4) bitShift: 32)!

Item was added:
+ ----- Method: ObjectMemorySimulatorLSB64>>longAt:put: (in category 'memory access') -----
+ longAt: byteAddress put: a64BitValue
+ 	"Note: Adjusted for Smalltalk's 1-based array indexing."
+ 
+ 	super longAt: byteAddress + 4 put: (a64BitValue bitShift: -32).
+ 	super longAt: byteAddress put: (a64BitValue bitAnd: 16rFFFFFFFF).
+ 	^ a64BitValue!

Item was added:
+ ObjectMemorySimulator subclass: #ObjectMemorySimulatorMSB
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-InterpreterSimulation'!
+ 
+ !ObjectMemorySimulatorMSB commentStamp: 'dtl 2/15/2012 20:13' prior: 0!
+ This class overrides a few methods in ObjectMemorySimulator required for simulation to work on big-endian architectures.!

Item was added:
+ ----- Method: ObjectMemorySimulatorMSB>>byteAt: (in category 'memory access') -----
+ byteAt: byteAddress
+ 	| lowBits bpwMinus1 |
+ 	bpwMinus1 := bytesPerWord - 1.
+ 	lowBits := byteAddress bitAnd: bpwMinus1.
+ 	^ ((self longAt: byteAddress - lowBits)
+ 		bitShift: (lowBits - bpwMinus1) * 8)
+ 		bitAnd: 16rFF!

Item was added:
+ ----- Method: ObjectMemorySimulatorMSB>>byteAt:put: (in category 'memory access') -----
+ byteAt: byteAddress put: byte
+ 	| longWord shift lowBits bpwMinus1 longAddress |
+ 	bpwMinus1 := bytesPerWord - 1.
+ 	lowBits := byteAddress bitAnd: bpwMinus1.
+ 	longAddress := byteAddress - lowBits.
+ 	longWord := self longAt: longAddress.
+ 	shift := (bpwMinus1 - lowBits) * 8.
+ 	longWord := longWord
+ 				- (longWord bitAnd: (16rFF bitShift: shift))
+ 				+ (byte bitShift: shift).
+ 	self longAt: longAddress put: longWord!

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

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

Item was added:
+ ----- Method: ObjectMemorySimulatorMSB>>shortAt: (in category 'memory access') -----
+ shortAt: byteAddress
+     "Return the half-word at byteAddress which must be even."
+ 	| lowBits bpwMinus2 |
+ 	bpwMinus2 := bytesPerWord - 2.
+ 	lowBits := byteAddress bitAnd: bpwMinus2.
+ 	^ ((self longAt: byteAddress - lowBits)
+ 		bitShift: (lowBits - bpwMinus2) * 8)
+ 		bitAnd: 16rFFFF
+ !

Item was added:
+ ----- Method: ObjectMemorySimulatorMSB>>shortAt:put: (in category 'memory access') -----
+ shortAt: byteAddress put: a16BitValue
+     "Return the half-word at byteAddress which must be even."
+ 	| longWord shift lowBits bpwMinus2 longAddress |
+ 	bpwMinus2 := bytesPerWord - 2.
+ 	lowBits := byteAddress bitAnd: bpwMinus2.
+ 	longAddress := byteAddress - lowBits.
+ 	longWord := self longAt: longAddress.
+ 	shift := (bpwMinus2 - lowBits) * 8.
+ 	longWord := longWord
+ 				- (longWord bitAnd: (16rFFFF bitShift: shift))
+ 				+ (a16BitValue bitShift: shift).
+ 	self longAt: longAddress put: longWord
+ !

Item was added:
+ ----- Method: ObjectMemorySimulatorMSB>>vmEndianness (in category 'memory access') -----
+ vmEndianness
+ 	"return 0 for little endian, 1 for big endian"
+ 	^1!

Item was added:
+ ObjectMemorySimulatorMSB subclass: #ObjectMemorySimulatorMSB64
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-InterpreterSimulation'!

Item was added:
+ ----- Method: ObjectMemorySimulatorMSB64>>byteSwapped: (in category 'memory access') -----
+ byteSwapped: w
+ 	"Return the given integer with its bytes in the reverse order."
+ 
+ 	^ (super byteSwapped: ((w bitShift: -32) bitAnd: 16rFFFFFFFF)) +
+ 	  ((super byteSwapped: (w bitAnd: 16rFFFFFFFF)) bitShift: 32)!

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

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

Item was added:
+ ----- Method: ObjectMemorySimulatorMSB64>>longAt: (in category 'memory access') -----
+ longAt: byteAddress
+ 	"Note: Adjusted for Smalltalk's 1-based array indexing."
+ 
+ 	^ ((super longAt: byteAddress) bitShift: 32) bitOr: (super longAt: byteAddress + 4)!

Item was added:
+ ----- Method: ObjectMemorySimulatorMSB64>>longAt:put: (in category 'memory access') -----
+ longAt: byteAddress put: a64BitValue
+ 	"Note: Adjusted for Smalltalk's 1-based array indexing."
+ 
+ 	super longAt: byteAddress put: (a64BitValue bitShift: -32).
+ 	super longAt: byteAddress + 4 put: (a64BitValue bitAnd: 16rFFFFFFFF).
+ 	^ a64BitValue!

Item was added:
+ ----- Method: SlangTest>>expectedFailures (in category 'testing') -----
+ expectedFailures
+ 	^#( testSetInstanceVariableWithAnAccessorMethod )!

Item was changed:
  ----- Method: SlangTest>>testSetInstanceVariableWithAnAccessorMethod (in category 'testing intermediate variable removal') -----
  testSetInstanceVariableWithAnAccessorMethod
+ 	"Intermediate variable from parameter of accessor method should be removed.
+ 	This is an existing limitation of the inliner, and could be improved for better code
+ 	generation. It is not a bug."
- 	"Intermediate variable from parameter of accessor method should be removed"
  
  	| s |
  	s := (SlangTestSupportInterpreter asInlinedCString: #setInstanceVariableWithAnAccessorMethod)
  			copyReplaceAll: 'setInstanceVariableWithAnAccessorMethod'
  			with: 'methodName'.
  	self assert: (s includesSubString: 'aVariable = remap(objectMemory, nilObj);').
  
  	"Should be translated like this:
  		aVariable = remap(objectMemory, nilObj);
  
  	Not like this:
  		oop = remap(objectMemory, nilObj);
  		aVariable = oop;"
  !

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

Item was changed:
  SharedPool subclass: #VMObjectIndices
  	instanceVariableNames: ''
+ 	classVariableNames: 'ActiveProcessIndex CharacterTable ClassAlien ClassArray ClassBitmap ClassBlockClosure ClassBlockContext ClassByteArray ClassCharacter ClassCompiledMethod ClassExternalAddress ClassExternalData ClassExternalFunction ClassExternalLibrary ClassExternalStructure ClassFloat ClassInteger ClassLargeNegativeInteger ClassLargePositiveInteger ClassMessage ClassMethodContext ClassPoint ClassProcess ClassSemaphore ClassString ClassUnsafeAlien ClassWeakFinalizer ClosureCopiedValuesIndex CompactClasses ConstMinusOne ConstOne ConstTwo ConstZero ExcessSignalsIndex ExternalObjectsArray FalseObject HeaderIndex InstanceSpecificationIndex InstructionPointerIndex LiteralStart MyListIndex NilObject PrimErrTableIndex PriorityIndex ProcessListsIndex ProcessSignalingLowSpace ReceiverIndex SchedulerAssociation SelectorAboutToReturn SelectorAttemptToAssign SelectorCannotInterpret SelectorCannotReturn SelectorDoesNotUnderstand SelectorMustBeBoolean SelectorRunWithIn SenderIndex SpecialSelectors TheDisplay TheFinalizationSemaphore TheInputSemaphore TheInterruptSemaphore TheLowSpaceSemaphore TheTimerSemaphore TrueObject XIndex YIndex'
- 	classVariableNames: 'ActiveProcessIndex CharacterTable ClassAlien ClassArray ClassBitmap ClassBlockClosure ClassBlockContext ClassByteArray ClassCharacter ClassCompiledMethod ClassExternalAddress ClassExternalData ClassExternalFunction ClassExternalLibrary ClassExternalStructure ClassFloat ClassInteger ClassLargeNegativeInteger ClassLargePositiveInteger ClassMessage ClassMethodContext ClassPoint ClassProcess ClassSemaphore ClassString ClassUnsafeAlien ClassWeakFinalizer ClosureCopiedValuesIndex CompactClasses ConstMinusOne ConstOne ConstTwo ConstZero ExcessSignalsIndex ExternalObjectsArray FalseObject HeaderIndex InstructionPointerIndex LiteralStart MyListIndex NilObject PrimErrTableIndex PriorityIndex ProcessListsIndex ProcessSignalingLowSpace ReceiverIndex SchedulerAssociation SelectorAboutToReturn SelectorAttemptToAssign SelectorCannotInterpret SelectorCannotReturn SelectorDoesNotUnderstand SelectorMustBeBoolean SelectorRunWithIn SenderIndex SpecialSelectors TheDisplay TheFinalizationSemaphore TheInputSemaphore TheInterruptSemaphore TheLowSpaceSemaphore TheTimerSemaphore TrueObject XIndex YIndex'
  	poolDictionaries: ''
  	category: 'VMMaker-Interpreter'!
  
  !VMObjectIndices commentStamp: '<historical>' prior: 0!
  I am a shared pool for the constants that define object layout and well-known objects shared between the object memories (e.g. ObjectMemory, NewObjectMemory), the interpreters (e.g. StackInterpreter, CoInterpreter) and the object representations (e.g. ObjectRepresentationForSqueakV3).
  
  self classPool declare: #Foo from: StackInterpreter classPool
  
  (ObjectMemory classPool keys select: [:k| (k beginsWith: 'Class') and: [(k endsWith: 'Index') not]]) do:
  	[:k| self classPool declare: k from: ObjectMemory classPool]!



More information about the Vm-dev mailing list