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

commits at source.squeak.org commits at source.squeak.org
Tue Feb 22 18:30:18 UTC 2022


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

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

Name: VMMaker.oscog-eem.3164
Author: eem
Time: 22 February 2022, 10:30:06.259461 am
UUID: 8a3081b3-6faa-47b4-84ed-badb0f3e9cc5
Ancestors: VMMaker.oscog-eem.3163

Rename PrimCallIsExternalPrim to PrimCallIsExternalCall

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

Item was changed:
  ----- Method: CoInterpreter class>>initializeMiscConstants (in category 'initialization') -----
  initializeMiscConstants
  
  	super initializeMiscConstants.
  	COGVM := true.
  
  	MinBackwardJumpCountForCompile := 40.
  
  	MaxNumArgs := 15.
  
  	PrimCallOnSmalltalkStack := 1. "Speed up simple external prims by avoiding stack switch"
  	PrimCallOnSmalltalkStackAlign2x := 2. "Align stack to a 2 x word size boundary, e.g. for MMX instructions etc"
  	PrimCallNeedsNewMethod := 4. "e.g. primitiveExternalCall and primitiveCalloutToFFI extract info from newMethod's first literal"
  	PrimCallMayEndureCodeCompaction := 8. "primitiveExternalCall and primitiveCalloutToFFI may invoke callbacks, hence may experience code compaction."
  	PrimCallCollectsProfileSamples := 16. "tells JIT to compile support for profiling primitives"
+ 	PrimCallIsExternalCall := 32. "Whether a primitive is not included in the VM, but loaded dynamically.
- 	PrimCallIsExternalPrim := 32. "Whether a primitive is not included in the VM, but loaded dynamically.
  									Hence it can only be called through a CallFullRT."
  
  	"Flags for use in primitiveMetadata: in external primitives, overlap with the PrimCallXXX flags above"
  	FastCPrimitiveFlag := 1.				"a.k.a. PrimCallOnSmalltalkStack"
  	FastCPrimitiveAlignForFloatsFlag := 2.	"a.k.a. PrimCallOnSmalltalkStackAlign2x"
  
  	"And to shift away the flags, to compute the accessor depth, use...
  	 c.f. NullSpurMetadata in sq.h"
  	SpurPrimitiveAccessorDepthShift := 8.
  	SpurPrimitiveFlagsMask := 1 << SpurPrimitiveAccessorDepthShift - 1.
  
  	"the primitive trace log; a record of the last 256 named/external primitives or significant events invoked."
  	PrimTraceLogSize := 256. "Room for 256 selectors.  Must be 256 because we use a byte to hold the index"
  	TraceBufferSize := 256 * 3. "Room for 256 events"
  	TraceContextSwitch := self objectMemoryClass basicNew integerObjectOf: 1.
  	TraceBlockActivation := self objectMemoryClass basicNew integerObjectOf: 2.
  	TraceBlockCreation := self objectMemoryClass basicNew integerObjectOf: 3.
  	TraceIncrementalGC := self objectMemoryClass basicNew integerObjectOf: 4.
  	TraceFullGC := self objectMemoryClass basicNew integerObjectOf: 5.
  	TraceCodeCompaction := self objectMemoryClass basicNew integerObjectOf: 6.
  	TraceOwnVM := self objectMemoryClass basicNew integerObjectOf: 7.
  	TraceDisownVM := self objectMemoryClass basicNew integerObjectOf: 8.
  	TraceThreadSwitch := self objectMemoryClass basicNew integerObjectOf: 9.
  	TracePreemptDisowningThread := self objectMemoryClass basicNew integerObjectOf: 10.
  	TraceVMCallback := self objectMemoryClass basicNew integerObjectOf: 11.
  	TraceVMCallbackReturn := self objectMemoryClass basicNew integerObjectOf: 12.
  	TraceStackOverflow := self objectMemoryClass basicNew integerObjectOf: 13.
  	TracePrimitiveFailure := self objectMemoryClass basicNew integerObjectOf: 14.
  	TracePrimitiveRetry := self objectMemoryClass basicNew integerObjectOf: 15.
  
  	TraceIsFromMachineCode := 1.
  	TraceIsFromInterpreter := 2.
  	CSCallbackEnter := 3.
  	CSCallbackLeave := 4.
  	CSEnterCriticalSection := 5.
  	CSExitCriticalSection := 6.
  	CSResume := 7.
  	CSSignal := 8.
  	CSSuspend := 9.
  	CSWait := 10.
  	CSYield := 11.
  	CSCheckEvents := 12.
  	CSThreadSchedulingLoop := 13.
  	CSOwnVM := 14.
  	CSThreadBind := 15.
  	CSSwitchIfNeccessary := 16.
  
  	TraceSources := CArrayAccessor on: #('?' 'm' 'i' 'callbackEnter' 'callbackLeave' 'enterCritical' 'exitCritical' 'resume' 'signal'  'suspend' 'wait' 'yield' 'eventcheck' 'threadsched' 'ownVM' 'bindToThread' 'switchIfNecessary').
  
  	"this is simulation only"
  	RumpCStackSize := 4096!

