[Vm-dev] VM Maker: VMMaker.oscog-eem.2056.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.2056.mcz

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

Name: VMMaker.oscog-eem.2056
Author: eem
Time: 29 December 2016, 8:54:25.129752 am
UUID: 36772c61-cd8d-48cf-addb-26a0ba374f3a
Ancestors: VMMaker.oscog-eem.2055

Simulator:

Fix firstIndexableField: in the Spur MM sims.

Have plugins be closed whenever the VM is closed.  Properly implement close to send close to any plugin that wants it.

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

Item was changed:
  ----- Method: CogVMSimulator>>close (in category 'initialization') -----
+ close  "close any files that ST may have opened, etc"
+ 	pluginList do: [:plugin| (plugin ~~ self and: [plugin respondsTo: #close]) ifTrue: [plugin close]]!
- close  "close any files that ST may have opened"
- 	(self loadNewPlugin: 'FilePlugin') ifNotNil:
- 		[:filePlugin| filePlugin close]!

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."
  	super initialize.
  
  	transcript := Transcript.
  
  	objectMemory ifNil:
  		[objectMemory := self class objectMemoryClass simulatorClass new].
  	cogit ifNil:
  		[cogit := self class cogitClass new setInterpreter: self].
  	objectMemory coInterpreter: self cogit: cogit.
  
  	cogit numRegArgs > 0 ifTrue:
  		[debugStackDepthDictionary := Dictionary new].
  
  	cogThreadManager ifNotNil:
  		[super initialize].
  
  	self assert: ConstMinusOne = (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.
  	nsMethodCache := Array new: NSMethodCacheSize.
  	atCache := nil.
  	self flushMethodCache.
  	cogCompiledCodeCompactionCalledFor := false.
  	gcSemaphoreIndex := 0.
  	externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
  	externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
  	externalPrimitiveTableFirstFreeIndex := 0.
  	primitiveTable := self class primitiveTable copy.
  	mappedPluginEntries := OrderedCollection new.
  	objectMemory hasSpurMemoryManagerAPI
  		ifTrue:
  			[primitiveAccessorDepthTable := Array new: primitiveTable size.
  			 pluginList := {}.
  			 self loadNewPlugin: '']
  		ifFalse:
  			[pluginList := {'' -> self }].
  	desiredNumStackPages := desiredEdenBytes := desiredCogCodeSize := 0.
  	"This is initialized on loading the image, but convenient for testing stack page values..."
  	numStackPages := self defaultNumStackPages. 
  	startMicroseconds := self ioUTCStartMicroseconds.
  	maxLiteralCountForCompile := MaxLiteralCountForCompile.
  	minBackwardJumpCountForCompile := MinBackwardJumpCountForCompile.
  	flagInterpretedMethods := false.
  
  	"initialize InterpreterSimulator variables used for debugging"
  	byteCount := lastPollCount := sendCount := lookupCount := 0.
+ 	quitBlock := [^self close].
- 	quitBlock := [^ self].
  	traceOn := true.
  	printSends := printFrameAtEachStep := printBytecodeAtEachStep := false.
  	myBitBlt := BitBltSimulator new setInterpreter: self.
  	displayForm := fakeForm := 'Display has not yet been installed' asDisplayText form.
  	eventQueue := SharedQueue new.
  	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: CogVMSimulator>>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 rightWord prevCtxt |
  	logFile := (FileStream readOnlyFileNamed: fileName) binary.
  	transcript clear.
  	byteCount := 0.
+ 	quitBlock := [^self close].
- 	quitBlock := [^ self].
  	self initStackPages.
  	self loadInitialContext.
  	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: ': <' , (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]].
  "
  		loggingStart >= byteCount ifTrue:
  			[rightWord := logFile nextWord.
  			 currentBytecode = rightWord ifFalse:
  				[self halt: 'halt at ', byteCount printString]].
  		self dispatchOn: currentBytecode in: BytecodeTable.
  		self incrementByteCount].
  	self externalizeIPandSP.
  	logFile close.
  	self inform: nBytes printString , ' bytecodes verfied.'!

Item was changed:
  ----- Method: CogVMSimulator>>logOfBytesWrite:toFileNamed:fromStart: (in category 'testing') -----
  logOfBytesWrite: nBytes toFileNamed: fileName fromStart: loggingStart
  	"Write a log file for testing a flaky interpreter on the same image"
  	"self logOfBytesWrite: 10000 toFileNamed: 'clone32Bytecodes.log' "
  	
  	| logFile |
  	logFile := (FileStream newFileNamed: fileName) binary.
  	transcript clear.
  	byteCount := 0.
+ 	quitBlock := [^self close].
- 	quitBlock := [^ self].
  	self initStackPages.
  	self loadInitialContext.
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	[byteCount < nBytes] whileTrue:
  		[byteCount >= loggingStart ifTrue:
  			[logFile nextWordPut: currentBytecode].
  		self dispatchOn: currentBytecode in: BytecodeTable.
  		self incrementByteCount].
  	self externalizeIPandSP.
  	logFile close!

Item was changed:
  ----- Method: CogVMSimulator>>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 priorFrame rightSelector prevCtxt |
  	logFile := FileStream readOnlyFileNamed: fileName.
  	transcript clear.
  	byteCount := 0.
  	sendCount := 0.
  	priorFrame := localFP.
+ 	quitBlock := [^self close].
- 	quitBlock := [^ self].
  	self initStackPages.
  	self loadInitialContext.
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	prevCtxt := 0.  prevCtxt := prevCtxt.
  	[sendCount < nSends] whileTrue:
  		[
  "
  byteCount>500 ifTrue:
  [byteCount>550 ifTrue: [self halt].
  self externalizeIPandSP.
  prevCtxt = localFP ifFalse:
   [prevCtxt := localFP.
   transcript cr; nextPutAll: (self printTop: 2); endEntry].
  transcript cr; print: byteCount; nextPutAll: ': ' , (localFP hex); space;
   print: (instructionPointer - method - (BaseHeaderSize - 2));
   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.
  		localFP = priorFrame ifFalse:
  			[sendCount := sendCount + 1.
  			 loggingStart >= sendCount ifTrue:
  				[rightSelector := logFile nextLine.
  				 (self stringOf: messageSelector) = rightSelector ifFalse:
  					[self halt: 'halt at ', sendCount printString]].
  			priorFrame := localFP].
  		self incrementByteCount].
  	self externalizeIPandSP.
  	logFile close.
  	self inform: nSends printString , ' sends verfied.'!

Item was changed:
  ----- Method: CogVMSimulator>>logOfSendsWrite:toFileNamed:fromStart: (in category 'testing') -----
  logOfSendsWrite: nSends toFileNamed: fileName fromStart: loggingStart
  	"Write a log file for testing a flaky interpreter on the same image"
  	"self logOfSendsWrite: 10000 toFileNamed: 'clone32Messages.log' fromStart: 2500"
  	
  	| logFile priorFrame |
  	logFile := FileStream newFileNamed: fileName.
  	transcript clear.
  	byteCount := 0.
  	sendCount := 0.
  	priorFrame := localFP.
+ 	quitBlock := [^self close].
- 	quitBlock := [^ self].
  	self initStackPages.
  	self loadInitialContext.
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	[sendCount < nSends] whileTrue:
  		[self dispatchOn: currentBytecode in: BytecodeTable.
  		localFP == priorFrame ifFalse:
  			[sendCount >= loggingStart ifTrue:
  				[sendCount := sendCount + 1.
  				 logFile nextPutAll: (self stringOf: messageSelector); cr].
  			priorFrame := localFP].
  		self incrementByteCount].
  	self externalizeIPandSP.
  	logFile close!

Item was changed:
  ----- Method: CogVMSimulator>>run (in category 'testing') -----
  run
  	"Just run"
  	quitBlock := [displayView ifNotNil:
  				   [displayView containingWindow ifNotNil:
  					[:topWindow|
  					((World submorphs includes: topWindow)
  					 and: [UIManager default confirm: 'close?']) ifTrue:
  						[topWindow delete]]].
+ 				  ^self close].
- 				  ^self].
  	self initStackPages.
  	self loadInitialContext.
  	self initialEnterSmalltalkExecutive!

Item was changed:
  ----- Method: CogVMSimulator>>runWithBreakCount: (in category 'testing') -----
  runWithBreakCount: theBreakCount
  	"Just run, halting when byteCount is reached"
  	quitBlock := [displayView ifNotNil:
  				   [displayView containingWindow ifNotNil:
  					[:topWindow|
  					((World submorphs includes: topWindow)
  					 and: [UIManager default confirm: 'close?']) ifTrue:
  						[topWindow delete]]].
+ 				  ^self close].
- 				  ^self].
  	breakCount := theBreakCount.
  	self initStackPages.
  	self loadInitialContext.
  	self initialEnterSmalltalkExecutive!

Item was changed:
  ----- Method: CogVMSimulator>>testBreakCount:printSends:printFrames:printBytecodes: (in category 'testing') -----
  testBreakCount: breakCount printSends: shouldPrintSends printFrames: shouldPrintFrames printBytecodes: shouldPrintBytecodes
  	self initStackPages.
  	self loadInitialContext.
  	transcript clear.
+ 	quitBlock := [^self close].
- 	quitBlock := [^self].
  	printSends := true & shouldPrintSends. "true & foo allows evaluating printFoo := true in the debugger"
  	printFrameAtEachStep := true & shouldPrintFrames.
  	printBytecodeAtEachStep := true & shouldPrintBytecodes.
  	self ensureDebugAtEachStepBlock.
  	self initialEnterSmalltalkExecutive!

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

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

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

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

Item was changed:
  ----- Method: StackInterpreterSimulator>>close (in category 'initialization') -----
+ close  "close any files that ST may have opened, etc"
+ 	pluginList do: [:plugin| (plugin ~~ self and: [plugin respondsTo: #close]) ifTrue: [plugin close]]!
- close  "close any files that ST may have opened"
- 	(self loadNewPlugin: 'FilePlugin') ifNotNil:
- 		[:filePlugin| filePlugin close]!

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."
  	super initialize.
  
  	bootstrapping := false.
  	transcript := Transcript.
  
  	objectMemory ifNil:
  		[objectMemory := self class objectMemoryClass simulatorClass new].
  	objectMemory coInterpreter: self.
  
  	self assert: ConstMinusOne = (objectMemory integerObjectOf: -1).
  
  	methodCache := Array new: MethodCacheSize.
  	nsMethodCache := Array new: NSMethodCacheSize.
  	atCache := Array new: AtCacheTotalSize.
  	self flushMethodCache.
  	gcSemaphoreIndex := 0.
  	externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
  	externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
  	externalPrimitiveTableFirstFreeIndex := 0.
  	primitiveTable := self class primitiveTable copy.
  	mappedPluginEntries := OrderedCollection new.
  	objectMemory hasSpurMemoryManagerAPI
  		ifTrue:
  			[primitiveAccessorDepthTable := Array new: primitiveTable size.
  			 pluginList := {}.
  			 self loadNewPlugin: '']
  		ifFalse:
  			[pluginList := {'' -> self }].
  	desiredNumStackPages := desiredEdenBytes := 0.
  	"This is initialized on loading the image, but convenient for testing stack page values..."
  	numStackPages := self defaultNumStackPages. 
  	startMicroseconds := self ioUTCStartMicroseconds.
  
  	"initialize InterpreterSimulator variables used for debugging"
  	byteCount := sendCount := lookupCount := 0.
+ 	quitBlock := [^self close].
- 	quitBlock := [^self].
  	traceOn := true.
  	printSends := printReturns := printFrameAtEachStep := printBytecodeAtEachStep := false.
  	myBitBlt := BitBltSimulator new setInterpreter: self.
  	displayForm := fakeForm := 'Display has not yet been installed' asDisplayText form.
  	eventQueue := SharedQueue new.
  	suppressHeartbeatFlag := false.
  	systemAttributes := Dictionary new.
  	extSemTabSize := 256.
  	disableBooleanCheat := false.
  	assertVEPAES := true. "a flag so the assertValidExecutionPointers can be disabled for simulation speed"!

Item was changed:
  ----- Method: StackInterpreterSimulator>>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 rightWord prevCtxt |
  	logFile := (FileStream readOnlyFileNamed: fileName) binary.
  	transcript clear.
  	byteCount := 0.
+ 	quitBlock := [^self close].
- 	quitBlock := [^ self].
  	self initStackPages.
  	self loadInitialContext.
  	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: ': <' , (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]].
  "
  		loggingStart >= byteCount ifTrue:
  			[rightWord := logFile nextWord.
  			 currentBytecode = rightWord ifFalse:
  				[self halt: 'halt at ', byteCount printString]].
  		self dispatchOn: currentBytecode in: BytecodeTable.
  		self incrementByteCount].
  	self externalizeIPandSP.
  	logFile close.
  	self inform: nBytes printString , ' bytecodes verfied.'!

Item was changed:
  ----- Method: StackInterpreterSimulator>>logOfBytesWrite:toFileNamed:fromStart: (in category 'testing') -----
  logOfBytesWrite: nBytes toFileNamed: fileName fromStart: loggingStart
  	"Write a log file for testing a flaky interpreter on the same image"
  	"self logOfBytesWrite: 10000 toFileNamed: 'clone32Bytecodes.log' "
  	
  	| logFile |
  	logFile := (FileStream newFileNamed: fileName) binary.
  	transcript clear.
  	byteCount := 0.
+ 	quitBlock := [^self close].
- 	quitBlock := [^ self].
  	self initStackPages.
  	self loadInitialContext.
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	[byteCount < nBytes] whileTrue:
  		[byteCount >= loggingStart ifTrue:
  			[logFile nextWordPut: currentBytecode].
  		self dispatchOn: currentBytecode in: BytecodeTable.
  		self incrementByteCount].
  	self externalizeIPandSP.
  	logFile close!

Item was changed:
  ----- Method: StackInterpreterSimulator>>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 priorFrame rightSelector prevCtxt |
  	logFile := FileStream readOnlyFileNamed: fileName.
  	transcript clear.
  	byteCount := 0.
  	sendCount := 0.
  	priorFrame := localFP.
+ 	quitBlock := [^self close].
- 	quitBlock := [^ self].
  	self initStackPages.
  	self loadInitialContext.
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	prevCtxt := 0.  prevCtxt := prevCtxt.
  	[sendCount < nSends] whileTrue:
  		[
  "
  byteCount>500 ifTrue:
  [byteCount>550 ifTrue: [self halt].
  self externalizeIPandSP.
  prevCtxt = localFP ifFalse:
   [prevCtxt := localFP.
   transcript cr; nextPutAll: (self printTop: 2); endEntry].
  transcript cr; print: byteCount; nextPutAll: ': ' , (localFP hex); space;
   print: (instructionPointer - method - (BaseHeaderSize - 2));
   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.
  		localFP = priorFrame ifFalse:
  			[sendCount := sendCount + 1.
  			 loggingStart >= sendCount ifTrue:
  				[rightSelector := logFile nextLine.
  				 (self stringOf: messageSelector) = rightSelector ifFalse:
  					[self halt: 'halt at ', sendCount printString]].
  			priorFrame := localFP].
  		self incrementByteCount].
  	self externalizeIPandSP.
  	logFile close.
  	self inform: nSends printString , ' sends verfied.'!

Item was changed:
  ----- Method: StackInterpreterSimulator>>logOfSendsWrite:toFileNamed:fromStart: (in category 'testing') -----
  logOfSendsWrite: nSends toFileNamed: fileName fromStart: loggingStart
  	"Write a log file for testing a flaky interpreter on the same image"
  	"self logOfSendsWrite: 10000 toFileNamed: 'clone32Messages.log' "
  	
  	| logFile priorFrame |
  	logFile := FileStream newFileNamed: fileName.
  	transcript clear.
  	byteCount := 0.
  	sendCount := 0.
  	priorFrame := localFP.
+ 	quitBlock := [^self close].
- 	quitBlock := [^ self].
  	self initStackPages.
  	self loadInitialContext.
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	[sendCount < nSends] whileTrue:
  		[self dispatchOn: currentBytecode in: BytecodeTable.
  		localFP = priorFrame ifFalse:
  			[sendCount >= loggingStart ifTrue:
  				[sendCount := sendCount + 1.
  				logFile nextPutAll: (self stringOf: messageSelector); cr].
  			priorFrame := localFP].
  		self incrementByteCount].
  	self externalizeIPandSP.
  	logFile close!

Item was changed:
  ----- Method: StackInterpreterSimulator>>run (in category 'testing') -----
  run
  	"Just run"
  	quitBlock := [displayView ifNotNil:
  				   [displayView containingWindow ifNotNil:
  					[:topWindow|
  					((World submorphs includes: topWindow)
  					 and: [UIManager default confirm: 'close?']) ifTrue:
  						[topWindow delete]]].
+ 				  ^self close].
- 				  ^self].
  	self initStackPages.
  	self loadInitialContext.
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	[true] whileTrue:
  		[self assertValidExecutionPointers.
  		 atEachStepBlock value. "N.B. may be nil"
  		 self dispatchOn: currentBytecode in: BytecodeTable.
  		 self incrementByteCount].
  	localIP := localIP - 1.
  	"undo the pre-increment of IP before returning"
  	self externalizeIPandSP!

Item was changed:
  ----- Method: StackInterpreterSimulator>>runWithBreakCount: (in category 'testing') -----
  runWithBreakCount: theBreakCount
  	"Just run, halting when byteCount is reached"
  	quitBlock := [displayView ifNotNil:
  				   [displayView containingWindow ifNotNil:
  					[:topWindow|
  					((World submorphs includes: topWindow)
  					 and: [UIManager default confirm: 'close?']) ifTrue:
  						[topWindow delete]]].
+ 				  ^self close].
- 				  ^self].
  	breakCount := theBreakCount.
  	self initStackPages.
  	self loadInitialContext.
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	[true] whileTrue:
  		[self assertValidExecutionPointers.
  		 self dispatchOn: currentBytecode in: BytecodeTable.
  		 self incrementByteCount].
  	localIP := localIP - 1.
  	"undo the pre-increment of IP before returning"
  	self externalizeIPandSP!

Item was changed:
  ----- Method: StackInterpreterSimulator>>test (in category 'testing') -----
  test
  	self initStackPages.
  	self loadInitialContext.
  	transcript clear.
  	byteCount := 0.
  	breakCount := -1.
+ 	quitBlock := [^self close].
- 	quitBlock := [^self].
  	printSends := printReturns := true.
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	[true] whileTrue:
  		[self assertValidExecutionPointers.
  		 printFrameAtEachStep ifTrue:
  			[self printFrame: localFP WithSP: localSP].
  		 printBytecodeAtEachStep ifTrue:
  			[self printCurrentBytecodeOn: Transcript.
  			 Transcript cr; flush].
  		 self dispatchOn: currentBytecode in: BytecodeTable.
  		 self incrementByteCount.
  		 byteCount = breakCount ifTrue:
  			["printFrameAtEachStep :=" printBytecodeAtEachStep := true.
  			 self halt: 'hit breakCount break-point']].
  	self externalizeIPandSP!

Item was changed:
  ----- Method: StackInterpreterSimulator>>test1 (in category 'testing') -----
  test1
  	self initStackPages.
  	self loadInitialContext.
  	transcript clear.
  	byteCount := 0.
  	breakCount := -1.
  	self setBreakSelector: #blockCopy:.
+ 	quitBlock := [^self close].
- 	quitBlock := [^self].
  	printSends := printReturns := true.
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	[true] whileTrue:
  		[self assertValidExecutionPointers.
  		 "byteCount >= 22283 ifTrue:
  			[(self checkIsStillMarriedContext: 22186072 currentFP: localFP) ifFalse:
  				[self halt]]."
  		 (printBytecodeAtEachStep
  		  "and: [self isMarriedOrWidowedContext: 22189568]") ifTrue:
  			["| thePage |
  			 thePage := stackPages stackPageFor: (self frameOfMarriedContext: 22189568).
  			 thePage == stackPage
  				ifTrue: [self shortPrintFrameAndCallers: localFP SP: localSP]
  				ifFalse: [self shortPrintFrameAndCallers: thePage headFrameFP SP: thePage headFrameSP]."
  			 self printCurrentBytecodeOn: Transcript.
  			 Transcript cr; flush].
  
  		 self dispatchOn: currentBytecode in: BytecodeTable.
  		 self incrementByteCount.
  		 byteCount = breakCount ifTrue:
  			["printFrameAtEachStep := true."
  			 printSends := printBytecodeAtEachStep := true.
  			 self halt: 'hit breakCount break-point']].
  	self externalizeIPandSP!

Item was changed:
  ----- Method: StackInterpreterSimulator>>testBreakCount:printSends:printFrames:printBytecodes: (in category 'testing') -----
  testBreakCount: breakCount printSends: shouldPrintSends printFrames: shouldPrintFrames printBytecodes: shouldPrintBytecodes
  	self initStackPages.
  	self loadInitialContext.
  	transcript clear.
  	byteCount := 0.
+ 	quitBlock := [^self close].
- 	quitBlock := [^self].
  	printSends := true & shouldPrintSends. "true & foo allows evaluating printFoo := true in the debugger"
  	printFrameAtEachStep := true & shouldPrintFrames.
  	printBytecodeAtEachStep := true & shouldPrintBytecodes.
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	[true] whileTrue:
  		[self assertValidExecutionPointers.
  		 printFrameAtEachStep ifTrue:
  			[self printFrame: localFP WithSP: localSP].
  		 printBytecodeAtEachStep ifTrue:
  			[self printCurrentBytecodeOn: Transcript.
  			 Transcript cr; flush].
  		 self dispatchOn: currentBytecode in: BytecodeTable.
  		 self incrementByteCount.
  		 byteCount = breakCount ifTrue:
  			["printFrameAtEachStep :=" printBytecodeAtEachStep := true.
  			 self halt: 'hit breakCount break-point']].
  	self externalizeIPandSP!