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

[commits at source.squeak.org]

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

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

Name: VMMaker.oscog-eem.168
Author: eem
Time: 24 June 2012, 12:11:04.735 pm
UUID: 9735eb86-c5f3-405e-a4e2-0788c5eca335
Ancestors: VMMaker.oscog-eem.167

Rename metaclassSizeBytes to metaclassSizeBits.
Nuke unused shortPrintRelative:.

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

Item was changed:
  ----- Method: CoInterpreter>>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 heapSize bytesRead bytesToShift
  	  hdrNumStackPages hdrEdenBytes hdrCogCodeSize headerFlags hdrMaxExtSemTabSize |
  	<var: #f type: 'sqImageFile '>
  	<var: #memStart type: 'usqInt'>
  	<var: #desiredHeapSize type: 'usqInt'>
  	<var: #headerStart type: 'squeakFileOffsetType '>
  	<var: #dataSize type: 'size_t '>
  	<var: #imageOffset type: 'squeakFileOffsetType '>
  
+ 	metaclassSizeBits := 6 * BytesPerWord.	"guess (Metaclass instSize * BPW)"
- 	metaclassSizeBytes := 6 * BytesPerWord.	"guess (Metaclass instSize * BPW)"
  	swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
  	headerStart := (self sqImageFilePosition: f) - 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). "N.B.  not used."
  	savedWindowSize	:= self getLongFromFile: f swap: swapBytes.
  	headerFlags			:= self getLongFromFile: f swap: swapBytes.
  	self setImageHeaderFlagsFrom: headerFlags.
  	extraVMMemory		:= self getLongFromFile: f swap: swapBytes. "N.B.  not used."
  	hdrNumStackPages	:= self getShortFromFile: f swap: swapBytes.
  	"4 stack pages is small.  Should be able to run with as few as
  	 three. 4 should be comfortable but slow.  8 is a reasonable
  	 default.  Can be changed via vmParameterAt: 43 put: n.
  	 Can be set as a preference (Info.plist, VM.ini, command line etc).
  	 If desiredNumStackPages is already non-zero then it has been
  	 set as a preference.  Ignore (but preserve) the header's default."
  	numStackPages := desiredNumStackPages ~= 0
  						ifTrue: [desiredNumStackPages]
  						ifFalse: [hdrNumStackPages = 0
  									ifTrue: [self defaultNumStackPages]
  									ifFalse: [hdrNumStackPages]].
  	desiredNumStackPages := hdrNumStackPages.
  	"This slot holds the size of the native method zone in 1k units. (pad to word boundary)."
  	hdrCogCodeSize := (self getShortFromFile: f swap: swapBytes) * 1024.
  	cogCodeSize := desiredCogCodeSize ~= 0
  						ifTrue: [desiredCogCodeSize]
  						ifFalse:
  							[hdrCogCodeSize = 0
  									ifTrue: [self defaultCogCodeSize]
  									ifFalse: [hdrCogCodeSize]].
  	hdrEdenBytes		:= self getLongFromFile: f swap: swapBytes.
  	objectMemory edenBytes: (desiredEdenBytes ~= 0
  						ifTrue: [desiredEdenBytes]
  						ifFalse:
  							[hdrEdenBytes = 0
  									ifTrue: [objectMemory defaultEdenBytes]
  									ifFalse: [hdrEdenBytes]]).
  	desiredEdenBytes := hdrEdenBytes.
  	hdrMaxExtSemTabSize := self getShortFromFile: f swap: swapBytes.
  	hdrMaxExtSemTabSize ~= 0 ifTrue:
  		[self setMaxExtSemSizeTo: hdrMaxExtSemTabSize].
  
  	"compare memory requirements with availability"
  	minimumMemory := cogCodeSize "no need to include the stackZone; this is alloca'ed"
  						+ dataSize
  						+ objectMemory edenBytes
  						+ self interpreterAllocationReserveBytes.
  	heapSize             :=  cogCodeSize "no need to include the stackZone; this is alloca'ed"
  						+ desiredHeapSize
  						"+ edenBytes" "don't include edenBytes; this is part of the heap and so part of desiredHeapSize"
  						+ self interpreterAllocationReserveBytes.
  	heapSize < minimumMemory ifTrue:
  		[self insufficientMemorySpecifiedError].
  
  	"allocate a contiguous block of memory for the Squeak heap and ancilliary data structures"
  	"N.B. If the platform needs to it will redefine this macro to make heapSize
  	 an in/out parameter and assign the ammount actually allocated into heapSize.
  	 See e.g. platforms/Mac OS/vm/sqPlatformSpecific.h.  (I *hate* this. eem 7/23/2009)"
  	"objectMemory memory: (self cCode: 'sqAllocateMemory(minimumMemory, heapSize)').  "
  	objectMemory memory: (self
  								allocateMemory: heapSize
  								minimum: minimumMemory
  								imageFile: f
  								headerSize: headerSize).	
  	
  	objectMemory memory = nil ifTrue: [self insufficientMemoryAvailableError].
  	heapBase := objectMemory memory + cogCodeSize.
  	self assert: objectMemory startOfMemory = heapBase.
  	objectMemory setMemoryLimit: objectMemory memory + heapSize - 24.  "decrease memoryLimit a tad for safety"
  	objectMemory setEndOfMemory: heapBase + dataSize.
  
  	"position file after the header"
  	self sqImageFile: f Seek: headerStart + headerSize.
  
  	"read in the image in bulk, then swap the bytes if necessary"
  	bytesRead := self cCode: 'sqImageFileRead(pointerForOop(heapBase), sizeof(unsigned char), dataSize, f)'.
  	bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
  
  	self ensureImageFormatIsUpToDate: swapBytes.
  
  	"compute difference between old and new memory base addresses"
  	bytesToShift := heapBase - oldBaseAddr.
  	self initializeInterpreter: bytesToShift.  "adjusts all oops to new location"
  	self initializeCodeGenerator.
  	^dataSize!