Item was changed:
  ----- Method: CoInterpreter>>functionPointerForCompiledMethod:primitiveIndex:primitivePropertyFlagsInto: (in category 'cog jit support') -----
  functionPointerForCompiledMethod: methodObj primitiveIndex: primitiveIndex primitivePropertyFlagsInto: flagsPtr
  	<api>
  	<returnTypeC: 'void (*functionPointerForCompiledMethodprimitiveIndexprimitivePropertyFlagsInto(sqInt methodObj, sqInt primitiveIndex, sqInt *flagsPtr))(void)'>
  	<inline: false>
  	| flags |
  	flagsPtr ifNotNil:
  		[flagsPtr at: 0 put: (flags := self primitivePropertyFlags: primitiveIndex numArgs: (self argumentCountOf: methodObj))].
  	primitiveIndex == PrimNumberFFICall ifTrue:
  		[self functionForPrimitiveCallout. "first invocation sets primCalloutIsExternal"
  		 flagsPtr ifNotNil:
  			[primCalloutIsExternal ifTrue:
+ 				[flagsPtr at: 0 put: (flags bitOr: PrimCallIsExternalCall)]].
- 				[flagsPtr at: 0 put: (flags bitOr: PrimCallIsExternalPrim)]].
  		 ^primitiveCalloutPointer].
  	primitiveIndex == PrimNumberExternalCall ifTrue:
  		[| lit |
  		 lit := self attemptToLinkExternalPrimitive: methodObj.
  		 flagsPtr ifNotNil:
  			["N.B. We only support the FastCPrimitiveFlag on Spur because Spur will not run a GC to
  			  satisfy an allocation in a primitive. The V3 ObjectMemory will and hence the depth of
  			  stack needed in a V3 primitive is probably too large to safely execute on a stack page."
  			 objectMemory hasSpurMemoryManagerAPI ifTrue:
  				[| metadata metadataFlags |
  				 metadata := objectMemory fetchPointer: ExternalCallLiteralFlagsIndex ofObject: lit.
  			 	 (objectMemory isIntegerObject: metadata) ifTrue:
  					[metadataFlags := (objectMemory integerValueOf: metadata) bitAnd: SpurPrimitiveFlagsMask.
  					 "combine the specific external primitive's flags with the base flags.
  					  Hence e.g. if profiling is in effect (as indicated by PrimCallCollectsProfileSamples
  					  in the base flags) it remains in effect after combining the specific flags."
  					 flags := flags bitOr: metadataFlags]].
  			 (self externalCallLiteralModuleIsVM: lit) ifFalse:
+ 				[flags := flags bitOr: PrimCallIsExternalCall].
- 				[flags := flags bitOr: PrimCallIsExternalPrim].
  			 flagsPtr at: 0 put: flags].
  		 ^self functionForPrimitiveExternalCall: methodObj].
  	^self functionPointerFor: primitiveIndex inClass: nil!

Item was changed:
  SharedPool subclass: #CogMethodConstants
  	instanceVariableNames: ''
