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

commits at source.squeak.org commits at source.squeak.org
Tue Sep 3 20:52:54 UTC 2013


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

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

Name: VMMaker.oscog-eem.344
Author: eem
Time: 3 September 2013, 1:50:17.78 pm
UUID: 9e4df594-7952-4318-aaa8-a088bbc78de0
Ancestors: VMMaker.oscog-eem.343

Move all the tortured class initialization logic from the simulators'
initialize methods to the simulators' instance creation methods.
Spur bootstrap now correctly initializaes the compact class indices
with those for SpurMemoryManager, not NewObjectMemory.

Add a little more protocol to SpurMemoryManager.
Fix comment typo.

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

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

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

Item was changed:
  ----- Method: CogVMSimulator class>>new (in category 'instance creation') -----
  new
+ 	^self onObjectMemory: nil cogit: nil options: #()!
- 	^self == CogVMSimulator
- 		ifTrue: [SmalltalkImage current endianness == #big
- 				ifTrue: [self notYetImplemented]
- 				ifFalse: [CogVMSimulatorLSB new]]
- 		ifFalse: [super new]!

Item was added:
+ ----- Method: CogVMSimulator class>>newWithOptions: (in category 'instance creation') -----
+ newWithOptions: optionsDictionaryOrArray
+ 	^self onObjectMemory: nil cogit: nil options: optionsDictionaryOrArray!

Item was added:
+ ----- Method: CogVMSimulator class>>onObjectMemory: (in category 'instance creation') -----
+ onObjectMemory: anObjectMemory
+ 	^self onObjectMemory: anObjectMemory cogit: nil options: #()!

Item was added:
+ ----- Method: CogVMSimulator class>>onObjectMemory:cogit: (in category 'instance creation') -----
+ onObjectMemory: anObjectMemory cogit: aCogit
+ 	^self onObjectMemory: anObjectMemory cogit: aCogit options: #()!

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

Item was changed:
  ----- Method: CogVMSimulator>>initialize (in category 'initialization') -----
  initialize
+ 	"Initialize the CogVMSimulator when running the interpreter inside Smalltalk.  The
+ 	 primary responsibility of this method is to allocate Smalltalk Arrays for variables
+ 	 that will be declared as statically-allocated global arrays in the translated code."
- 	"Initialize the StackInterpreterSimulator when running the interpreter
- 	 inside Smalltalk. The primary responsibility of this method is to allocate
- 	 Smalltalk Arrays for variables that will be declared as statically-allocated
- 	 global arrays in the translated code."
  
+ 	objectMemory ifNil:
+ 		[objectMemory := self class objectMemoryClass simulatorClass new].
+ 	cogit ifNil:
+ 		[cogit := self class cogitClass new setInterpreter: self].
+ 	objectMemory coInterpreter: self cogit: cogit.
- 	| objectMemoryClass |
  
