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

commits at source.squeak.org commits at source.squeak.org
Sun Feb 19 19:44:56 UTC 2012


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

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

Name: VMMaker.oscog-eem.146
Author: eem
Time: 19 February 2012, 11:42:38.406 am
UUID: b6c14447-ad5d-4a58-8479-63e47d215c0b
Ancestors: VMMaker.oscog-eem.145

Support for multiple bytecode sets.  The sign bit of a method's
header can select an alternative bytecode set.  This is implemented
by adding 256 to currentBytecode when dispatching.  The overhead
is avoioded for slow machines using macrology.  But in tests on a
fast MacBook Pro adding the offset can actually be faster because
other effects dominate dispatch performance on modern machines
(e.g. code placement).

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

Item was changed:
  ----- Method: CCodeGenerator>>addClassVarsFor: (in category 'public') -----
  addClassVarsFor: aClass
  	"Add the class variables for the given class to the code base as constants."
+ 	aClass classPool associationsDo:
+ 		[:assoc | self addConstantForBinding: assoc]!
- 	aClass classPool associationsDo: [:assoc | | val node |
- 		val := assoc value.
- 		node := (useSymbolicConstants and:[self isCLiteral: val])
- 				ifTrue:[TDefineNode new setName: assoc key asString value: assoc value]
- 				ifFalse:[TConstantNode new setValue: assoc value].
- 		constants at: assoc key asString put: node].
- !

Item was added:
+ ----- Method: CCodeGenerator>>addConstantForBinding: (in category 'public') -----
+ addConstantForBinding: variableBinding
+ 	"Add the pool variable to the code base as a constant."
+ 	| node val |
+ 	val := variableBinding value.
+ 	node := (useSymbolicConstants and: [self isCLiteral: val])
+ 				ifTrue:[TDefineNode new
+ 							setName: variableBinding key asString
+ 							value: variableBinding value]
+ 				ifFalse:[TConstantNode new setValue: variableBinding value].
+ 	constants at: variableBinding key asString put: node!