+ 	classVariableNames: 'CMBlock CMClosedPIC CMFree CMMaxUsageCount CMMethod CMOpenPIC CompletePrimitive EncounteredUnknownBytecode InsufficientCodeSpace MaxLiteralCountForCompile MaxMethodSize MaxNegativeErrorCode MaxNumArgs MaxStackCheckOffset MethodTooBig NotFullyInitialized PrimCallCollectsProfileSamples PrimCallIsExternalCall PrimCallMayEndureCodeCompaction PrimCallNeedsNewMethod PrimCallOnSmalltalkStack PrimCallOnSmalltalkStackAlign2x ShouldNotJIT UnfailingPrimitive UnimplementedPrimitive YoungSelectorInPIC'
- 	classVariableNames: 'CMBlock CMClosedPIC CMFree CMMaxUsageCount CMMethod CMOpenPIC CompletePrimitive EncounteredUnknownBytecode InsufficientCodeSpace MaxLiteralCountForCompile MaxMethodSize MaxNegativeErrorCode MaxNumArgs MaxStackCheckOffset MethodTooBig NotFullyInitialized PrimCallCollectsProfileSamples PrimCallIsExternalPrim PrimCallMayEndureCodeCompaction PrimCallNeedsNewMethod PrimCallOnSmalltalkStack PrimCallOnSmalltalkStackAlign2x ShouldNotJIT UnfailingPrimitive UnimplementedPrimitive YoungSelectorInPIC'
  	poolDictionaries: ''
  	category: 'VMMaker-JIT'!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>compileOnStackExternalPrimitive:flags: (in category 'primitive generators') -----
  compileOnStackExternalPrimitive: primitiveRoutine flags: flags
  	"Compile a fast call of a C primitive using the current stack page, avoiding the stack switch except on failure.
  	 This convention still uses stackPointer and argumentCount to access operands.  Push all operands to the stack,
  	 assign stackPointer, argumentCount, and zero primFailCode.  Make the call (saving a LinkReg if required).
  	 Test for failure and return.  On failure on Spur, if there is an accessor depth, assign framePointer and newMethod,
  	 do the stack switch, call checkForAndFollowForwardedPrimitiveState, and loop back if forwarders are found.
  	 Fall through to frame build."
  	<option: #SpurObjectMemory>
  	<var: #primitiveRoutine declareC: 'void (*primitiveRoutine)(void)'>
  	| calleeSavedRegisterMask linkRegSaveRegister spRegSaveRegister jmpFail retry continueAfterProfileSample jumpToTakeSample |
  	self assert: (objectRepresentation hasSpurMemoryManagerAPI and: [flags anyMask: PrimCallOnSmalltalkStack]).
  	self deny: (backEnd hasVarBaseRegister
  				and: [self register: VarBaseReg isInMask: ABICallerSavedRegisterMask]).
  
  	(coInterpreter recordFastCCallPrimTraceForMethod: methodObj) ifTrue:
  		[self genFastPrimTraceUsing: ClassReg and: SendNumArgsReg].
  
  	"Clear the primFailCode and set argumentCount"
  	self MoveCq: 0 R: TempReg.
  	self MoveR: TempReg Aw: coInterpreter primFailCodeAddress.
  	methodOrBlockNumArgs ~= 0 ifTrue:
  		[self AddCq: methodOrBlockNumArgs R: TempReg]. "As small or smaller than move on most archs"
  	self MoveR: TempReg Aw: coInterpreter argumentCountAddress.
  	self genExternalizeStackPointerForFastPrimitiveCall.
  	"We may need to save LinkReg and/or SPReg, and given the stack machinations
  	  it is much easier to save them in callee saved registers than on the stack itself."
  	calleeSavedRegisterMask := ABICalleeSavedRegisterMask bitClear: (self registerMaskFor: ClassReg).
  	backEnd hasLinkRegister ifTrue:
  		[linkRegSaveRegister := self availableRegisterOrNoneIn: calleeSavedRegisterMask.
  		 self deny: linkRegSaveRegister = NoReg.
  		 self MoveR: LinkReg R: linkRegSaveRegister.
  		 calleeSavedRegisterMask := calleeSavedRegisterMask bitClear: (self registerMaskFor: linkRegSaveRegister)].
  	spRegSaveRegister := NoReg.
  	(SPReg ~= NativeSPReg
  	 and: [(self isCalleeSavedReg: SPReg) not]) ifTrue:
  		[spRegSaveRegister := self availableRegisterOrNoneIn: calleeSavedRegisterMask.
  		 self deny: spRegSaveRegister = NoReg.
  		 self MoveR: SPReg R: spRegSaveRegister].
  	retry := self Label.
  	(flags anyMask: PrimCallOnSmalltalkStackAlign2x)
  		ifTrue: [self AndCq: (objectMemory wordSize * 2 - 1) bitInvert R: SPReg R: NativeSPReg]
  		ifFalse:
  			[SPReg ~= NativeSPReg ifTrue:
  				[backEnd genLoadNativeSPRegWithAlignedSPReg]].
  	backEnd genMarshallNArgs: 0 arg: nil arg: nil arg: nil arg: nil.
  	"If the primitive is in the interpreter then its address won't change relative to the code zone over time,
  	 whereas if it is in a plugin its address could change if the module is un/re/over/loaded.
  	 So if in the interpreter and in range use a normal call instruction."