Item was changed:
  ----- Method: CogVMSimulator>>nameOfClass: (in category 'debug support') -----
  nameOfClass: classOop
+ 	(objectMemory sizeBitsOf: classOop) = metaclassSizeBits ifTrue:
- 	(objectMemory sizeBitsOf: classOop) = metaclassSizeBytes ifTrue:
  		[^(self nameOfClass:
  				(objectMemory fetchPointer: thisClassIndex ofObject: classOop)) , ' class'].
  	^self stringOf: (objectMemory fetchPointer: classNameIndex ofObject: classOop)!

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

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

Item was changed:
  ObjectMemory subclass: #Interpreter
+ 	instanceVariableNames: 'activeContext theHomeContext method receiver instructionPointer stackPointer localIP localSP localHomeContext localReturnContext localReturnValue messageSelector argumentCount newMethod currentBytecode successFlag primitiveIndex primitiveFunctionPointer methodCache atCache lkupClass reclaimableContextCount nextPollTick nextWakeupTick lastTick interruptKeycode interruptPending semaphoresToSignalA semaphoresUseBufferA semaphoresToSignalCountA semaphoresToSignalB semaphoresToSignalCountB savedWindowSize fullScreenFlag deferDisplayUpdates pendingFinalizationSignals compilerInitialized extraVMMemory receiverClass interpreterProxy showSurfaceFn interruptCheckCounterFeedBackReset interruptChecksEveryNms externalPrimitiveTable primitiveTable globalSessionID jmpBuf jmpDepth jmpMax suspendedCallbacks suspendedMethods profileProcess profileMethod profileSemaphore nextProfileTick metaclassSizeBits statIOProcessEvents statCheckForEvents statQuickCheckForEvents statProcessSwitch statPendingFinalizationSignals gcSemaphoreIndex'
- 	instanceVariableNames: 'activeContext theHomeContext method receiver instructionPointer stackPointer localIP localSP localHomeContext localReturnContext localReturnValue messageSelector argumentCount newMethod currentBytecode successFlag primitiveIndex primitiveFunctionPointer methodCache atCache lkupClass reclaimableContextCount nextPollTick nextWakeupTick lastTick interruptKeycode interruptPending semaphoresToSignalA semaphoresUseBufferA semaphoresToSignalCountA semaphoresToSignalB semaphoresToSignalCountB savedWindowSize fullScreenFlag deferDisplayUpdates pendingFinalizationSignals compilerInitialized extraVMMemory receiverClass interpreterProxy showSurfaceFn interruptCheckCounterFeedBackReset interruptChecksEveryNms externalPrimitiveTable primitiveTable globalSessionID jmpBuf jmpDepth jmpMax suspendedCallbacks suspendedMethods profileProcess profileMethod profileSemaphore nextProfileTick metaclassSizeBytes statIOProcessEvents statCheckForEvents statQuickCheckForEvents statProcessSwitch statPendingFinalizationSignals gcSemaphoreIndex'
  	classVariableNames: 'AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BlockArgumentCountIndex BlockMethodIndex BytecodeTable CacheProbeMax CallerIndex ClosureMethodIndex CompilerHooksSize CrossedX DirBadPath DirEntryFound DirNoMoreEntries DoBalanceChecks EndOfRun HomeIndex InitialIPIndex JitterTable MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MillisecondClockMask PrimitiveExternalCallIndex PrimitiveTable SemaphoresToSignalSize TempFrameStart'
  	poolDictionaries: 'VMBasicConstants VMMethodCacheConstants VMObjectIndices'
  	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 changed:
  ----- Method: Interpreter>>initializeInterpreter: (in category 'initialization') -----
  initializeInterpreter: bytesToShift 
  	"Initialize Interpreter state before starting execution of a new image."
  	interpreterProxy := self sqGetInterpreterProxy.
  	self dummyReferToProxy.
  	self initializeObjectMemory: bytesToShift.
  	self initCompilerHooks.
  	self checkAssumedCompactClasses.
