[Vm-dev] VM Maker: VMMaker.oscog-mt.3184.mcz

commits at source.squeak.org commits at source.squeak.org
Tue May 10 08:07:37 UTC 2022


Marcel Taeumel uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-mt.3184.mcz

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

Name: VMMaker.oscog-mt.3184
Author: mt
Time: 8 May 2022, 1:03:06.798026 pm
UUID: 57b61827-3f1a-ab45-966e-7c5caaef28d7
Ancestors: VMMaker.oscog-eem.3183

Adds boolean global "cannotDeferDisplayUpdates" that graphics backends can set to let primitive 126 (primitiveDeferDisplayUpdates) fail. It is cleared by default, which is also how C initializes sqInt by default.

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

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

Item was changed:
  ----- Method: Interpreter 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."
  
  	^(super mustBeGlobal: var)
+ 	   or: [ #('deferDisplayUpdates' 'cannotDeferDisplayUpdates' 'extraVMMemory' 'interpreterProxy' 'interpreterVersion' 'showSurfaceFn') includes: var]!
- 	   or: [ #('deferDisplayUpdates' 'extraVMMemory' 'interpreterProxy' 'interpreterVersion' 'showSurfaceFn') includes: var]!

Item was changed:
  ----- Method: Interpreter>>initializeInterpreter: (in category 'initialization') -----
  initializeInterpreter: bytesToShift 
  	"Initialize Interpreter state before starting execution of a new image."
  	interpreterProxy := self sqGetInterpreterProxy.
  	self dummyReferToProxy.
  	self initializeObjectMemory: bytesToShift.
  	self initCompilerHooks.
  	self checkAssumedCompactClasses.
  	metaclassSizeBits := self sizeBitsOf: (self fetchClassOfNonImm: (self splObj: ClassArray)).	"determine actual (Metaclass instSize * 4)"
  	activeContext := nilObj.
  	theHomeContext := nilObj.
  	method := nilObj.
  	receiver := nilObj.
  	messageSelector := nilObj.
  	newMethod := nilObj.
  	lkupClass := nilObj.
  	receiverClass := nilObj.
  	self flushMethodCache.
  	self loadInitialContext.
  	self initialCleanup.
  	interruptCheckCounter := 0.
  	interruptCheckCounterFeedBackReset := 1000.
  	interruptChecksEveryNms := 1.
  	nextProfileTick := 0.
  	profileSemaphore := nilObj.
  	profileProcess := nilObj.
  	profileMethod := nilObj.
  	nextPollTick := 0.
  	nextWakeupTick := 0.
  	lastTick := 0.
  	interruptKeycode := 2094. "cmd-. as used for Mac but no other OS"
  	interruptPending := false.
  	semaphoresUseBufferA := true.
  	semaphoresToSignalCountA := 0.
  	semaphoresToSignalCountB := 0.
+ 	deferDisplayUpdates := cannotDeferDisplayUpdates := false.
- 	deferDisplayUpdates := false.
  	pendingFinalizationSignals := statPendingFinalizationSignals := 0.
  	globalSessionID := 0.
  	[globalSessionID = 0]
  		whileTrue: [globalSessionID := self
  						cCode: 'time(NULL) + ioMSecs()'
  						inSmalltalk: [(Random new next * SmallInteger maxVal) asInteger]].
  	jmpDepth := 0.
  	jmpMax := MaxJumpBuf. "xxxx: Must match the definition of jmpBuf and suspendedCallbacks"
  	statQuickCheckForEvents := 0.
  	statCheckForEvents := 0.
  	statProcessSwitch := 0.
  	statIOProcessEvents := 0
  !

Item was changed:
  ----- Method: Interpreter>>primitiveDeferDisplayUpdates (in category 'I/O primitives') -----
  primitiveDeferDisplayUpdates
  	"Set or clear the flag that controls whether modifications of 
  	the Display object are propagated to the underlying 
  	platform's screen."
  	| flag |
+ 	cannotDeferDisplayUpdates ifTrue: [^self primitiveFail].
  	flag := self stackTop.
  	flag = trueObj
  		ifTrue: [deferDisplayUpdates := true]
  		ifFalse: [flag = falseObj
  				ifTrue: [deferDisplayUpdates := false]
  				ifFalse: [self primitiveFail]].
  	successFlag
  		ifTrue: [self pop: 1]!

Item was added:
+ ----- Method: InterpreterProxy>>getCannotDeferDisplayUpdates (in category 'special objects') -----
+ getCannotDeferDisplayUpdates
+ 	^false!

Item was changed:
  InterpreterPrimitives subclass: #StackInterpreter
(excessive size, no diff calculated)

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,
  	 and for variables that are initialized to some value (e.g. primitiveDoMixedArithmetic)."
  
  	^(super mustBeGlobal: var)
  	   or: [(self objectMemoryClass mustBeGlobal: var)
  	   or: [(#('interpreterProxy' 'interpreterVersion' 'inIOProcessEvents' 'sendWheelEvents'
+ 			'deferDisplayUpdates' 'cannotDeferDisplayUpdates' 'eventTraceMask' 'extraVMMemory'
- 			'deferDisplayUpdates' 'eventTraceMask' 'extraVMMemory'
  			'showSurfaceFn' 'displayBits' 'displayWidth' 'displayHeight' 'displayDepth'
  			'desiredNumStackPages' 'desiredEdenBytes'
  			'primitiveDoMixedArithmetic'
  			'breakLookupClassTag' 'breakSelector' 'breakSelectorLength' 'sendTrace' 'checkAllocFiller' 'checkedPluginName'
  			"'reenterInterpreter'" 'suppressHeartbeatFlag' 'ffiExceptionResponse'
  			'debugCallbackInvokes' 'debugCallbackPath' 'debugCallbackReturns') includes: var)
  	   or: [ "This allows slow machines to define bytecodeSetSelector as 0
  			to avoid the interpretation overhead."
  			MULTIPLEBYTECODESETS not and: [var = 'bytecodeSetSelector']]]]!

Item was added:
+ ----- Method: StackInterpreter>>getCannotDeferDisplayUpdates (in category 'simulation support') -----
+ getCannotDeferDisplayUpdates
+ 	<doNotGenerate>
+ 	^cannotDeferDisplayUpdates!

Item was changed:
  ----- Method: StackInterpreter>>initialize (in category 'initialization') -----
  initialize
  	"Here we can initialize the variables C initializes to zero.  #initialize methods do /not/ get translated."
  	super initialize.
  	primitiveDoMixedArithmetic := true. "whether we authorize primitives to perform mixed arithmetic or not".
  	newFinalization := false.
  	stackLimit := 0. "This is also the initialization flag for the stack system."
  	stackPage := overflowedPage := nil.
  	extraFramesToMoveOnOverflow := 0.
  	bytecodeSetSelector := 0.
  	highestRunnableProcessPriority := 0.
  	nextPollUsecs := 0.
  	nextWakeupUsecs := 0.
  	tempOop := tempOop2 := theUnknownShort := 0.
  	interruptPending := false.
  	inIOProcessEvents := 0.
  	fullScreenFlag := 0.
+ 	sendWheelEvents := deferDisplayUpdates := cannotDeferDisplayUpdates := false.
- 	sendWheelEvents := deferDisplayUpdates := false.
  	displayBits := displayWidth := displayHeight := displayDepth := 0.
  	pendingFinalizationSignals := statPendingFinalizationSignals := 0.
  	globalSessionID := 0.
  	longRunningPrimitiveStartUsecs := longRunningPrimitiveStopUsecs := 0.
  	maxExtSemTabSizeSet := false.
  	debugCallbackInvokes := debugCallbackPath := debugCallbackReturns := 0.
  	primitiveCalloutPointer := -1. "initialized in declaration in declareCVarsIn:"
  	transcript := Transcript. "initialized to stdout in readImageFromFile:HeapSize:StartingAt:"
  	pcPreviousToFunction := PCPreviousToFunction. "initialized via StackInterpreter class>>declareCVarsIn:"
  	statForceInterruptCheck := statStackOverflow := statCheckForEvents :=
  	statProcessSwitch := statIOProcessEvents := statStackPageDivorce :=
  	statIdleUsecs := 0!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveDeferDisplayUpdates (in category 'I/O primitives') -----
  primitiveDeferDisplayUpdates
  	"Set or clear the flag that controls whether modifications of 
  	 the Display object are propagated to the underlying 
  	 platform's screen."
  	| flag |
+ 	cannotDeferDisplayUpdates ifTrue: [^self primitiveFail].
  	flag := self stackTop.
  	flag = objectMemory trueObject
  		ifTrue: [deferDisplayUpdates := true]
  		ifFalse:
  			[flag = objectMemory falseObject
  				ifTrue: [deferDisplayUpdates := false]
  				ifFalse: [^self primitiveFail]].
  	self cCode: [] inSmalltalk: [self fullDisplayUpdate].
  	self pop: 1!



More information about the Vm-dev mailing list