+ 	((flags noMask: PrimCallIsExternalCall)
- 	((flags noMask: PrimCallIsExternalPrim)
  	 and: [backEnd isWithinCallRange: primitiveRoutine asInteger])
  		ifTrue: [self CallRT: primitiveRoutine asInteger]
  		ifFalse: [self CallFullRT: primitiveRoutine asInteger].
  	backEnd genRemoveNArgsFromStack: 0.
  	"test primFailCode and jump to failure sequence if non-zero"
  	self MoveAw: coInterpreter primFailCodeAddress R: TempReg.
  	spRegSaveRegister ~= NoReg ifTrue:
  		[self MoveR: spRegSaveRegister R: SPReg].
  	self CmpCq: 0 R: TempReg.
  	jmpFail := self JumpNonZero: 0.
  	"Remember to restore the native stack pointer to point to the C stack,
  	 otherwise the Smalltalk frames will get overwritten on an interrupt."
  	SPReg ~= NativeSPReg ifTrue:
  		[backEnd genLoadCStackPointer].
  	"placing the test here attributes the tick to the primitive plus any checkForAndFollowForwardedPrimitiveState
  	 scanning, but attributes all of a failing primitive to the current method (in ceStackOverflow: on frame build)."
  	(backEnd has64BitPerformanceCounter
  	 and: [flags anyMask: PrimCallCollectsProfileSamples]) ifTrue:
  		[jumpToTakeSample := self genCheckForProfileTimerTick: (self registerMaskFor: NoReg)].
  	"At this point the primitive has cut back stackPointer to point to the result."
  	continueAfterProfileSample :=
  	self MoveAw: coInterpreter stackPointerAddress R: TempReg.
  	"get result and restore retpc"
  	backEnd hasLinkRegister
  		ifTrue:
  			[self MoveMw: 0 r: TempReg R: ReceiverResultReg;
  				AddCq: objectMemory wordSize R: TempReg R: SPReg;
  				MoveR: linkRegSaveRegister R: LinkReg]
  		ifFalse:
  			[| retpcOffset |
  			"The original retpc is (argumentCount + 1) words below stackPointer."
  			 retpcOffset := (methodOrBlockNumArgs + 1 * objectMemory wordSize) negated.
  			 self MoveMw: retpcOffset r: TempReg R: ClassReg; "get retpc"
  				MoveR: TempReg R: SPReg;
  			 	MoveMw: 0 r: TempReg R: ReceiverResultReg;
  				MoveR: ClassReg Mw: 0 r: TempReg "put it back on stack for the return..."].
  	self RetN: 0.
  
  	(backEnd has64BitPerformanceCounter
  	 and: [flags anyMask: PrimCallCollectsProfileSamples]) ifTrue:
  		[jumpToTakeSample jmpTarget: self Label.
  		 self genTakeProfileSample.
  		 self Jump: continueAfterProfileSample].
  
  	"primitive failure. if there is an accessor depth, scan and retry on failure (but what if faling for out of memory?)"
  	jmpFail jmpTarget: self Label.
  	(coInterpreter accessorDepthForPrimitiveMethod: methodObj) >= 0
  		ifTrue:
  			[| skip |
  			 "Given that following primitive state to the accessor depth is recursive, we're asking for
  			  trouble if we run the fixup on the Smalltalk stack page.  Run it on the full C stack instead.
  			 This won't be a performance issue since primitive failure should be very rare."
  			self MoveR: FPReg Aw: coInterpreter framePointerAddress.
  			self MoveCw: primitiveRoutine asInteger R: TempReg.
  			self MoveR: TempReg Aw: coInterpreter primitiveFunctionPointerAddress.
  			methodLabel addDependent:
  				(self annotateAbsolutePCRef:
  					(self MoveCw: methodLabel asInteger R: ClassReg)).
  			self MoveMw: (self offset: CogMethod of: #methodObject) r: ClassReg R: TempReg.
  			self MoveR: TempReg Aw: coInterpreter newMethodAddress.
  			self genLoadCStackPointersForPrimCall.
  			backEnd genMarshallNArgs: 0 arg: 0 arg: 0 arg: 0 arg: 0.
  			(backEnd isWithinCallRange: (self cCode: [#checkForAndFollowForwardedPrimitiveState asUnsignedIntegerPtr]
  										inSmalltalk: [self simulatedTrampolineFor: #checkForAndFollowForwardedPrimitiveState]))
  				ifTrue:
  					[self CallRT: (self cCode: [#checkForAndFollowForwardedPrimitiveState asUnsignedIntegerPtr]
  										inSmalltalk: [self simulatedTrampolineFor: #checkForAndFollowForwardedPrimitiveState])]
  				ifFalse:
  					[self CallFullRT: (self cCode: [#checkForAndFollowForwardedPrimitiveState asUnsignedIntegerPtr]
  										inSmalltalk: [self simulatedTrampolineFor: #checkForAndFollowForwardedPrimitiveState])].
  			backEnd genLoadStackPointersForPrimCall: ClassReg.
  			self CmpCq: 0 R: ABIResultReg.
  			skip := self JumpZero: 0.
  			self MoveCq: 0 R: TempReg.
  			self MoveR: TempReg Aw: coInterpreter primFailCodeAddress.
  			self Jump: retry.
  			skip jmpTarget: self Label]
  		ifFalse: "must reload SPReg to undo any alignment change,"
  			[(flags anyMask: PrimCallOnSmalltalkStackAlign2x) ifTrue:
  				[backEnd hasLinkRegister
  					ifTrue:
  						[self MoveAw: coInterpreter stackPointerAddress R: SPReg]
  					ifFalse: "remember to include return address; use scratch to avoid an interrupt overwriting retpc"
  						[self MoveAw: coInterpreter stackPointerAddress R: TempReg.
  						 self SubCq: objectRepresentation wordSize R: TempReg.
  						 self MoveR: TempReg R: SPReg]]].
  	"Remember to restore the native stack pointer to point to the C stack,
  	 otherwise the Smalltalk frames will get overwritten on an interrupt."
  	SPReg ~= NativeSPReg ifTrue:
  		[backEnd genLoadCStackPointer].
  	"The LinkRegister now contains the return address either of the primitive call or of checkForAndFollowForwardedPrimitiveState.
  	 It must be restored to the return address of the send invoking this primtiive method."
  	backEnd hasLinkRegister ifTrue:
  		[self MoveR: linkRegSaveRegister R: LinkReg].
  	"Finally remember to reload ReceiverResultReg if required.  Even if
  	 arguments have been pushed, the prolog sequence assumes it is live."
  	(self register: ReceiverResultReg isInMask: ABICallerSavedRegisterMask) ifTrue:
  		[self MoveMw: (methodOrBlockNumArgs + (backEnd hasLinkRegister ifTrue: [0] ifFalse: [1])) * objectMemory wordSize
  			r: SPReg
  			R: ReceiverResultReg].
  	"continue to frame build..."
  	^0!



More information about the Vm-dev mailing list