Item was changed:
  ----- Method: CCodeGenerator>>emitCConstantsOn: (in category 'C code generator') -----
  emitCConstantsOn: aStream 
  	"Store the global variable declarations on the given stream."
  	| unused constList |
  	unused := constants keys asSet.
  	methods do:
  		[:meth|
  		meth parseTree nodesDo:
  			[:n| n isConstant ifTrue: [unused remove: n name ifAbsent: []]]].
  	unused copy do:
  		[:const|
  		(variableDeclarations anySatisfy: [:value| value includesSubString: const]) ifTrue:
  			[unused remove: const ifAbsent: []]].
  	"Don't generate any defines for the externally defined constants, STACKVM, COGVM, COGMTVM et al."
  	(VMClass class>>#initializeMiscConstantsWith:) literalsDo:
  		[:lit|
  		lit isVariableBinding ifTrue:
  			[unused add: lit key]].
+ 	 "force inclusion of BytesPerWord and MULTIPLEBYTECODESETS declarations."
+ 	#(BytesPerWord MULTIPLEBYTECODESETS) do:
+ 		[:key| unused remove: key ifAbsent: []].
- 	unused remove: #BytesPerWord ifAbsent: []. "force inclusion of BytesPerWord declaration"
  	constList := constants keys reject:[:any| unused includes: any].
  	aStream cr; nextPutAll: '/*** Constants ***/'; cr.
  	(self sortStrings: constList) do:
  		[:varName| | node default value |
  		node := constants at: varName.
  		node name isEmpty ifFalse:
  			["Allow the class to provide an alternative definition, either of just the value or the whole shebang"
  			default := self cLiteralFor: node value name: varName.
  			value := vmClass
  						ifNotNil:
  							[(vmClass specialValueForConstant: node name default: default)
  								ifNotNil: [:specialDef| specialDef]
  								ifNil: [default]]
  						ifNil: [default].
  			value first ~= $# ifTrue:
  				[aStream nextPutAll: '#define '; nextPutAll: node name; space].
  			aStream nextPutAll: value; cr]].
  	aStream cr!

Item was changed:
  ----- Method: CoInterpreter>>setMethod: (in category 'internal interpreter access') -----
  setMethod: aMethodObj
  	self assert: aMethodObj asUnsignedInteger >= objectMemory startOfMemory.
+ 	super setMethod: aMethodObj!
- 	method := aMethodObj!

Item was changed:
  ----- Method: CogVMSimulator>>interpret (in category 'interpreter shell') -----
  interpret
  	"This is the main interpreter loop. It normally loops forever, fetching and executing bytecodes.
  	 When running in the context of a web browser plugin VM, however, it must return control to the
  	 web browser periodically. This should done only when the state of the currently running Squeak
  	 thread is safely stored in the object heap. Since this is the case at the moment that a check for
  	 interrupts is performed, that is when we return to the browser if it is time to do so.  Interrupt
  	 checks happen quite frequently.
  
  	Override for simulation to insert bytecode breakpoint support."
  
  	<inline: false>
  	"If stacklimit is zero then the stack pages have not been initialized."
  	stackLimit = 0 ifTrue:
  		[^self initStackPagesAndInterpret].
  	"record entry time when running as a browser plug-in"
  	self browserPluginInitialiseIfNeeded.
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	[true] whileTrue:
  		[self assertValidExecutionPointers.
  		 atEachStepBlock value. "N.B. may be nil"
+ 		 self dispatchOn: currentBytecode + bytecodeSetSelector in: BytecodeTable.
- 		 self dispatchOn: currentBytecode in: BytecodeTable.
  		 self incrementByteCount].
  	localIP := localIP - 1.  "undo the pre-increment of IP before returning"
  	self externalizeIPandSP.
  	^nil
  !

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 rightByte prevCtxt |
  	logFile := (FileStream readOnlyFileNamed: fileName) binary.
  	transcript clear.
  	byteCount := 0.
  	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 + bytecodeSetSelector = rightWord ifFalse:
- 			[rightByte := logFile next.
- 			 currentBytecode = rightByte ifFalse:
  				[self halt: 'halt at ', byteCount printString]].
+ 		self dispatchOn: currentBytecode + bytecodeSetSelector in: BytecodeTable.
- 		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].
  	self initStackPages.
  	self loadInitialContext.
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	[byteCount < nBytes] whileTrue:
  		[byteCount >= loggingStart ifTrue:
+ 			[logFile nextWordPut: currentBytecode + bytecodeSetSelector].
+ 		self dispatchOn: currentBytecode + bytecodeSetSelector in: BytecodeTable.
- 			[logFile nextPut: 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].
  	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 + bytecodeSetSelector in: BytecodeTable.
- 		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].
  	self initStackPages.
  	self loadInitialContext.
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	[sendCount < nSends] whileTrue:
+ 		[self dispatchOn: currentBytecode + bytecodeSetSelector in: BytecodeTable.
- 		[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>>printCurrentBytecodeOn: (in category 'debug printing') -----
  printCurrentBytecodeOn: aStream
  	| code |
  	code := currentBytecode radix: 16.
+ 	aStream ensureCr; print: localIP - method - 3; tab.
+ 	bytecodeSetSelector > 0 ifTrue:
+ 		[aStream nextPutAll: 'ALT '].
  	aStream
- 		ensureCr;
- 		print: localIP - method - 3;
- 		tab;
  		nextPut: (code size < 2
  					ifTrue: [$0]
  					ifFalse: [code at: 1]);
  		nextPut: code last; space;
+ 		nextPutAll: (BytecodeTable at: currentBytecode + bytecodeSetSelector + 1);
- 		nextPutAll: (BytecodeTable at: currentBytecode + 1);
  		space;
  		nextPut: $(; print: byteCount + 1; nextPut: $)!

Item was changed:
  ----- Method: Cogit>>cog:selector: (in category 'jit - api') -----
  cog: aMethodObj selector: aSelectorOop
  	"Attempt to produce a machine code method for the bytecode method
  	 object aMethodObj.  N.B. If there is no code memory available do *NOT*
  	 attempt to reclaim the method zone.  Certain clients (e.g. ceSICMiss:)
  	 depend on the zone remaining constant across method generation."
  	<api>
  	<returnTypeC: #'CogMethod *'>
  	| cogMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	self assert: ((coInterpreter methodHasCogMethod: aMethodObj) not
  				or: [(self noAssertMethodClassAssociationOf: aMethodObj) = objectMemory nilObject]).
  	"coInterpreter stringOf: aSelectorOop"
  	coInterpreter
  		compilationBreak: aSelectorOop
  		point: (objectMemory lengthOf: aSelectorOop).
  	aMethodObj = breakMethod ifTrue: [self halt: 'Compilation of breakMethod'].
  	self cppIf: NewspeakVM
  		ifTrue: [cogMethod := methodZone findPreviouslyCompiledVersionOf: aMethodObj with: aSelectorOop.
  				cogMethod ifNotNil:
  					[(coInterpreter methodHasCogMethod: aMethodObj) not ifTrue:
  						[self assert: (coInterpreter rawHeaderOf: aMethodObj) = cogMethod methodHeader.
  						 cogMethod methodObject: aMethodObj.
  						 coInterpreter rawHeaderOf: aMethodObj put: cogMethod asInteger].
  					^cogMethod]].
+ 	"The alternate bytecode set is for now always interpreted."
+ 	(coInterpreter methodUsesAlternateBytecodeSet: aMethodObj) ifTrue:
+ 		[^nil].
  	methodObj := aMethodObj.
  	cogMethod := self compileCogMethod: aSelectorOop.
  	(cogMethod asInteger between: MaxNegativeErrorCode and: -1) ifTrue:
  		[cogMethod asInteger >= MaxUnreportableError
  			ifTrue:
  				[cogMethod asInteger = InsufficientCodeSpace ifTrue:
  					[coInterpreter callForCogCompiledCodeCompaction]]
  			ifFalse:
  				[self reportError: (self cCoerceSimple: cogMethod to: #sqInt)].
  		 ^nil].
  	"self cCode: ''
  		inSmalltalk:
  			[coInterpreter printCogMethod: cogMethod.
  			 ""coInterpreter symbolicMethod: aMethodObj.""
  			 self assertValidMethodMap: cogMethod."
  			 "self disassembleMethod: cogMethod."
  			 "printInstructions := clickConfirm := true""]."
  	^cogMethod!

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 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'
- 	instanceVariableNames: 'currentBytecode 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 class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses"
  	aCCodeGenerator
  		addHeaderFile:'<stddef.h> /* for e.g. alloca */';
  		addHeaderFile:'<setjmp.h>';
  		addHeaderFile:'"vmCallback.h"';
  		addHeaderFile:'"sqMemoryFence.h"';
  		addHeaderFile:'"dispdbg.h"'.
  	self declareInterpreterVersionIn: aCCodeGenerator
  		defaultName: 'Stack'.
  	aCCodeGenerator
  		var: #interpreterProxy  type: #'struct VirtualMachine*'.
  	aCCodeGenerator
  		declareVar: #sendTrace type: 'volatile int';
  		declareVar: #byteCount type: 'unsigned long'.
  	"These need to be pointers or unsigned."
  	self declareC: #(instructionPointer method newMethod)
  		as: #usqInt
  		in: aCCodeGenerator.
  	"These are all pointers; char * because Slang has no support for C pointer arithmetic."
  	self declareC: #(localIP localSP localFP stackPointer framePointer stackLimit stackMemory)
  		as: #'char *'
  		in: aCCodeGenerator.
  	self declareC: #(stackPage overflowedPage)
  		as: #'StackPage *'
  		in: aCCodeGenerator.
  	aCCodeGenerator removeVariable: 'stackPages'.  "this is an implicit receiver in the translated code."
+ 	"This defines bytecodeSetSelector as 0 if MULTIPLEBYTECODESETS
+ 	 is not defined, for the benefit of the interpreter on slow machines."
+ 	aCCodeGenerator addConstantForBinding: (self bindingOf: #MULTIPLEBYTECODESETS).
+ 	MULTIPLEBYTECODESETS ifFalse:
+ 		[aCCodeGenerator
+ 			var: #bytecodeSetSelector
+ 			declareC: '#define bytecodeSetSelector 0'].
  	aCCodeGenerator
  		var: #methodCache
  		declareC: 'long methodCache[MethodCacheSize + 1 /* ', (MethodCacheSize + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #atCache
  		declareC: 'sqInt atCache[AtCacheTotalSize + 1 /* ', (AtCacheTotalSize + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #primitiveTable
  		declareC: 'void (*primitiveTable[MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex +2) printString, ' */])(void) = ', self primitiveTableString.
  	self primitiveTable do:
  		[:symbolOrNot|
  		(symbolOrNot isSymbol
  		 and: [symbolOrNot ~~ #primitiveFail]) ifTrue:
  			[(aCCodeGenerator methodNamed: symbolOrNot) ifNotNil:
  				[:tMethod| tMethod returnType: #void]]].
  	aCCodeGenerator
  		var: #primitiveFunctionPointer
  		declareC: 'void (*primitiveFunctionPointer)()'.
  	aCCodeGenerator
  		var: #externalPrimitiveTable
  		declareC: 'void (*externalPrimitiveTable[MaxExternalPrimitiveTableSize + 1 /* ', (MaxExternalPrimitiveTableSize + 1) printString, ' */])(void)'.
  	aCCodeGenerator var: #showSurfaceFn type: #'void *'.
  	aCCodeGenerator
  		var: #jmpBuf
  		declareC: 'jmp_buf jmpBuf[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #suspendedCallbacks
  		declareC: 'usqInt suspendedCallbacks[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #suspendedMethods
  		declareC: 'usqInt suspendedMethods[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #interruptCheckChain
  		declareC: 'void (*interruptCheckChain)(void) = 0'.
  	aCCodeGenerator
  		var: #breakSelector type: #'char *';
  		var: #breakSelectorLength
  		declareC: 'sqInt breakSelectorLength = -1'.
  
  	self declareC: #(nextPollUsecs nextWakeupUsecs longRunningPrimitiveGCUsecs
  					longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs)
  		as: #usqLong
  		in: aCCodeGenerator.
  	aCCodeGenerator var: #nextProfileTick type: #sqLong!

Item was changed:
  ----- Method: StackInterpreter class>>initializeBytecodeTable (in category 'initialization') -----
  initializeBytecodeTable
+ 	"StackInterpreter initializeBytecodeTable"
- 	"Interpreter initializeBytecodeTable"
- 	"Note: This table will be used to generate a C switch statement."
  
+ 	NewspeakVM ifTrue:
+ 		[^self initializeBytecodeTableForNewspeakV3PlusClosures].
- 	BytecodeTable := Array new: 256.
- 	self table: BytecodeTable from:
- 	{
- 		#(  0  15 pushReceiverVariableBytecode).
- 		#( 16  31 pushTemporaryVariableBytecode).
- 		#( 32  63 pushLiteralConstantBytecode).
- 		#( 64  95 pushLiteralVariableBytecode).
- 		#( 96 103 storeAndPopReceiverVariableBytecode).
- 		#(104 111 storeAndPopTemporaryVariableBytecode).
- 		#(112 pushReceiverBytecode).
- 		#(113 pushConstantTrueBytecode).
- 		#(114 pushConstantFalseBytecode).
- 		#(115 pushConstantNilBytecode).
- 		#(116 pushConstantMinusOneBytecode).
- 		#(117 pushConstantZeroBytecode).
- 		#(118 pushConstantOneBytecode).
- 		#(119 pushConstantTwoBytecode).
- 		#(120 returnReceiver).
- 		#(121 returnTrue).
- 		#(122 returnFalse).
- 		#(123 returnNil).
- 		#(124 returnTopFromMethod).
- 		#(125 returnTopFromBlock).
  
+ 	^self initializeBytecodeTableForSqueakV3PlusClosures!
- 		"Newspeak bytecodes"
- 		{ 126. NewspeakVM ifTrue: [#dynamicSuperSendBytecode] ifFalse: [#unknownBytecode]}.
- 		{ 127. NewspeakVM ifTrue: [#pushImplicitReceiverBytecode] ifFalse: [#unknownBytecode]}.
- 
- 		#(128 extendedPushBytecode).
- 		#(129 extendedStoreBytecode).
- 		#(130 extendedStoreAndPopBytecode).
- 		#(131 singleExtendedSendBytecode).
- 		#(132 doubleExtendedDoAnythingBytecode).
- 		#(133 singleExtendedSuperBytecode).
- 		#(134 secondExtendedSendBytecode).
- 		#(135 popStackBytecode).
- 		#(136 duplicateTopBytecode).
- 
- 		#(137 pushActiveContextBytecode).
- 		"Closure & Newspeak bytecodes"
- 		#(138 pushNewArrayBytecode).
- 		{139. NewspeakVM ifTrue: [#pushExplicitOuterSendReceiverBytecode] ifFalse: [#unknownBytecode]}.
- 		#(140 pushRemoteTempLongBytecode).
- 		#(141 storeRemoteTempLongBytecode).
- 		#(142 storeAndPopRemoteTempLongBytecode).
- 		#(143 pushClosureCopyCopiedValuesBytecode).
- 
- 		#(144 151 shortUnconditionalJump).
- 		#(152 159 shortConditionalJump).
- 		#(160 167 longUnconditionalJump).
- 		#(168 171 longJumpIfTrue).
- 		#(172 175 longJumpIfFalse).
- 
- 		"176-191 were sendArithmeticSelectorBytecode"
- 		#(176 bytecodePrimAdd).
- 		#(177 bytecodePrimSubtract).
- 		#(178 bytecodePrimLessThan).
- 		#(179 bytecodePrimGreaterThan).
- 		#(180 bytecodePrimLessOrEqual).
- 		#(181 bytecodePrimGreaterOrEqual).
- 		#(182 bytecodePrimEqual).
- 		#(183 bytecodePrimNotEqual).
- 		#(184 bytecodePrimMultiply).
- 		#(185 bytecodePrimDivide).
- 		#(186 bytecodePrimMod).
- 		#(187 bytecodePrimMakePoint).
- 		#(188 bytecodePrimBitShift).
- 		#(189 bytecodePrimDiv).
- 		#(190 bytecodePrimBitAnd).
- 		#(191 bytecodePrimBitOr).	
- 
- 		"192-207 were sendCommonSelectorBytecode"
- 		#(192 bytecodePrimAt).
- 		#(193 bytecodePrimAtPut).
- 		#(194 bytecodePrimSize).
- 		#(195 bytecodePrimNext).
- 		#(196 bytecodePrimNextPut).
- 		#(197 bytecodePrimAtEnd).
- 		#(198 bytecodePrimEquivalent).
- 		#(199 bytecodePrimClass).
- 		#(200 bytecodePrimBlockCopy).
- 		#(201 bytecodePrimValue).
- 		#(202 bytecodePrimValueWithArg).
- 		#(203 bytecodePrimDo).
- 		#(204 bytecodePrimNew).
- 		#(205 bytecodePrimNewWithArg).
- 		#(206 bytecodePrimPointX).
- 		#(207 bytecodePrimPointY).
- 
- 		#(208 223 sendLiteralSelector0ArgsBytecode).
- 		#(224 239 sendLiteralSelector1ArgBytecode).
- 		#(240 255 sendLiteralSelector2ArgsBytecode).
- 	}!

Item was added:
+ ----- Method: StackInterpreter class>>initializeBytecodeTableForNewspeakV3PlusClosures (in category 'initialization') -----
+ initializeBytecodeTableForNewspeakV3PlusClosures
+ 	"StackInterpreter initializeBytecodeTableForNewspeakV3PlusClosures"
+ 	"Note: This table will be used to generate a C switch statement."
+ 
+ 	BytecodeTable := Array new: 256.
+ 	self table: BytecodeTable from:
+ 	#(
+ 		(  0  15 pushReceiverVariableBytecode)
+ 		( 16  31 pushTemporaryVariableBytecode)
+ 		( 32  63 pushLiteralConstantBytecode)
+ 		( 64  95 pushLiteralVariableBytecode)
+ 		( 96 103 storeAndPopReceiverVariableBytecode)
+ 		(104 111 storeAndPopTemporaryVariableBytecode)
+ 		(112 pushReceiverBytecode)
+ 		(113 pushConstantTrueBytecode)
+ 		(114 pushConstantFalseBytecode)
+ 		(115 pushConstantNilBytecode)
+ 		(116 pushConstantMinusOneBytecode)
+ 		(117 pushConstantZeroBytecode)
+ 		(118 pushConstantOneBytecode)
+ 		(119 pushConstantTwoBytecode)
+ 		(120 returnReceiver)
+ 		(121 returnTrue)
+ 		(122 returnFalse)
+ 		(123 returnNil)
+ 		(124 returnTopFromMethod)
+ 		(125 returnTopFromBlock)
+ 
+ 		"2 of the 3 Newspeak bytecodes"
+ 		(126 dynamicSuperSendBytecode)
+ 		(127 pushImplicitReceiverBytecode)
+ 
+ 		(128 extendedPushBytecode)
+ 		(129 extendedStoreBytecode)
+ 		(130 extendedStoreAndPopBytecode)
+ 		(131 singleExtendedSendBytecode)
+ 		(132 doubleExtendedDoAnythingBytecode)
+ 		(133 singleExtendedSuperBytecode)
+ 		(134 secondExtendedSendBytecode)
+ 		(135 popStackBytecode)
+ 		(136 duplicateTopBytecode)
+ 
+ 		(137 pushActiveContextBytecode)
+ 		(138 pushNewArrayBytecode)
+ 
+ 		"The last of 3 Newspeak bytecodes"
+ 		(139 pushExplicitOuterSendReceiverBytecode)
+ 
+ 		(140 pushRemoteTempLongBytecode)
+ 		(141 storeRemoteTempLongBytecode)
+ 		(142 storeAndPopRemoteTempLongBytecode)
+ 		(143 pushClosureCopyCopiedValuesBytecode)
+ 
+ 		(144 151 shortUnconditionalJump)
+ 		(152 159 shortConditionalJump)
+ 		(160 167 longUnconditionalJump)
+ 		(168 171 longJumpIfTrue)
+ 		(172 175 longJumpIfFalse)
+ 
+ 		"176-191 were sendArithmeticSelectorBytecode"
+ 		(176 bytecodePrimAdd)
+ 		(177 bytecodePrimSubtract)
+ 		(178 bytecodePrimLessThan)
+ 		(179 bytecodePrimGreaterThan)
+ 		(180 bytecodePrimLessOrEqual)
+ 		(181 bytecodePrimGreaterOrEqual)
+ 		(182 bytecodePrimEqual)
+ 		(183 bytecodePrimNotEqual)
+ 		(184 bytecodePrimMultiply)
+ 		(185 bytecodePrimDivide)
+ 		(186 bytecodePrimMod)
+ 		(187 bytecodePrimMakePoint)
+ 		(188 bytecodePrimBitShift)
+ 		(189 bytecodePrimDiv)
+ 		(190 bytecodePrimBitAnd)
+ 		(191 bytecodePrimBitOr)	
+ 
+ 		"192-207 were sendCommonSelectorBytecode"
+ 		(192 bytecodePrimAt)
+ 		(193 bytecodePrimAtPut)
+ 		(194 bytecodePrimSize)
+ 		(195 bytecodePrimNext)
+ 		(196 bytecodePrimNextPut)
+ 		(197 bytecodePrimAtEnd)
+ 		(198 bytecodePrimEquivalent)
+ 		(199 bytecodePrimClass)
+ 		(200 bytecodePrimBlockCopy)
+ 		(201 bytecodePrimValue)
+ 		(202 bytecodePrimValueWithArg)
+ 		(203 bytecodePrimDo)
+ 		(204 bytecodePrimNew)
+ 		(205 bytecodePrimNewWithArg)
+ 		(206 bytecodePrimPointX)
+ 		(207 bytecodePrimPointY)
+ 
+ 		(208 223 sendLiteralSelector0ArgsBytecode)
+ 		(224 239 sendLiteralSelector1ArgBytecode)
+ 		(240 255 sendLiteralSelector2ArgsBytecode)
+ 	)!

Item was added:
+ ----- Method: StackInterpreter class>>initializeBytecodeTableForSqueakV3PlusClosures (in category 'initialization') -----
+ initializeBytecodeTableForSqueakV3PlusClosures
+ 	"StackInterpreter initializeBytecodeTableForSqueakV3PlusClosures"
+ 	"Note: This table will be used to generate a C switch statement."
+ 
+ 	BytecodeTable := Array new: 256.
+ 	self table: BytecodeTable from:
+ 	#(
+ 		(  0  15 pushReceiverVariableBytecode)
+ 		( 16  31 pushTemporaryVariableBytecode)
+ 		( 32  63 pushLiteralConstantBytecode)
+ 		( 64  95 pushLiteralVariableBytecode)
+ 		( 96 103 storeAndPopReceiverVariableBytecode)
+ 		(104 111 storeAndPopTemporaryVariableBytecode)
+ 		(112 pushReceiverBytecode)
+ 		(113 pushConstantTrueBytecode)
+ 		(114 pushConstantFalseBytecode)
+ 		(115 pushConstantNilBytecode)
+ 		(116 pushConstantMinusOneBytecode)
+ 		(117 pushConstantZeroBytecode)
+ 		(118 pushConstantOneBytecode)
+ 		(119 pushConstantTwoBytecode)
+ 		(120 returnReceiver)
+ 		(121 returnTrue)
+ 		(122 returnFalse)
+ 		(123 returnNil)
+ 		(124 returnTopFromMethod)
+ 		(125 returnTopFromBlock)
+ 
+ 		(126 127 unknownBytecode)
+ 
+ 		(128 extendedPushBytecode)
+ 		(129 extendedStoreBytecode)
+ 		(130 extendedStoreAndPopBytecode)
+ 		(131 singleExtendedSendBytecode)
+ 		(132 doubleExtendedDoAnythingBytecode)
+ 		(133 singleExtendedSuperBytecode)
+ 		(134 secondExtendedSendBytecode)
+ 		(135 popStackBytecode)
+ 		(136 duplicateTopBytecode)
+ 
+ 		(137 pushActiveContextBytecode)
+ 		(138 pushNewArrayBytecode)
+ 		(139 unknownBytecode)
+ 		(140 pushRemoteTempLongBytecode)
+ 		(141 storeRemoteTempLongBytecode)
+ 		(142 storeAndPopRemoteTempLongBytecode)
+ 		(143 pushClosureCopyCopiedValuesBytecode)
+ 
+ 		(144 151 shortUnconditionalJump)
+ 		(152 159 shortConditionalJump)
+ 		(160 167 longUnconditionalJump)
+ 		(168 171 longJumpIfTrue)
+ 		(172 175 longJumpIfFalse)
+ 
+ 		"176-191 were sendArithmeticSelectorBytecode"
+ 		(176 bytecodePrimAdd)
+ 		(177 bytecodePrimSubtract)
+ 		(178 bytecodePrimLessThan)
+ 		(179 bytecodePrimGreaterThan)
+ 		(180 bytecodePrimLessOrEqual)
+ 		(181 bytecodePrimGreaterOrEqual)
+ 		(182 bytecodePrimEqual)
+ 		(183 bytecodePrimNotEqual)
+ 		(184 bytecodePrimMultiply)
+ 		(185 bytecodePrimDivide)
+ 		(186 bytecodePrimMod)
+ 		(187 bytecodePrimMakePoint)
+ 		(188 bytecodePrimBitShift)
+ 		(189 bytecodePrimDiv)
+ 		(190 bytecodePrimBitAnd)
+ 		(191 bytecodePrimBitOr)	
+ 
+ 		"192-207 were sendCommonSelectorBytecode"
+ 		(192 bytecodePrimAt)
+ 		(193 bytecodePrimAtPut)
+ 		(194 bytecodePrimSize)
+ 		(195 bytecodePrimNext)
+ 		(196 bytecodePrimNextPut)
+ 		(197 bytecodePrimAtEnd)
+ 		(198 bytecodePrimEquivalent)
+ 		(199 bytecodePrimClass)
+ 		(200 bytecodePrimBlockCopy)
+ 		(201 bytecodePrimValue)
+ 		(202 bytecodePrimValueWithArg)
+ 		(203 bytecodePrimDo)
+ 		(204 bytecodePrimNew)
+ 		(205 bytecodePrimNewWithArg)
+ 		(206 bytecodePrimPointX)
+ 		(207 bytecodePrimPointY)
+ 
+ 		(208 223 sendLiteralSelector0ArgsBytecode)
+ 		(224 239 sendLiteralSelector1ArgBytecode)
+ 		(240 255 sendLiteralSelector2ArgsBytecode)
+ 	)!

Item was added:
+ ----- Method: StackInterpreter class>>initializeSqueakV3PlusClosuresBytecodeTable (in category 'initialization') -----
+ initializeSqueakV3PlusClosuresBytecodeTable
+ 	"StackInterpreter initializeSqueakV3PlusClosuresBytecodeTable"
+ 	"Note: This table will be used to generate a C switch statement."
+ 
+ 	BytecodeTable := Array new: 256.
+ 	self table: BytecodeTable from:
+ 	#(
+ 		(  0  15 pushReceiverVariableBytecode)
+ 		( 16  31 pushTemporaryVariableBytecode)
+ 		( 32  63 pushLiteralConstantBytecode)
+ 		( 64  95 pushLiteralVariableBytecode)
+ 		( 96 103 storeAndPopReceiverVariableBytecode)
+ 		(104 111 storeAndPopTemporaryVariableBytecode)
+ 		(112 pushReceiverBytecode)
+ 		(113 pushConstantTrueBytecode)
+ 		(114 pushConstantFalseBytecode)
+ 		(115 pushConstantNilBytecode)
+ 		(116 pushConstantMinusOneBytecode)
+ 		(117 pushConstantZeroBytecode)
+ 		(118 pushConstantOneBytecode)
+ 		(119 pushConstantTwoBytecode)
+ 		(120 returnReceiver)
+ 		(121 returnTrue)
+ 		(122 returnFalse)
+ 		(123 returnNil)
+ 		(124 returnTopFromMethod)
+ 		(125 returnTopFromBlock)
+ 
+ 		(126 127 unknownBytecode)
+ 
+ 		(128 extendedPushBytecode)
+ 		(129 extendedStoreBytecode)
+ 		(130 extendedStoreAndPopBytecode)
+ 		(131 singleExtendedSendBytecode)
+ 		(132 doubleExtendedDoAnythingBytecode)
+ 		(133 singleExtendedSuperBytecode)
+ 		(134 secondExtendedSendBytecode)
+ 		(135 popStackBytecode)
+ 		(136 duplicateTopBytecode)
+ 
+ 		(137 pushActiveContextBytecode)
+ 		(138 pushNewArrayBytecode)
+ 		(139 unknownBytecode)
+ 		(140 pushRemoteTempLongBytecode)
+ 		(141 storeRemoteTempLongBytecode)
+ 		(142 storeAndPopRemoteTempLongBytecode)
+ 		(143 pushClosureCopyCopiedValuesBytecode)
+ 
+ 		(144 151 shortUnconditionalJump)
+ 		(152 159 shortConditionalJump)
+ 		(160 167 longUnconditionalJump)
+ 		(168 171 longJumpIfTrue)
+ 		(172 175 longJumpIfFalse)
+ 
+ 		"176-191 were sendArithmeticSelectorBytecode"
+ 		(176 bytecodePrimAdd)
+ 		(177 bytecodePrimSubtract)
+ 		(178 bytecodePrimLessThan)
+ 		(179 bytecodePrimGreaterThan)
+ 		(180 bytecodePrimLessOrEqual)
+ 		(181 bytecodePrimGreaterOrEqual)
+ 		(182 bytecodePrimEqual)
+ 		(183 bytecodePrimNotEqual)
+ 		(184 bytecodePrimMultiply)
+ 		(185 bytecodePrimDivide)
+ 		(186 bytecodePrimMod)
+ 		(187 bytecodePrimMakePoint)
+ 		(188 bytecodePrimBitShift)
+ 		(189 bytecodePrimDiv)
+ 		(190 bytecodePrimBitAnd)
+ 		(191 bytecodePrimBitOr)	
+ 
+ 		"192-207 were sendCommonSelectorBytecode"
+ 		(192 bytecodePrimAt)
+ 		(193 bytecodePrimAtPut)
+ 		(194 bytecodePrimSize)
+ 		(195 bytecodePrimNext)
+ 		(196 bytecodePrimNextPut)
+ 		(197 bytecodePrimAtEnd)
+ 		(198 bytecodePrimEquivalent)
+ 		(199 bytecodePrimClass)
+ 		(200 bytecodePrimBlockCopy)
+ 		(201 bytecodePrimValue)
+ 		(202 bytecodePrimValueWithArg)
+ 		(203 bytecodePrimDo)
+ 		(204 bytecodePrimNew)
+ 		(205 bytecodePrimNewWithArg)
+ 		(206 bytecodePrimPointX)
+ 		(207 bytecodePrimPointY)
+ 
+ 		(208 223 sendLiteralSelector0ArgsBytecode)
+ 		(224 239 sendLiteralSelector1ArgBytecode)
+ 		(240 255 sendLiteralSelector2ArgsBytecode)
+ 	)!

Item was changed:
  ----- Method: StackInterpreter class>>mustBeGlobal: (in category 'translation') -----
  mustBeGlobal: var
  	"Answer if a variable must be global and exported.  Used for inst vars that are accessed from VM support code."
  
  	^(self objectMemoryClass mustBeGlobal: var)
+ 	   or: [(#('interpreterProxy' 'interpreterVersion' 'inIOProcessEvents'
- 	   or: [#('interpreterProxy' 'interpreterVersion' 'inIOProcessEvents'
  			'deferDisplayUpdates' 'extraVMMemory' 'showSurfaceFn'
  			'desiredNumStackPages' 'desiredEdenBytes'
  			'breakSelector' 'breakSelectorLength' 'sendTrace'
+ 			'suppressHeartbeatFlag') includes: var)
+ 	   or: [ "This allows slow machines to define bytecodeSetSelector as 0
+ 			to avoid the interpretation overhead."
+ 			MULTIPLEBYTECODESETS not and: [var = 'bytecodeSetSelector']]]!
- 			'suppressHeartbeatFlag') includes: var]!

Item was changed:
  ----- Method: StackInterpreter>>interpret (in category 'interpreter shell') -----
  interpret
  	"This is the main interpreter loop. It normally loops forever, fetching and executing bytecodes. When running in the context of a browser plugin VM, however, it must return control to the browser periodically. This should done only when the state of the currently running Squeak thread is safely stored in the object heap. Since this is the case at the moment that a check for interrupts is performed, that is when we return to the browser if it is time to do so. Interrupt checks happen quite frequently."
  
  	<inline: false>
  	"If stacklimit is zero then the stack pages have not been initialized."
  	stackLimit = 0 ifTrue:
  		[^self initStackPagesAndInterpret].
  	"record entry time when running as a browser plug-in"
  	self browserPluginInitialiseIfNeeded.
  	self internalizeIPandSP.
  	self fetchNextBytecode.
+ 	[true] whileTrue: [self dispatchOn: currentBytecode + bytecodeSetSelector in: BytecodeTable].
- 	[true] whileTrue: [self dispatchOn: currentBytecode in: BytecodeTable].
  	localIP := localIP - 1.  "undo the pre-increment of IP before returning"
  	self externalizeIPandSP.
  	^nil
  !

Item was added:
+ ----- Method: StackInterpreter>>methodUsesAlternateBytecodeSet: (in category 'internal interpreter access') -----
+ methodUsesAlternateBytecodeSet: aMethodObj
+ 	<api>
+ 	<inline: true>
+ 	"A negative header selects the alternate bytecode set."
+ 	^(objectMemory integerValueOf: (self headerOf: aMethodObj)) < 0!

Item was changed:
  ----- Method: StackInterpreter>>setMethod: (in category 'internal interpreter access') -----
  setMethod: aMethodObj
+ 	"Set the method and determine the bytecode set based on the method header's sign.
+ 	 If MULTIPLEBYTECODESETS then a negative header selects the alternate bytecode set.
+ 	 Conditionalizing the code on MULTIPLEBYTECODESETS allows the header sign bit to be
+ 	 used for other experiments."
+ 	<inline: true>
+ 	method := aMethodObj.
+ 	self cppIf: MULTIPLEBYTECODESETS
+ 		ifTrue:
+ 			[bytecodeSetSelector := (self methodUsesAlternateBytecodeSet: method)
+ 										ifTrue: [256]
+ 										ifFalse: [0]]!
- 	method := aMethodObj!

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 rightByte prevCtxt |
  	logFile := (FileStream readOnlyFileNamed: fileName) binary.
  	transcript clear.
  	byteCount := 0.
  	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:
- 			[rightByte := logFile next.
- 			 currentBytecode = rightByte ifFalse:
  				[self halt: 'halt at ', byteCount printString]].
+ 		self dispatchOn: currentBytecode + bytecodeSetSelector in: BytecodeTable.
- 		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].
  	self initStackPages.
  	self loadInitialContext.
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	[byteCount < nBytes] whileTrue:
  		[byteCount >= loggingStart ifTrue:
+ 			[logFile nextWordPut: currentBytecode + bytecodeSetSelector].
+ 		self dispatchOn: currentBytecode + bytecodeSetSelector in: BytecodeTable.
- 			[logFile nextPut: 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].
  	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 + bytecodeSetSelector in: BytecodeTable.
- 		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].
  	self initStackPages.
  	self loadInitialContext.
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	[sendCount < nSends] whileTrue:
+ 		[self dispatchOn: currentBytecode + bytecodeSetSelector in: BytecodeTable.
- 		[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>>printCurrentBytecodeOn: (in category 'debug printing') -----
  printCurrentBytecodeOn: aStream
  	| code |
  	code := currentBytecode radix: 16.
+ 	aStream ensureCr; print: localIP - method - 3; tab.
+ 	bytecodeSetSelector > 0 ifTrue:
+ 		[aStream nextPutAll: 'ALT '].
+ 	aStream
- 	aStream print: localIP - method - 3;
- 		tab;
  		nextPut: (code size < 2
  					ifTrue: [$0]
  					ifFalse: [code at: 1]);
  		nextPut: code last; space;
+ 		nextPutAll: (BytecodeTable at: currentBytecode + bytecodeSetSelector + 1);
- 		nextPutAll: (BytecodeTable at: currentBytecode + 1);
  		space;
  		nextPut: $(; print: byteCount + 1; nextPut: $)!

Item was changed:
  ----- Method: StackInterpreterSimulator>>run (in category 'testing') -----
  run
  	"Just run"
  	quitBlock := [([transcript dependents anyOne outermostMorphThat: [:m| m isSystemWindow]]
  					on: Error
  					do: [:ex| nil])
  						ifNotNil: [:window| (UIManager default confirm: 'close?') ifTrue: [window delete]].
  				  ^self].
  	self initStackPages.
  	self loadInitialContext.
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	[true] whileTrue:
  		[self assertValidExecutionPointers.
  		 atEachStepBlock value. "N.B. may be nil"
+ 		 self dispatchOn: currentBytecode + bytecodeSetSelector in: BytecodeTable.
- 		 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>>runAtEachStep: (in category 'testing') -----
  runAtEachStep: aBlock
  	self initStackPages.
  	self loadInitialContext.
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	[true] whileTrue:
  		[self assertValidExecutionPointers.
  		 aBlock value: currentBytecode.
+ 		 self dispatchOn: currentBytecode + bytecodeSetSelector in: BytecodeTable.
- 		 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>>runAtEachStep:breakCount: (in category 'testing') -----
  runAtEachStep: aBlock breakCount: breakCount
  	self initStackPages.
  	self loadInitialContext.
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	[true] whileTrue:
  		[self assertValidExecutionPointers.
  		 aBlock value: currentBytecode.
+ 		 self dispatchOn: currentBytecode + bytecodeSetSelector in: BytecodeTable.
- 		 self dispatchOn: currentBytecode in: BytecodeTable.
  		 self incrementByteCount.
  		 byteCount = breakCount ifTrue:
  			[self halt]].
  	localIP := localIP - 1.
  	"undo the pre-increment of IP before returning"
  	self externalizeIPandSP!

Item was changed:
  ----- Method: StackInterpreterSimulator>>runForNBytes: (in category 'testing') -----
  runForNBytes: nBytecodes 
  	"Do nByteCodes more bytecode dispatches.
  	Keep byteCount up to date.
  	This can be run repeatedly."
  	| endCount |
  	self initStackPages.
  	self loadInitialContext.
  	endCount := byteCount + nBytecodes.
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	[byteCount < endCount] whileTrue:
+ 		[self dispatchOn: currentBytecode + bytecodeSetSelector in: BytecodeTable.
- 		[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 notNil
  				   and: [UIManager default confirm: 'close?']) ifTrue:
  					[(displayView outermostMorphThat: [:m| m isSystemWindow]) ifNotNil:
  						[:topWindow| topWindow delete]].
  				  ^self].
  	breakCount := theBreakCount.
  	self initStackPages.
  	self loadInitialContext.
  	self internalizeIPandSP.
  	self fetchNextBytecode.
  	[true] whileTrue:
  		[self assertValidExecutionPointers.
+ 		 self dispatchOn: currentBytecode + bytecodeSetSelector in: BytecodeTable.
- 		 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].
  	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 + bytecodeSetSelector in: BytecodeTable.
- 		 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].
  	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 + bytecodeSetSelector in: BytecodeTable.
- 		 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].
  	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 + bytecodeSetSelector in: BytecodeTable.
- 		 self dispatchOn: currentBytecode in: BytecodeTable.
  		 self incrementByteCount.
  		 byteCount = breakCount ifTrue:
  			["printFrameAtEachStep :=" printBytecodeAtEachStep := true.
  			 self halt: 'hit breakCount break-point']].
  	self externalizeIPandSP!

Item was changed:
  SharedPool subclass: #VMBasicConstants
  	instanceVariableNames: ''
+ 	classVariableNames: 'BaseHeaderSize Byte0Mask Byte0Shift Byte1Mask Byte1Shift Byte1ShiftNegated Byte2Mask Byte2Shift Byte3Mask Byte3Shift Byte3ShiftNegated Byte4Mask Byte4Shift Byte4ShiftNegated Byte5Mask Byte5Shift Byte5ShiftNegated Byte6Mask Byte6Shift Byte7Mask Byte7Shift Byte7ShiftNegated Bytes3to0Mask Bytes7to4Mask BytesPerOop BytesPerWord COGMTVM COGVM DisownVMLockOutFullGC DoAssertionChecks DoExpensiveAssertionChecks GCModeBecome GCModeFull GCModeIncr IMMUTABILITY MULTIPLEBYTECODESETS NewspeakVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrGenericFailure PrimErrInappropriate PrimErrLimitExceeded PrimErrNamedInternal PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrObjectMayMove PrimErrUnsupported PrimNoErr STACKVM ShiftForWord VMBIGENDIAN'
- 	classVariableNames: 'BaseHeaderSize Byte0Mask Byte0Shift Byte1Mask Byte1Shift Byte1ShiftNegated Byte2Mask Byte2Shift Byte3Mask Byte3Shift Byte3ShiftNegated Byte4Mask Byte4Shift Byte4ShiftNegated Byte5Mask Byte5Shift Byte5ShiftNegated Byte6Mask Byte6Shift Byte7Mask Byte7Shift Byte7ShiftNegated Bytes3to0Mask Bytes7to4Mask BytesPerOop BytesPerWord COGMTVM COGVM DisownVMLockOutFullGC DoAssertionChecks DoExpensiveAssertionChecks GCModeBecome GCModeFull GCModeIncr IMMUTABILITY NewspeakVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrGenericFailure PrimErrInappropriate PrimErrLimitExceeded PrimErrNamedInternal PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrObjectMayMove PrimErrUnsupported PrimNoErr STACKVM ShiftForWord VMBIGENDIAN'
  	poolDictionaries: ''
  	category: 'VMMaker-Interpreter'!
  
  !VMBasicConstants commentStamp: '<historical>' prior: 0!
  I am a shared pool for basic constants upon which the VM as a whole depends.
  
  self ensureClassPool.
  self classPool declare: #BytesPerWord from: VMSqueakV3ObjectRepresentationConstants classPool.
  self classPool declare: #BaseHeaderSize from: VMSqueakV3ObjectRepresentationConstants classPool
  (ObjectMemory classPool keys select: [:k| k beginsWith: 'Byte']) do:
  	[:k| self classPool declare: k from: ObjectMemory classPool]!

Item was changed:
  ----- Method: VMClass class>>initializeMiscConstantsWith: (in category 'initialization') -----
  initializeMiscConstantsWith: optionsDictionary
  	"Falsify the `what type of VM is this?' flags that are defined in the various interp.h files,
  	 or in the case of VMBIGENDIAN the various sqConfig.h files.
  	 Subclass implementations need to include a super initializeMiscConstantsWith:."
  
  	VMBIGENDIAN class. "Mention this for the benefit of CCodeGenerator>>emitCConstantsOn:"
  	STACKVM := COGVM := COGMTVM := false.
+ 	IMMUTABILITY := NewspeakVM := false.
+ 	MULTIPLEBYTECODESETS := false!
- 	IMMUTABILITY := NewspeakVM := false!



More information about the Vm-dev mailing list