+ 	metaclassSizeBits := self sizeBitsOf: (self fetchClassOfNonInt: (self splObj: ClassArray)).	"determine actual (Metaclass instSize * 4)"
- 	metaclassSizeBytes := self sizeBitsOf: (self fetchClassOfNonInt: (self splObj: ClassArray)).	"determine actual (Metaclass instSize * 4)"
  	activeContext := nilObj.
  	theHomeContext := nilObj.
  	method := nilObj.
  	receiver := nilObj.
  	messageSelector := nilObj.
  	newMethod := nilObj.
  	lkupClass := nilObj.
  	receiverClass := nilObj.
  	self flushMethodCache.
  	self loadInitialContext.
  	self initialCleanup.
  	interruptCheckCounter := 0.
  	interruptCheckCounterFeedBackReset := 1000.
  	interruptChecksEveryNms := 1.
  	nextProfileTick := 0.
  	profileSemaphore := nilObj.
  	profileProcess := nilObj.
  	profileMethod := nilObj.
  	nextPollTick := 0.
  	nextWakeupTick := 0.
  	lastTick := 0.
  	interruptKeycode := 2094. "cmd-. as used for Mac but no other OS"
  	interruptPending := false.
  	semaphoresUseBufferA := true.
  	semaphoresToSignalCountA := 0.
  	semaphoresToSignalCountB := 0.
  	deferDisplayUpdates := false.
  	pendingFinalizationSignals := statPendingFinalizationSignals := 0.
  	globalSessionID := 0.
  	[globalSessionID = 0]
  		whileTrue: [globalSessionID := self
  						cCode: 'time(NULL) + ioMSecs()'
  						inSmalltalk: [(Random new next * SmallInteger maxVal) asInteger]].
  	jmpDepth := 0.
  	jmpMax := MaxJumpBuf. "xxxx: Must match the definition of jmpBuf and suspendedCallbacks"
  	statQuickCheckForEvents := 0.
  	statCheckForEvents := 0.
  	statProcessSwitch := 0.
  	statIOProcessEvents := 0
  !

Item was changed:
  ----- Method: Interpreter>>printNameOfClass:count: (in category 'debug printing') -----
  printNameOfClass: classOop count: cnt
  	"Details: The count argument is used to avoid a possible infinite recursion if classOop is a corrupted object."
  
  	cnt <= 0 ifTrue: [^self print: 'bad class'].