- 	"initialize class variables"
- 	objectMemory ifNotNil:
- 		[^self halt].
- 
- 	objectMemoryClass := self class objectMemoryClass.
- 
- 	objectMemoryClass initBytesPerWord: objectMemoryClass bytesPerWord.
- 	((Smalltalk classNamed: #CoInterpreterMT) ifNil: [CoInterpreter] ifNotNil: [:cimt| cimt])  initialize.
- 	(self class cogitClass withAllSuperclasses copyUpThrough: Cogit) reverseDo:
- 		[:c| c initialize].
- 
- 	super initialize.
- 	objectMemory := objectMemoryClass simulatorClass new.
- 	cogit := self class cogitClass new setInterpreter: self.
  	cogit numRegArgs > 0 ifTrue:
  		[debugStackDepthDictionary := Dictionary new].
- 	objectMemory coInterpreter: self cogit: cogit.
  
+ 	cogThreadManager ifNotNil:
+ 		[super initialize].
+ 
  	"Note: we must initialize ConstMinusOne & HasBeenReturnedFromMCPC differently
  	 for simulation, due to the fact that the simulator works only with +ve 32-bit values"
  	ConstMinusOne := objectMemory integerObjectOf: -1.
  	HasBeenReturnedFromMCPC := objectMemory integerObjectOf: -1.
  	cogMethodZone := cogit methodZone. "Because Slang can't remove intermediate implicit receivers (cogit methodZone foo doesn't reduce to foo())"
  	enableCog := true.
  
  	methodCache := Array new: MethodCacheSize.
  	atCache := Array new: AtCacheTotalSize.
  	self flushMethodCache.
  	self flushAtCache.
  	cogCompiledCodeCompactionCalledFor := false.
  	gcSemaphoreIndex := 0.
  	externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
  	externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
  	externalPrimitiveTableFirstFreeIndex := 0.
  	primitiveTable := self class primitiveTable copy.
  	pluginList := #().
  	mappedPluginEntries := OrderedCollection new.
  	desiredNumStackPages := desiredEdenBytes := desiredCogCodeSize := 0.
  	"This is initialized on loading the image, but convenient for testing stack page values..."
  	numStackPages := self defaultNumStackPages. 
  	startMicroseconds := Time totalSeconds * 1000000.
  	maxLiteralCountForCompile := MaxLiteralCountForCompile.
  	minBackwardJumpCountForCompile := MinBackwardJumpCountForCompile.
  	flagInterpretedMethods := false.
  
  	"initialize InterpreterSimulator variables used for debugging"
  	byteCount := lastPollCount := sendCount := 0.
  	quitBlock := [^ self].
  	traceOn := true.
  	printSends := printFrameAtEachStep := printBytecodeAtEachStep := false.
  	myBitBlt := BitBltSimulator new setInterpreter: self.
  	transcript := Transcript.
  	displayForm := 'Display has not yet been installed' asDisplayText form.
  	suppressHeartbeatFlag := deferSmash := deferredSmash := false.
  	systemAttributes := Dictionary new.
  	primTraceLog := CArrayAccessor on: (Array new: 256 withAll: 0).
  	primTraceLogIndex := 0.
  	traceLog := CArrayAccessor on: (Array new: TraceBufferSize withAll: 0).
  	traceLogIndex := 0.
  	traceSources := TraceSources.
  	statCodeCompactionCount := 0.
  	statCodeCompactionUsecs := 0.
  	extSemTabSize := 256!

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."
  
- 	"initialize class variables"
- 	ObjectMemory initBytesPerWord: self bytesPerWord.
- 	ObjectMemory initialize.
- 	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 := self integerObjectOf: -1.
  
  	methodCache := Array new: MethodCacheSize.
  	atCache := Array new: AtCacheTotalSize.
  	self flushMethodCache.
  	rootTable := Array new: RootTableSize.
  	weakRoots := Array new: RootTableSize + RemapBufferSize + 100.
  	remapBuffer := Array new: RemapBufferSize.
  	gcSemaphoreIndex := 0.
  	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.
  	printSends := "printReturns := printBytecodeAtEachStep :=" false.
  	myBitBlt := BitBltSimulator new setInterpreter: self.
  	headerTypeBytes := CArrayAccessor on: HeaderTypeExtraBytes.
  	transcript := Transcript.
  	displayForm := 'Display has not yet been installed' asDisplayText form.
  	!

Item was changed:
  ----- Method: ObjectMemory>>integerObjectOf: (in category 'interpreter access') -----
  integerObjectOf: value
  	"Convert the integer value, assumed to be in SmallInteger range, into a tagged SmallInteger object.
  	 In C, use a shift and an add to set the tag bit.
+ 	 In Smalltalk we have to work harder because the simulator works with strictly positive bit patterns."
- 	 In Smalltalk we have to work harder because thesimulator works with strictly positive bit patterns."
  
  	^self
  		cCode: [(value << 1) + 1]
  		inSmalltalk: [value >= 0
  						ifTrue: [(value << 1) + 1]
  						ifFalse: [((16r80000000 + value) << 1) + 1]]!

Item was added:
+ ----- Method: Spur32BitMemoryManager class>>bytesPerWord (in category 'word size') -----
+ bytesPerWord
+ 	^4!

Item was added:
+ ----- Method: Spur64BitMemoryManager class>>bytesPerWord (in category 'word size') -----
+ bytesPerWord
+ 	^8!

Item was added:
+ ----- Method: SpurMemoryManager class>>bytesPerWord (in category 'word size') -----
+ bytesPerWord
+ 	^self subclassResponsibility!

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

Item was added:
+ ----- Method: SpurMemoryManager>>integerObjectOf: (in category 'immediates') -----
+ integerObjectOf: value
+ 	"Convert the integer value, assumed to be in SmallInteger range, into a tagged SmallInteger object.
+ 	 In C, use a shift and an add to set the tag bit.
+ 	 In Smalltalk we have to work harder because the simulator works with strictly positive bit patterns."
+ 
+ 	^self
+ 		cCode: [(value << 1) + 1]
+ 		inSmalltalk: [value >= 0
+ 						ifTrue: [(value << 1) + 1]
+ 						ifFalse: [((16r80000000 + value) << 1) + 1]]!

Item was changed:
  ----- Method: StackInterpreter class>>initializeWithOptions: (in category 'initialization') -----
  initializeWithOptions: optionsDictionary
  	"StackInterpreter initializeWithOptions: Dictionary new"
  
- 	NewObjectMemory initializeWithOptions: optionsDictionary.  "initialize ObjectMemory constants"
  	self initializeMiscConstantsWith: optionsDictionary. "must preceed other initialization."
  	self initializeAssociationIndex.
  	self initializeBytecodeTable.
  	self initializeCaches.
  	self initializeCharacterIndex.
  	self initializeCharacterScannerIndices.
  	self initializeClassIndices.
  	self initializeContextIndices.
  	self initializeDirectoryLookupResultCodes.
  	self initializeFrameIndices.
  	self initializeMessageIndices.
  	self initializeMethodIndices.
  	self initializePointIndices.
  	self initializePrimitiveTable.
  	self initializeSchedulerIndices.
  	self initializeSmallIntegers.
  	self initializeStreamIndices!

Item was added:
+ ----- Method: StackInterpreter>>objectMemory: (in category 'initialization') -----
+ objectMemory: anObjectMemory
+ 	<doNotGenerate>
+ 	objectMemory := anObjectMemory!

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

Item was added:
+ ----- Method: StackInterpreterSimulator class>>initializeWithOptions:objectMemoryClass: (in category 'class initialization') -----
+ initializeWithOptions: optionsDictionaryOrArray objectMemoryClass: objectMemoryClassOrNil
+ 	"The relevant ObjectMemory and Interpreter classes must be initialized in order.
+ 	 This happens notionally every time we start the simulator,
+ 	 but in fact happens when ever we instantiate a simulator."
+ 	| optionsDictionary |
+ 	optionsDictionary := optionsDictionaryOrArray isArray
+ 							ifTrue: [Dictionary newFromPairs: optionsDictionaryOrArray]
+ 							ifFalse: [optionsDictionaryOrArray].
+ 	(objectMemoryClassOrNil ifNil: [self objectMemoryClass])
+ 		initializeWithOptions: optionsDictionary.
+ 
+ 	StackInterpreter initializeWithOptions: optionsDictionary!

Item was changed:
  ----- Method: StackInterpreterSimulator class>>new (in category 'instance creation') -----
  new
+ 	^self onObjectMemory: nil options: #()!
- 	^ self == StackInterpreterSimulator
- 		ifTrue: [SmalltalkImage current endianness == #big
- 				ifTrue: [self notYetImplemented"StackInterpreterSimulatorMSB new"]
- 				ifFalse: [StackInterpreterSimulatorLSB new]]
- 		ifFalse: [super new]!

Item was added:
+ ----- Method: StackInterpreterSimulator class>>newWithOptions: (in category 'instance creation') -----
+ newWithOptions: optionsDictionaryOrArray
+ 	^self onObjectMemory: nil options: optionsDictionaryOrArray!

Item was added:
+ ----- Method: StackInterpreterSimulator class>>onObjectMemory: (in category 'instance creation') -----
+ onObjectMemory: anObjectMemory
+ 	^self onObjectMemory: anObjectMemory options: #()!

Item was added:
+ ----- Method: StackInterpreterSimulator class>>onObjectMemory:options: (in category 'instance creation') -----
+ onObjectMemory: anObjectMemory options: optionsDictionaryOrArray
+ 	^self == StackInterpreterSimulator
+ 		ifTrue:
+ 			[self initializeWithOptions: optionsDictionaryOrArray
+ 				objectMemoryClass: (anObjectMemory ifNotNil: [anObjectMemory class]).
+ 			 SmalltalkImage current endianness == #big
+ 				ifTrue: [self notYetImplemented"StackInterpreterSimulatorMSB onObjectMemory: anObjectMemory"]
+ 				ifFalse: [StackInterpreterSimulatorLSB onObjectMemory: anObjectMemory]]
+ 		ifFalse: [super basicNew objectMemory: anObjectMemory; initialize]!

Item was changed:
  ----- Method: StackInterpreterSimulator>>initialize (in category 'initialization') -----
  initialize
  	"Initialize the StackInterpreterSimulator when running the interpreter
  	 inside Smalltalk. The primary responsibility of this method is to allocate
  	 Smalltalk Arrays for variables that will be declared as statically-allocated
  	 global arrays in the translated code."
  
+ 	objectMemory ifNil:
+ 		[objectMemory := self class objectMemoryClass simulatorClass new].
- 	| objectMemoryClass |
- 
- 	"initialize class variables"
- 	objectMemory ifNotNil:
- 		[^self halt].
- 
- 	objectMemoryClass := self class objectMemoryClass.
- 
- 	objectMemoryClass initBytesPerWord: objectMemoryClass bytesPerWord.
- 	objectMemoryClass initialize.
- 	StackInterpreter initialize.
- 
- 	super initialize.
- 	objectMemory := objectMemoryClass simulatorClass new.
  	objectMemory coInterpreter: self.
  
  	"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.
  
  	methodCache := Array new: MethodCacheSize.
  	atCache := Array new: AtCacheTotalSize.
  	self flushMethodCache.
  	self flushAtCache.
  	gcSemaphoreIndex := 0.
  	externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
  	externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
  	externalPrimitiveTableFirstFreeIndex := 0.
  	primitiveTable := self class primitiveTable copy.
  	pluginList := #().
  	mappedPluginEntries := #().
  	desiredNumStackPages := desiredEdenBytes := 0.
  	"This is initialized on loading the image, but convenient for testing stack page values..."
  	numStackPages := self defaultNumStackPages. 
  	startMicroseconds := Time totalSeconds * 1000000.
  
  	"initialize InterpreterSimulator variables used for debugging"
  	byteCount := 0.
  	sendCount := 0.
  	quitBlock := [^ self].
  	traceOn := true.
  	printSends := printReturns := printFrameAtEachStep := printBytecodeAtEachStep := false.
  	myBitBlt := BitBltSimulator new setInterpreter: self.
  	transcript := Transcript.
  	displayForm := 'Display has not yet been installed' asDisplayText form.
  	suppressHeartbeatFlag := false.
  	extSemTabSize := 256.
  	disableBooleanCheat := false!



More information about the Vm-dev mailing list