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

commits at source.squeak.org commits at source.squeak.org
Sun Feb 20 01:19:43 UTC 2022


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

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

Name: VMMaker.oscog-eem.3161
Author: eem
Time: 19 February 2022, 5:19:34.554129 pm
UUID: 44c0ec9b-cfdf-48f0-8671-3b901756a959
Ancestors: VMMaker.oscog-eem.3160

Spur CoInterpreter: use primitiveMetadataTable in CoInterpreter and primitiveAccessorDepthTable in StackInterpreter.  There's no need to waste the space in the StackInterpreter and its easier to read the depths from the depth table in interp.c than decode the depth+metadata table in cointerp.c.

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

Item was changed:
  StackInterpreterPrimitives subclass: #CoInterpreter
+ 	instanceVariableNames: 'cogit cogMethodZone gcMode cogCodeSize desiredCogCodeSize heapBase primitiveMetadataTable lastCoggableInterpretedBlockMethod deferSmash deferredSmash primTraceLog primTraceLogIndex traceLog traceLogIndex traceSources cogCompiledCodeCompactionCalledFor statCodeCompactionCount statCodeCompactionUsecs lastUncoggableInterpretedBlockMethod flagInterpretedMethods maxLiteralCountForCompile minBackwardJumpCountForCompile CFramePointer CStackPointer CReturnAddress primTracePluginName primCalloutIsExternal'
- 	instanceVariableNames: 'cogit cogMethodZone gcMode cogCodeSize desiredCogCodeSize heapBase lastCoggableInterpretedBlockMethod deferSmash deferredSmash primTraceLog primTraceLogIndex traceLog traceLogIndex traceSources cogCompiledCodeCompactionCalledFor statCodeCompactionCount statCodeCompactionUsecs lastUncoggableInterpretedBlockMethod flagInterpretedMethods maxLiteralCountForCompile minBackwardJumpCountForCompile CFramePointer CStackPointer CReturnAddress primTracePluginName primCalloutIsExternal'
  	classVariableNames: 'CSCallbackEnter CSCallbackLeave CSCheckEvents CSEnterCriticalSection CSExitCriticalSection CSOwnVM CSResume CSSignal CSSuspend CSSwitchIfNeccessary CSThreadBind CSThreadSchedulingLoop CSWait CSYield HasBeenReturnedFromMCPC HasBeenReturnedFromMCPCOop MFMethodFlagFrameIsMarkedFlag MinBackwardJumpCountForCompile PrimTraceLogSize RumpCStackSize TraceBlockActivation TraceBlockCreation TraceBufferSize TraceCodeCompaction TraceContextSwitch TraceDisownVM TraceFullGC TraceIncrementalGC TraceIsFromInterpreter TraceIsFromMachineCode TraceOwnVM TracePreemptDisowningThread TracePrimitiveFailure TracePrimitiveRetry TraceSources TraceStackOverflow TraceThreadSwitch TraceVMCallback TraceVMCallbackReturn'
  	poolDictionaries: 'CogMethodConstants VMStackFrameOffsets'
  	category: 'VMMaker-JIT'!
  
  !CoInterpreter commentStamp: 'eem 3/31/2020 18:56' prior: 0!
  I am a variant of the StackInterpreter that can co-exist with the Cog JIT.  I interpret unjitted methods, either because they have been found for the first time or because they are judged to be too big to JIT.  See CogMethod class's comment for method interoperability.
  
  cogCodeSize
  	- the current size of the machine code zone
  
  cogCompiledCodeCompactionCalledFor
  	- a variable set when the machine code zone runs out of space, causing a machine code zone compaction at the next available opportunity
  
  cogMethodZone
  	- the manager for the machine code zone (instance of CogMethodZone)
  
  cogit
  	- the JIT (co-jit) (instance of SimpleStackBasedCogit, StackToRegisterMappoingCogit, etc)
  
  deferSmash
  	- a flag causing deferral of smashes of the stackLimit around the call of functionSymbol (for assert checks)
  
  deferredSmash
  	- a flag noting deferral of smashes of the stackLimit around the call of functionSymbol (for assert checks)
  
  desiredCogCodeSize
  	- the desred size of the machine code zone, set at startup or via primitiveVMParameter to be written at snapshot time
  
  flagInterpretedMethods
  	- true if methods that are interpreted shoudl have their flag bit set (used to identity methods that are interpreted because they're unjittable for some reason)
  
  gcMode
  	- the variable holding the gcMode, used to inform the cogit of how to scan the machine code zone for oops on GC
  
  heapBase
  	- the address in memory of the base of the objectMemory's heap, which is immediately above the machine code zone
  
  lastCoggableInterpretedBlockMethod
  	- a variable used to invoke the cogit for a block mehtod being invoked repeatedly in the interpreter
  
  lastUncoggableInterpretedBlockMethod
  	- a variable used to avoid invoking the cogit for an unjittable method encountered on block evaluation
  
  maxLiteralCountForCompile
  	- the variable controlling which methods to jit.  methods with a literal count above this value will not be jitted (on the grounds that large methods are typically used for initialization, and take up a lot of space in the code zone)
  
  minBackwardJumpCountForCompile
  	- the variable controlling when to attempt to jit a method being interpreted.  If as many backward jumps as this occur, the current method will be jitted
  
  primTraceLog
  	- a small array implementing a crcular buffer logging the last N primitive invocations, GCs, code compactions, etc used for crash reporting
  
  primTraceLogIndex
  	- the index into primTraceLog of the next entry
  
  reenterInterpreter
  	- the jmpbuf used to jmp back into the interpreter when transitioning from machine code to the interpreter
  
  statCodeCompactionCount
  	- the count of machine code zone compactions
  
  statCodeCompactionUsecs
  	- the total microseconds spent in machine code zone compactions
  
  traceLog
  	- a log of various events, used in debugging
  
  traceLogIndex
  	- the index into traceLog of the next entry
  
  traceSources
  	- the names associated with the codes of events in traceLog
  
  CFramePointer
  	- if in use, the value of the C frame pointer on most recent entry to the interpreter after start-up or a callback.  Used to establish the C stack when calling the run-time from generated machine code.
  
  CStackPointer
  	- the value of the C stack pointer on most recent entry to the interpreter after start-up or a callback.  Used to establish the C stack when calling the run-time from generated machine code.
  
  CReturnAddress
  	- the return address for the function call which invoked the interpreter at start-up.  Using this as teh return address when entering the interpreter via ceInvokeInterpeter maintains a valid stack.  Since this is effevtively a constant it does not need to be saved and restored once set.!

Item was changed:
  ----- Method: CoInterpreter class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	"Override to avoid repeating StackInterpreter's declarations and add our own extensions"
  	self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses"
  	aCCodeGenerator
  		addHeaderFile:'"sqCogStackAlignment.h"';
  		addHeaderFile:'"cogmethod.h"'.
  	NewspeakVM ifTrue:
  		[aCCodeGenerator addHeaderFile:'"nssendcache.h"'].
  	aCCodeGenerator
  		addHeaderFile: (aCCodeGenerator vmClass isThreadedVM 
  			ifTrue: ['"cointerpmt.h"'] 
  			ifFalse: ['"cointerp.h"']);
  		addHeaderFile:'"cogit.h"'.
  	aCCodeGenerator vmClass
  		declareInterpreterVersionIn: aCCodeGenerator
  		defaultName: aCCodeGenerator interpreterVersion.
  	aCCodeGenerator
  		var: #cogCodeSize type: #usqInt;
  		var: #heapBase type: #usqInt;
  		var: #statCodeCompactionUsecs type: #usqLong;
  		var: #maxLiteralCountForCompile
  			declareC: 'sqInt maxLiteralCountForCompile = MaxLiteralCountForCompile /* ', MaxLiteralCountForCompile printString, ' */';
  		var: #minBackwardJumpCountForCompile
  			declareC: 'sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* ', MinBackwardJumpCountForCompile printString, ' */'.
  	aCCodeGenerator
  		removeVariable: 'atCache'; "Way too much trouble than it's worth in the Cog VM"
  		removeVariable: 'reenterInterpreter'. "We can use the JIT and CFrame/StrackPointer for a lighter-weight solution."
+ 	aCCodeGenerator removeVariable: #primitiveAccessorDepthTable.
+ 	aCCodeGenerator vmClass objectMemoryClass hasSpurMemoryManagerAPI
+ 		ifTrue:
+ 			[aCCodeGenerator
+ 				var: #primitiveMetadataTable
+ 				type: 'signed short'
+ 				sizeString: 'MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */'
+ 				array: (aCCodeGenerator vmClass primitiveMetadataTableUsing: aCCodeGenerator)]
+ 		ifFalse:
+ 			[aCCodeGenerator removeVariable: #primitiveMetadataTable].
  	aCCodeGenerator
  		var: #primTraceLogIndex type: #'unsigned char';
  		var: #primTraceLog declareC: 'sqInt primTraceLog[256]';
  		var: #traceLog
  		declareC: 'sqInt traceLog[TraceBufferSize /* ', TraceBufferSize printString, ' */]';
  		var: 'primTracePluginName' type: #'char *';
  		var: #traceSources type: #'char *' array: TraceSources.
  	aCCodeGenerator
  		var: #CFramePointer type: #'volatile usqIntptr_t';
  		var: #CStackPointer type: #'volatile usqIntptr_t';
  		var: #CReturnAddress type: #'volatile usqIntptr_t'!

Item was added:
+ ----- Method: CoInterpreter class>>primitiveMetadataTableUsing: (in category 'constants') -----
+ primitiveMetadataTableUsing: aCCodeGenerator
+ 	^self primitiveTable collect:
+ 		[:thing| | implementingClass tMethod |
+ 		(thing isInteger "quick prims, 0 for fast primitve fail"
+ 		 or: [thing == #primitiveFail
+ 		 or: [(implementingClass := self primitivesClass whichClassIncludesSelector: thing) isNil]])
+ 			ifTrue: [-1 << SpurPrimitiveAccessorDepthShift]
+ 			ifFalse:
+ 				[tMethod := (aCCodeGenerator methodNamed: thing) ifNil:
+ 								[aCCodeGenerator compileToTMethodSelector: thing in: implementingClass].
+ 				 (aCCodeGenerator accessorDepthForMethod: tMethod) << SpurPrimitiveAccessorDepthShift
+ 				+ (self metadataFlagsForPrimitive: tMethod)]]!

Item was added:
+ ----- Method: CoInterpreter>>accessorDepthForPrimitiveIndex: (in category 'cog jit support') -----
+ accessorDepthForPrimitiveIndex: primIndex
+ 	<api>
+ 	<option: #SpurObjectMemory>
+ 	^(primitiveMetadataTable at: primIndex) >>> SpurPrimitiveAccessorDepthShift!

Item was added:
+ ----- Method: CoInterpreter>>computeAccessorDepthsForInterpreterPrimitives (in category 'primitive support') -----
+ computeAccessorDepthsForInterpreterPrimitives
+ 	<doNotGenerate>
+ 	| cg |
+ 	cg := self codeGeneratorToComputeAccessorDepth.
+ 	primitiveMetadataTable ifNil:
+ 		[primitiveMetadataTable := Array new: primitiveTable size withAll: (-1 bitShift: SpurPrimitiveAccessorDepthShift)].		
+ 	primitiveTable withIndexDo:
+ 		[:prim :index| | depthAndFlags |
+ 		 prim isSymbol ifTrue:
+ 			[depthAndFlags := self metadataFlagsFor: prim using: cg.
+ 			 self assert: depthAndFlags isInteger.
+ 			 primitiveMetadataTable at: index - 1 put: depthAndFlags]].
+ 	^cg!

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

Item was changed:
  ----- Method: StackInterpreter class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	| vmClass |
  	self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses"
  	vmClass := aCCodeGenerator vmClass. "Generate primitiveTable etc based on vmClass, not just StackInterpreter"
  	aCCodeGenerator
  		addHeaderFile: '<stdio.h> /* for printf */';
  		addHeaderFile: '<stdlib.h> /* for e.g. alloca */';
  		addHeaderFile: '<setjmp.h>';
  		addHeaderFile: '<wchar.h> /* for wint_t */';
  		addHeaderFile: '"vmCallback.h"';
  		addHeaderFile: '"sqMemoryFence.h"';
  		addHeaderFile: '"sqImageFileAccess.h"';
  		addHeaderFile: '"sqSetjmpShim.h"';
  		addHeaderFile: '"dispdbg.h"'.
  	LowcodeVM ifTrue:
  		[aCCodeGenerator addHeaderFile: '"sqLowcodeFFI.h"'].
  
  	vmClass declareInterpreterVersionIn: aCCodeGenerator defaultName: 'Stack'.
  	aCCodeGenerator
  		var: #interpreterProxy  type: #'struct VirtualMachine*'.
  	aCCodeGenerator
  		declareVar: #sendTrace type: 'volatile int';
  		declareVar: #byteCount type: #usqLong. "see dispdbg.h"
  	"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 breakSelector)
  		as: #'char *'
  		in: aCCodeGenerator.
  	aCCodeGenerator
  		var: #breakSelectorLength
  		declareC: 'sqInt breakSelectorLength = MinSmallInteger'.
  	self declareC: #(stackPage overflowedPage)
  		as: #'StackPage *'
  		in: aCCodeGenerator.
  	aCCodeGenerator
  		var: #transcript type: #'FILE *'.
  	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 == false ifTrue:
  		[aCCodeGenerator
  			removeVariable: 'bytecodeSetSelector'].
  	BytecodeSetHasExtensions == false ifTrue:
  		[aCCodeGenerator
  			removeVariable: 'extA';
  			removeVariable: 'extB'].
  	aCCodeGenerator
  		var: #methodCache
  		declareC: 'sqIntptr_t methodCache[MethodCacheSize + 1 /* ', (MethodCacheSize + 1) printString, ' */]'.
  	NewspeakVM
  		ifTrue:
  			[aCCodeGenerator
  				var: #nsMethodCache
  				declareC: 'sqIntptr_t nsMethodCache[NSMethodCacheSize + 1 /* ', (NSMethodCacheSize + 1) printString, ' */]']
  		ifFalse:
  			[aCCodeGenerator
  				removeVariable: #nsMethodCache;
  				removeVariable: 'localAbsentReceiver';
  				removeVariable: 'localAbsentReceiverOrZero'].
  	AtCacheTotalSize isInteger ifTrue:
  		[aCCodeGenerator
  			var: #atCache
  			declareC: 'sqInt atCache[AtCacheTotalSize + 1 /* ', (AtCacheTotalSize + 1) printString, ' */]'].
  	aCCodeGenerator
  		var: #primitiveTable
  		declareC: 'void (*primitiveTable[MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */])(void) = ', vmClass primitiveTableString.
  	vmClass primitiveTable do:
  		[:symbolOrNot|
  		(symbolOrNot isSymbol
  		 and: [symbolOrNot ~~ #primitiveFail]) ifTrue:
  			[(aCCodeGenerator methodNamed: symbolOrNot) ifNotNil:
  				[:tMethod| tMethod returnType: #void]]].
  
  	vmClass objectMemoryClass hasSpurMemoryManagerAPI
  		ifTrue:
  			[aCCodeGenerator
+ 				var: #primitiveAccessorDepthTable
+ 				type: #char
- 				var: #primitiveMetadataTable
- 				type: 'signed short'
  				sizeString: 'MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */'
+ 				array: (vmClass primitiveAccessorDepthTableUsing: aCCodeGenerator).
- 				array: (vmClass primitiveMetadataTableUsing: aCCodeGenerator).
  			 aCCodeGenerator
  				removeConstant: #PrimNumberInstVarAt;
  				removeConstant: #PrimNumberPerform;
  				removeConstant: # PrimNumberPerformWithArgs;
  				removeConstant: #PrimNumberShallowCopy;
  				removeConstant: #PrimNumberSlotAt;
  				removeConstant: #PrimNumberFlushExternalPrimitives;
  				removeConstant: #PrimNumberUnloadModule]
  		ifFalse:
  			[aCCodeGenerator
+ 				removeVariable: #primitiveAccessorDepthTable;
- 				removeVariable: #primitiveMetadataTable;
  				removeConstant: #PrimNumberVMParameter].
  
  	aCCodeGenerator
  		var: #displayBits type: #'void *';
  		var: #primitiveCalloutPointer declareC: 'void *primitiveCalloutPointer = (void *)-1'.
  	self declareC: #(displayWidth displayHeight displayDepth) as: #int in: aCCodeGenerator.
  	aCCodeGenerator
  		var: #primitiveFunctionPointer
  			declareC: 'void (*primitiveFunctionPointer)()';
  			var: 'pcPreviousToFunction'
  				declareC: 'sqInt (* const pcPreviousToFunction)(sqInt,sqInt) = ', (aCCodeGenerator cFunctionNameFor: PCPreviousToFunction);
  		var: #externalPrimitiveTable
  			declareC: 'void (*externalPrimitiveTable[MaxExternalPrimitiveTableSize + 1 /* ', (MaxExternalPrimitiveTableSize + 1) printString, ' */])(void)';
  		var: #interruptCheckChain
  			declareC: 'void (*interruptCheckChain)(void) = 0';
  		var: #showSurfaceFn
  			declareC: 'int (*showSurfaceFn)(sqIntptr_t, int, int, int, int)'.
  
  	self declareCAsUSqLong: #(nextPollUsecs nextWakeupUsecs
  								"these are high-frequency enough that they're overflowing quite quickly on modern hardware"
  								statProcessSwitch statIOProcessEvents statForceInterruptCheck
  								statCheckForEvents statStackOverflow statStackPageDivorce
  								statIdleUsecs)
  		in: aCCodeGenerator.
  	aCCodeGenerator var: #nextProfileTick type: #sqLong.
  	aCCodeGenerator var: #reenterInterpreter type: 'jmp_buf'.
  	LowcodeVM
  		ifTrue:
  			[aCCodeGenerator
  				var: #lowcodeCalloutState type: #'sqLowcodeCalloutState*'.
  			 self declareC: #(nativeSP nativeStackPointer shadowCallStackPointer)
  				as: #'char *'
  				in: aCCodeGenerator]
  		ifFalse:
  			[#(lowcodeCalloutState nativeSP nativeStackPointer shadowCallStackPointer) do:
  				[:var| aCCodeGenerator removeVariable: var]].
  	(self instVarNames select: [:ivn| ivn beginsWith: 'longRunningPrimitive']) do:
  		[:lrpmVar|
  		aCCodeGenerator
  			var: lrpmVar
  			declareC: '#if LRPCheck\', ((lrpmVar endsWith: 'Usecs') ifTrue: [#usqLong] ifFalse: [#sqInt]), ' ', lrpmVar, '\#endif']!

Item was added:
+ ----- Method: StackInterpreter class>>primitiveAccessorDepthTableUsing: (in category 'constants') -----
+ primitiveAccessorDepthTableUsing: aCCodeGenerator
+ 	^self primitiveTable collect:
+ 		[:thing| | implementingClass |
+ 		(thing isInteger "quick prims, 0 for fast primitve fail"
+ 		 or: [thing == #primitiveFail
+ 		 or: [(implementingClass := self primitivesClass whichClassIncludesSelector: thing) isNil]])
+ 			ifTrue: [-1]
+ 			ifFalse:
+ 				[aCCodeGenerator accessorDepthForMethod:
+ 					((aCCodeGenerator methodNamed: thing) ifNil:
+ 						[aCCodeGenerator compileToTMethodSelector: thing in: implementingClass])]]!

Item was removed:
- ----- Method: StackInterpreter class>>primitiveMetadataDepthTable (in category 'constants') -----
- primitiveMetadataDepthTable
- 	| cg |
- 	cg := CCodeGenerator new.
- 	cg vmClass: StackInterpreter.
- 	^self primitiveMetadataTableUsing: cg!

Item was removed:
- ----- Method: StackInterpreter class>>primitiveMetadataTableUsing: (in category 'constants') -----
- primitiveMetadataTableUsing: aCCodeGenerator
- 	^self primitiveTable collect:
- 		[:thing| | implementingClass tMethod |
- 		(thing isInteger "quick prims, 0 for fast primitve fail"
- 		 or: [thing == #primitiveFail
- 		 or: [(implementingClass := self primitivesClass whichClassIncludesSelector: thing) isNil]])
- 			ifTrue: [-1 << SpurPrimitiveAccessorDepthShift]
- 			ifFalse:
- 				[tMethod := (aCCodeGenerator methodNamed: thing) ifNil:
- 								[aCCodeGenerator compileToTMethodSelector: thing in: implementingClass].
- 				 (aCCodeGenerator accessorDepthForMethod: tMethod) << SpurPrimitiveAccessorDepthShift
- 				+ (self metadataFlagsForPrimitive: tMethod)]]!

Item was changed:
  ----- Method: StackInterpreter>>accessorDepthForPrimitiveIndex: (in category 'cog jit support') -----
  accessorDepthForPrimitiveIndex: primIndex
- 	<api>
  	<option: #SpurObjectMemory>
+ 	<inline: #always>
+ 	^primitiveAccessorDepthTable at: primIndex!
- 	^(primitiveMetadataTable at: primIndex) >>> SpurPrimitiveAccessorDepthShift!

Item was changed:
  ----- Method: StackInterpreter>>computeAccessorDepthsForInterpreterPrimitives (in category 'primitive support') -----
  computeAccessorDepthsForInterpreterPrimitives
  	<doNotGenerate>
  	| cg |
  	cg := self codeGeneratorToComputeAccessorDepth.
+ 	primitiveAccessorDepthTable ifNil:
+ 		[primitiveAccessorDepthTable := Array new: primitiveTable size withAll: -1].		
- 	primitiveMetadataTable ifNil:
- 		[primitiveMetadataTable := Array new: primitiveTable size withAll: (-1 bitShift: SpurPrimitiveAccessorDepthShift)].		
  	primitiveTable withIndexDo:
+ 		[:prim :index| 
- 		[:prim :index| | depthAndFlags |
  		 prim isSymbol ifTrue:
+ 			[primitiveAccessorDepthTable at: index - 1 put: ((cg accessorDepthForSelector: prim) ifNil: [0])]].
- 			[depthAndFlags := self metadataFlagsFor: prim using: cg.
- 			 self assert: depthAndFlags isInteger.
- 			 primitiveMetadataTable at: index - 1 put: depthAndFlags]].
  	^cg!

Item was changed:
  ----- Method: StackInterpreterSimulator>>initializePluginEntries (in category 'plugin support') -----
  initializePluginEntries
  	mappedPluginEntries := OrderedCollection new.
  	objectMemory hasSpurMemoryManagerAPI
  		ifTrue:
+ 			[primitiveAccessorDepthTable := Array new: primitiveTable size withAll: -1.
- 			[primitiveMetadataTable := Array new: primitiveTable size withAll: (-1 bitShift: SpurPrimitiveAccessorDepthShift).
  			 pluginList := {}.
  			 self loadNewPlugin: '']
  		ifFalse:
  			[pluginList := {'' -> self }]!



More information about the Vm-dev mailing list