+ 	((self sizeBitsOf: classOop) = metaclassSizeBits
+ 	  and: [metaclassSizeBits >= (6 * BytesPerWord)])	"(Metaclass instSize * 4)"
- 	((self sizeBitsOf: classOop) = metaclassSizeBytes
- 	  and: [metaclassSizeBytes >= (6 * BytesPerWord)])	"(Metaclass instSize * 4)"
  		ifTrue: [self printNameOfClass: (self fetchPointer: 5 "thisClass" ofObject: classOop) count: cnt - 1.
  				self print: ' class']
  		ifFalse: [self printStringOf: (self fetchPointer: 6 "name" ofObject: classOop)]!

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 '>
  
+ 	metaclassSizeBits := 6 * BytesPerWord.	"guess (Metaclass instSize * BPW)"
- 	metaclassSizeBytes := 6 * BytesPerWord.	"guess (Metaclass instSize * BPW)"
  	swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
  	headerStart := (self sqImageFilePosition: f) - BytesPerWord.  "record header start position"
  
  	headerSize			:= self getLongFromFile: f swap: swapBytes.
  	dataSize				:= self getLongFromFile: f swap: swapBytes.
  	oldBaseAddr			:= self getLongFromFile: f swap: swapBytes.
  	specialObjectsOop	:= self getLongFromFile: f swap: swapBytes.
  	lastHash			:= self getLongFromFile: f swap: swapBytes.
  	savedWindowSize	:= self getLongFromFile: f swap: swapBytes.
  	fullScreenFlag		:= self getLongFromFile: f swap: swapBytes.
  	extraVMMemory		:= self getLongFromFile: f swap: swapBytes.
  
  	lastHash = 0 ifTrue: [
  		"lastHash wasn't stored (e.g. by the cloner); use 999 as the seed"
  		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"
  	memory := self cCode: 'sqAllocateMemory(minimumMemory, heapSize)'.
  	memory = nil ifTrue: [self insufficientMemoryAvailableError].
  
  	memStart := self startOfMemory.
  	self setMemoryLimit: (memStart + heapSize) - 24.  "decrease memoryLimit a tad for safety"
  	self setEndOfMemory: memStart + dataSize.
  
  	"position file after the header"
  	self sqImageFile: f Seek: headerStart + headerSize.
  
  	"read in the image in bulk, then swap the bytes if necessary"
  	bytesRead := self cCode: 'sqImageFileRead(pointerForOop(memory), sizeof(unsigned char), dataSize, f)'.
  	bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
  
  	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"
  	^ dataSize
  !

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

Item was changed:
  ObjectMemory subclass: #NewspeakInterpreter
+ 	instanceVariableNames: 'activeContext theHomeContext method receiver instructionPointer stackPointer localIP localSP localHomeContext localReturnContext localReturnValue messageSelector argumentCount newMethod currentBytecode primFailCode primitiveFunctionPointer inIOProcessEvents methodCache atCache lkupClass reclaimableContextCount nextPollTick nextWakeupTick lastTick interruptKeycode interruptPending gcSemaphoreIndex savedWindowSize fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory imageFormatVersionNumber interpreterProxy showSurfaceFn interruptCheckCounterFeedBackReset interruptChecksEveryNms externalPrimitiveTable primitiveTable globalSessionID metaclassSizeBits thisClassIndex classNameIndex statPendingFinalizationSignals breakSelector breakSelectorLength primTraceLog primTraceLogIndex sendTraceLog sendTraceLogIndex'
- 	instanceVariableNames: 'activeContext theHomeContext method receiver instructionPointer stackPointer localIP localSP localHomeContext localReturnContext localReturnValue messageSelector argumentCount newMethod currentBytecode primFailCode primitiveFunctionPointer inIOProcessEvents methodCache atCache lkupClass reclaimableContextCount nextPollTick nextWakeupTick lastTick interruptKeycode interruptPending gcSemaphoreIndex savedWindowSize fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory imageFormatVersionNumber interpreterProxy showSurfaceFn interruptCheckCounterFeedBackReset interruptChecksEveryNms externalPrimitiveTable primitiveTable globalSessionID metaclassSizeBytes thisClassIndex classNameIndex statPendingFinalizationSignals breakSelector breakSelectorLength primTraceLog primTraceLogIndex sendTraceLog sendTraceLogIndex'
  	classVariableNames: 'AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BlockArgumentCountIndex BytecodeTable CacheProbeMax CallerIndex CrossedX DirBadPath DirEntryFound DirNoMoreEntries EnclosingMixinIndex EnclosingObjectIndex EndOfRun FailImbalancedPrimitives HomeIndex InitialIPIndex MaxExternalPrimitiveTableSize MaxPrimitiveIndex MaxQuickPrimitiveIndex MessageDictionaryIndex MillisecondClockMask MixinIndex MixinNameIndex PrimitiveExternalCallIndex PrimitiveTable RecordPrimTrace RecordSendTrace TempFrameStart TraceLogSize'
  	poolDictionaries: 'VMBasicConstants VMMethodCacheConstants VMObjectIndices'
  	category: 'VMMaker-Interpreter'!
  
  !NewspeakInterpreter commentStamp: 'tpr 4/3/2006 12:46' 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.
  
  The latest version has been extend to support 64 bit systems in at least a basic manner - it is possible to create a 64 bit image via a special SystemTracer - and much of the core code has been cleaned up so that it works whether the C compiler thinks integers are 32 or 64 bit in size. There is still some cleanup required.
  
  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 changed:
  ----- Method: NewspeakInterpreter>>initializeExtraClassInstVarIndices (in category 'initialization') -----
  initializeExtraClassInstVarIndices
+ 	"Initialize metaclassSizeBits and thisClassIndex which are used in debug printing, and
- 	"Initialize metaclassSizeBytes and thisClassIndex which are used in debug printing, and
  	 classNameIndex which is used not only for debug printing but for is:KindOf: & is:MemberOf:
  	 via classNameOf:is: (evil but a reality we have to accept)."
  	| classArrayObj classArrayClass |
  	classNameIndex := 6. "default"
  	thisClassIndex := 5. "default"
  	classArrayObj := self splObj: ClassArray.
  	classArrayClass := self fetchClassOfNonInt: classArrayObj.
+ 	metaclassSizeBits := self sizeBitsOf: classArrayClass.	"determine actual (Metaclass instSize * 4)"
- 	metaclassSizeBytes := self sizeBitsOf: classArrayClass.	"determine actual (Metaclass instSize * 4)"
  	InstanceSpecificationIndex + 1 to: (self lengthOf: classArrayClass) do:
  		[:i|
  		(self fetchPointer: i ofObject: classArrayClass) = classArrayObj ifTrue:
  			[thisClassIndex := i]].
  	InstanceSpecificationIndex + 1 to: (self lengthOf: classArrayObj) do:
  		[:i| | oop |
  		oop := self fetchPointer: i ofObject: classArrayObj.
  		((self isBytes: oop)
  		and: [(self lengthOf: oop) = 5
  		and: [(self str: 'Array' n: (self firstFixedField: oop) cmp: 5) = 0]]) ifTrue:
  			[classNameIndex := i]]!

Item was changed:
  ----- Method: NewspeakInterpreter>>lengthOfNameOfClass: (in category 'debug printing') -----
  lengthOfNameOfClass: classOop
  	<inline: false>
+ 	(self sizeBitsOf: classOop) = metaclassSizeBits ifTrue:
- 	(self sizeBitsOf: classOop) = metaclassSizeBytes ifTrue:
  		[^self lengthOfNameOfClass: (self fetchPointer: thisClassIndex ofObject: classOop)].
  	^self lengthOf: (self fetchPointer: classNameIndex ofObject: classOop)!

Item was changed:
  ----- Method: NewspeakInterpreter>>nameOfClass: (in category 'debug printing') -----
  nameOfClass: classOop
  	"Brain-damaged nameOfClass: for C VM.  Does *not* answer Foo class for metaclasses.
  	 Use e.g. classIsMeta: to avoid being fooled."
  	<inline: false>
  	<returnTypeC: 'char *'>
+ 	(self sizeBitsOf: classOop) = metaclassSizeBits ifTrue:
- 	(self sizeBitsOf: classOop) = metaclassSizeBytes ifTrue:
  		[^self nameOfClass: (self fetchPointer: thisClassIndex ofObject: classOop)].
  	^self firstFixedField: (self fetchPointer: classNameIndex ofObject: classOop)!

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

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

Item was changed:
  ----- Method: NewspeakInterpreter>>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: #memStart type: 'usqInt'>
  	<var: #desiredHeapSize type: 'usqInt'>
  	<var: #headerStart type: 'squeakFileOffsetType '>
  	<var: #dataSize type: 'size_t '>
  	<var: #imageOffset type: 'squeakFileOffsetType '>
  
+ 	metaclassSizeBits := 7 * BytesPerWord.	"guess (Metaclass instSize+1 * 4)"
- 	metaclassSizeBytes := 7 * BytesPerWord.	"guess (Metaclass instSize+1 * 4)"
  	swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
  	headerStart := (self sqImageFilePosition: f) - BytesPerWord.  "record header start position"
  
  	headerSize			:= self getLongFromFile: f swap: swapBytes.
  	dataSize			:= self getLongFromFile: f swap: swapBytes.
  	oldBaseAddr		:= self getLongFromFile: f swap: swapBytes.
  	specialObjectsOop	:= self getLongFromFile: f swap: swapBytes.
  	lastHash			:= self getLongFromFile: f swap: swapBytes.
  	savedWindowSize	:= self getLongFromFile: f swap: swapBytes.
  	fullScreenFlag		:= self getLongFromFile: f swap: swapBytes.
  	extraVMMemory	:= self getLongFromFile: f swap: swapBytes.
  
  	lastHash = 0 ifTrue: [
  		"lastHash wasn't stored (e.g. by the cloner); use 999 as the seed"
  		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"
  	memory := self
  					allocateMemory: heapSize
  					minimum: minimumMemory
  					imageFile: f
  					headerSize: headerSize.
  	memory = nil ifTrue: [self insufficientMemoryAvailableError].
  
  	memStart := self startOfMemory.
  	memoryLimit := (memStart + heapSize) - 24.  "decrease memoryLimit a tad for safety"
  	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 cCode: 'sqImageFileRead(pointerForOop(memory), sizeof(unsigned char), dataSize, f)'.
  	bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
  
  	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"
  	^dataSize!

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

Item was changed:
  InterpreterPrimitives subclass: #StackInterpreter
+ 	instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue primitiveFunctionPointer methodCache atCache lkupClass highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptKeycode interruptPending savedWindowSize imageHeaderFlags fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory interpreterProxy showSurfaceFn primitiveTable externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassSizeBits interruptCheckChain suppressHeartbeatFlag breakSelector breakSelectorLength longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered tempOop statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents theUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite statPendingFinalizationSignals gcSemaphoreIndex classByteArrayCompactIndex'
- 	instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue primitiveFunctionPointer methodCache atCache lkupClass highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptKeycode interruptPending savedWindowSize imageHeaderFlags fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory interpreterProxy showSurfaceFn primitiveTable externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassSizeBytes interruptCheckChain suppressHeartbeatFlag breakSelector breakSelectorLength longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered tempOop statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents theUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite statPendingFinalizationSignals gcSemaphoreIndex classByteArrayCompactIndex'
  	classVariableNames: 'AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BytecodeTable CacheProbeMax DirBadPath DirEntryFound DirNoMoreEntries DumpStackOnLowSpace EnclosingMixinIndex EnclosingObjectIndex FailImbalancedPrimitives HeaderFlagBitPosition MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MaxQuickPrimitiveIndex MixinIndex PrimitiveExternalCallIndex PrimitiveTable'
  	poolDictionaries: 'VMBasicConstants VMMethodCacheConstants VMObjectIndices VMSqueakV3BytecodeConstants VMSqueakV3ObjectRepresentationConstants VMStackFrameOffsets'
  	category: 'VMMaker-Interpreter'!
  
  !StackInterpreter 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.  This VM supports Closures but *not* old-style BlockContexts.
  
  It has been modernized with 32-bit pointers, better management of Contexts (see next item), 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.
  
  The VM does not use Contexts directly.  Instead Contexts serve as proxies for a more conventional stack format that is invisible to the image.  There is considerable explanation at http://www.mirandabanda.org/cogblog/2009/01/14/under-cover-contexts-and-the-big-frame-up.  The VM maintains a fixed-size stack zone divided into pages, each page being capable of holding several method/block activations.  A send establishes a new frame in the current stack page, a return returns to the previous frame.  This eliminates allocation/deallocation of contexts and the moving of receiver and arguments from caller to callee on each send/return.  Contexts are created lazily when an activation needs a context (creating a block, explicit use of thisContext, access to sender when sender is a frame, or linking of stack pages together).  Contexts are either conventional and heap-resident ("single") or "married" and serve as proxies for their corresponding frame or "widowed", meaning that their spouse frame has been returned from (died).  A married context is specially marked (more details in the code) and refers to its frame.  Likewise a married frame is specially marked and refers to its context.
  
  In addition to SmallInteger arithmetic and Floats, the VM 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 completely 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.
  
  5. Moving to a 2 bit immediate tag and having immediate Characters is a good choice for Unicode and the JIT
  
  6.  If Eliot Miranda's 2 word header scheme is acceptable in terms of footprint (we estimate about a 10% increase in image size with about 35 reclaimed by better representation of CompiledMethod - loss of MethodProperties) then the in-line cache for the JIT is simplified, class access is faster and header access is the same in 32-bit and full 64-bit images.!

Item was changed:
  ----- Method: StackInterpreter>>initializeExtraClassInstVarIndices (in category 'initialization') -----
  initializeExtraClassInstVarIndices
+ 	"Initialize metaclassSizeBits and thisClassIndex which are used in debug printing, and
- 	"Initialize metaclassSizeBytes and thisClassIndex which are used in debug printing, and
  	 classNameIndex which is used not only for debug printing but for is:KindOf: & is:MemberOf:
  	 via classNameOf:is: (evil but a reality we have to accept)."
  	| classArrayObj classArrayClass |
  	classArrayObj := objectMemory splObj: ClassArray.
  	classArrayClass := objectMemory fetchClassOfNonInt: classArrayObj.
+ 	metaclassSizeBits := objectMemory sizeBitsOf: classArrayClass.	"determine actual (Metaclass instSize * 4)"
- 	metaclassSizeBytes := objectMemory sizeBitsOf: classArrayClass.	"determine actual (Metaclass instSize * 4)"
  	thisClassIndex := 5. "default"
  	InstanceSpecificationIndex + 1 to: (objectMemory lengthOf: classArrayClass) do:
  		[:i|
  		(objectMemory fetchPointer: i - 1 ofObject: classArrayClass) = classArrayObj ifTrue:
  			[thisClassIndex := i - 1]].
  	classNameIndex := 6. "default"
  	InstanceSpecificationIndex + 1 to: (objectMemory lengthOf: classArrayObj) do:
  		[:i| | oop |
  		oop := objectMemory fetchPointer: i - 1 ofObject: classArrayObj.
  		((objectMemory isBytes: oop)
  		and: [(objectMemory lengthOf: oop) = 5
  		and: [(self str: 'Array' n: (objectMemory firstFixedField: oop) cmp: 5) = 0]]) ifTrue:
  			[classNameIndex := i - 1]]!

Item was changed:
  ----- Method: StackInterpreter>>lengthOfNameOfClass: (in category 'debug printing') -----
  lengthOfNameOfClass: classOop
  	<inline: false>
+ 	(objectMemory sizeBitsOf: classOop) = metaclassSizeBits ifTrue:
- 	(objectMemory sizeBitsOf: classOop) = metaclassSizeBytes ifTrue:
  		[^self lengthOfNameOfClass: (objectMemory fetchPointer: thisClassIndex ofObject: classOop)].
  	^objectMemory lengthOf: (objectMemory fetchPointer: classNameIndex ofObject: classOop)!

Item was changed:
  ----- Method: StackInterpreter>>nameOfClass: (in category 'debug printing') -----
  nameOfClass: classOop
  	"Brain-damaged nameOfClass: for C VM.  Does *not* answer Foo class for metaclasses.
  	 Use e.g. classIsMeta: to avoid being fooled."
  	<inline: false>
  	<returnTypeC: 'char *'>
+ 	(objectMemory sizeBitsOf: classOop) = metaclassSizeBits ifTrue:
- 	(objectMemory sizeBitsOf: classOop) = metaclassSizeBytes ifTrue:
  		[^self nameOfClass: (objectMemory fetchPointer: thisClassIndex ofObject: classOop)].
  	^objectMemory firstFixedField: (objectMemory fetchPointer: classNameIndex ofObject: classOop)!

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

Item was changed:
  ----- Method: StackInterpreter>>printOopShortInner: (in category 'debug printing') -----
  printOopShortInner: oop
  	| classOop name nameLen |
  	<var: #name type: #'char *'>
  	<inline: true>
  	(objectMemory isIntegerObject: oop) ifTrue:
  		[self printNum: (objectMemory integerValueOf: oop);
  			printChar: $(;
  			printHex: (objectMemory integerValueOf: oop);
  			printChar: $).
  		 ^nil].
  	(oop between: objectMemory startOfMemory and: objectMemory freeStart) ifFalse:
  		[self printHex: oop; print: ' is not on the heap'.
  		 ^nil].
  	(oop bitAnd: (BytesPerWord - 1)) ~= 0 ifTrue:
  		[self printHex: oop; print: ' is misaligned'.
  		 ^nil].
  	(self isFloatObject: oop) ifTrue:
  		[self printFloat: (self dbgFloatValueOf: oop).
  		 ^nil].
  	classOop := objectMemory fetchClassOfNonInt: oop.
  	(objectMemory addressCouldBeObj: classOop) ifFalse:
  		[self print: 'a ??'. ^nil].
+ 	(objectMemory sizeBitsOf: classOop) = metaclassSizeBits ifTrue:
- 	(objectMemory sizeBitsOf: classOop) = metaclassSizeBytes ifTrue:
  		[self printNameOfClass: oop count: 5.
  		 ^nil].
  	oop = objectMemory nilObject ifTrue: [self print: 'nil'. ^nil].
  	oop = objectMemory trueObject ifTrue: [self print: 'true'. ^nil].
  	oop = objectMemory falseObject ifTrue: [self print: 'false'. ^nil].
  	nameLen := self lengthOfNameOfClass: classOop.
  	nameLen = 0 ifTrue: [self print: 'a ??'. ^nil].
  	name := self nameOfClass: classOop.
  	nameLen = 10 ifTrue:
  		[(self str: name n: 'ByteString' cmp: 10) not "strncmp is weird" ifTrue:
  			[self printChar: $'; printStringOf: oop; printChar: $'.
  			 ^nil].
  		 (self str: name n: 'ByteSymbol' cmp: 10) not "strncmp is weird" ifTrue:
  			[self printChar: $#; printStringOf: oop.
  			 ^nil]].
  	(nameLen = 9 and: [(self str: name n: 'Character' cmp: 9) not]) ifTrue:
  		[self printChar: $$; printChar: (objectMemory integerValueOf: (objectMemory fetchPointer: 0 ofObject: oop)).
  		 ^nil].
  	self cCode: [self prin: 'a(n) %.*s' t: nameLen f: name]
  		inSmalltalk: [self print: 'a(n) '; print: name].
  	"Try to spot association-like things; they're all subclasses of LookupKey"
  	((objectMemory instanceSizeOf: classOop) = (ValueIndex + 1)
  	 and: [(self superclassOf: classOop) = (self superclassOf: (objectMemory fetchClassOfNonInt: (objectMemory splObj: SchedulerAssociation)))
  	 and: [self isBytes: (objectMemory fetchPointer: KeyIndex ofObject: oop)]]) ifTrue:
  		[self space;
  			printOopShort: (objectMemory fetchPointer: KeyIndex ofObject: oop);
  			print: ' -> ';
  			printHex: (objectMemory fetchPointer: ValueIndex ofObject: oop)]!

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

Item was changed:
  ----- Method: StackInterpreterSimulator>>nameOfClass: (in category 'debug support') -----
  nameOfClass: classOop
+ 	(objectMemory sizeBitsOf: classOop) = metaclassSizeBits ifTrue:
- 	(objectMemory sizeBitsOf: classOop) = metaclassSizeBytes ifTrue:
  		[^(self nameOfClass:
  				(objectMemory fetchPointer: thisClassIndex ofObject: classOop)) , ' class'].
  	^self stringOf: (objectMemory fetchPointer: classNameIndex ofObject: classOop)!

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

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