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

commits at source.squeak.org commits at source.squeak.org
Sat Jul 16 18:16:46 UTC 2022


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

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

Name: VMMaker.oscog-eem.3210
Author: eem
Time: 16 July 2022, 11:16:32.951904 am
UUID: a7eaf010-b7fe-4a09-8ced-6f5eb6201ec7
Ancestors: VMMaker.oscog-eem.3209

SmartSyntaxPlugins:
Add Unsigned32 for type unsigned int (Unsigned got changed to sqIntptr_t in the 32-bit => 64-bit transition).  This probably doesn't simulate yet, because of the use of the #deferred symbol now being allowed on code generation implementors of ccg:prolog:expr:index:.  But that can be fixed later. SImulation of existing plugins remains OK.


Fix passign of floats in the ThreadedRiscV64FFIPlugin, and restore the <inline: false> in ThreadedRiscV64FFIPlugin>>#ffiCall:ArgArrayOrNil:NumArgs: to acvoid massive code duplication.

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

Item was added:
+ ----- Method: SmartSyntaxPluginAssignmentCodeGenerator>>ccgLoad:expr:asUnsigned32BitValueFrom:andThen: (in category 'coercing') -----
+ ccgLoad: aBlock expr: aString asUnsigned32BitValueFrom: stackIndex andThen: validationString
+ 	^aString, ' := interpreterProxy positive32BitValueOf:', (self stackAccessorFor: stackIndex)!

Item was changed:
  ----- Method: SmartSyntaxPluginCodeGenerator>>ccgLoad:expr:asPtrFrom:andThen: (in category 'coercing') -----
  ccgLoad: aBlock expr: aString asPtrFrom: anInteger andThen: valBlock
  	"Answer codestring for void pointer to first indexable field of object (without validating side-effect unless specified in valBlock), as described in comment to ccgLoad:expr:asRawOopFrom:"
  
  	^(valBlock value: anInteger),
+ 	  '. ',
+ 	  (aBlock value: 'interpreterProxy firstIndexableField:(interpreterProxy stackValue:', anInteger asString, ')')!
- 	  '.',
- 	  (aBlock value: 'interpreterProxy firstIndexableField:(interpreterProxy stackValue:', anInteger asString, '))')!

Item was added:
+ ----- Method: SmartSyntaxPluginCodeGenerator>>compileToTMethodSelector:in: (in category 'utilities') -----
+ compileToTMethodSelector: selector in: aClass
+ 	"Compile a method to a TMethod"
+ 	(breakSrcInlineSelectors notNil
+ 	 and: [(breakSrcInlineSelectors includes: selector) not "i.e. break in the superclass method..."
+ 	 and: [breakOnInline ~~ true]]) ifTrue:
+ 		[| methodNode |
+ 		methodNode := (aClass >> selector) methodNode.
+ 		methodNode block nodesDo:
+ 			[:n|
+ 			(n isMessageNode
+ 			 and: [(n selector key beginsWith: #primitive:parameters:)
+ 			 and: [n arguments first isLiteralNode
+ 			 and: [breakSrcInlineSelectors includes: n arguments first key asSymbol]]]) ifTrue: [self halt. ^super compileToTMethodSelector: selector in: aClass]]].
+ 	^super compileToTMethodSelector: selector in: aClass!

Item was changed:
  ----- Method: SmartSyntaxPluginTMethod>>namedPrimitiveProlog (in category 'specifying primitives') -----
  namedPrimitiveProlog
  	"Generate the code for a primitive:parameters:... send.  This is in two parts.
  	 The first is validation; the second is coercing assignment."
+ 	| statements validator validations deferredValidations assigner |
- 	| statements validator validations assigner |
  	fullArgs isEmpty ifTrue:
  		[^#()].
  	validator := SmartSyntaxPluginValidationCodeGenerator new.
  	statements := OrderedCollection new.
  	validations := fullArgs withIndexCollect:
  					[:arg :i|
  					(parmSpecs at: i) 
+ 							ccg:	validator
+ 							prolog:	nil
+ 							expr:	arg
+ 							index:	fullArgs size - i].
- 							ccg: 	validator
- 							prolog:  nil
- 							expr: arg
- 							index: (fullArgs size - i)].
  	validations := validations reject: [:validation| validation isNil].
+ 	deferredValidations := validations select: [:validation| validation isArray and: [validation size = 2 and: [validation first == #deferred]]].
+ 	validations := validations copyWithoutAll: deferredValidations.
+ 	statements addAllLast: (self validationStatementsFor: validations).
- 	validations isEmpty ifFalse:
- 		[statements addAllLast: (self statementsFor:
- 									(String streamContents:
- 										[:s|
- 										s nextPut: $(.
- 										validations
- 											do: [:validation| s nextPut: $(; nextPutAll: validation; nextPut: $)]
- 											separatedBy: [s crtab; nextPutAll: 'and: ['].
- 										s next: validations size - 1 put: $].
- 										s nextPutAll: ') ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]'])
- 									varName: '')].
  	assigner := SmartSyntaxPluginAssignmentCodeGenerator new.
  	fullArgs withIndexDo:
  		[:arg :i|
  		statements addAllLast:
  			(self 
  				statementsFor: 
  					((parmSpecs at: i) 
+ 						ccg:	assigner
+ 						prolog:	nil
- 						ccg: 	assigner
- 						prolog:  nil
  						expr:	arg
+ 						index:	fullArgs size - i)
- 						index:	(fullArgs size - i))
  				varName: '')].
+ 	statements addAllLast: (self validationStatementsFor: (deferredValidations collect: #second)).
  	^statements!

Item was added:
+ ----- Method: SmartSyntaxPluginTMethod>>validationStatementsFor: (in category 'private') -----
+ validationStatementsFor: validations
+ 	validations isEmpty ifTrue: [^#()].
+ 	^self
+ 		statementsFor: (String streamContents:
+ 								[:s|
+ 								s nextPut: $(.
+ 								validations
+ 									do: [:validation| s nextPut: $(; nextPutAll: validation; nextPut: $)]
+ 									separatedBy: [s crtab; nextPutAll: 'and: ['].
+ 								s next: validations size - 1 put: $].
+ 								s nextPutAll: ') ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument]'])
+ 		varName: ''!

Item was added:
+ ----- Method: SmartSyntaxPluginValidationCodeGenerator>>ccgLoad:expr:asUnsigned32BitValueFrom:andThen: (in category 'coercing') -----
+ ccgLoad: aBlock expr: aString asUnsigned32BitValueFrom: stackIndex andThen: validationString
+ 	^{#deferred. validationString}!

Item was removed:
- ----- Method: SpurMemoryManager>>inactiveOrFailedToDeferScan: (in category 'weakness and ephemerality') -----
- inactiveOrFailedToDeferScan: anEphemeron
- 	"Answer whether an ephemeron is inactive (has a marked key) or,
- 	 if active, failed to fit on the unscanned ephemerons stack."
- 	| key |
- 	self assert: (self isEphemeron: anEphemeron).
- 	((self isImmediate: (key := self keyOfEphemeron: anEphemeron))
- 	 or: [self isMarked: key]) ifTrue:
- 		[^true].
- 	^(self pushOnUnscannedEphemeronsStack: anEphemeron) not!

Item was changed:
  ----- Method: ThreadedRiscV64FFIPlugin>>ffiCall:ArgArrayOrNil:NumArgs: (in category 'callout support') -----
  ffiCall: externalFunction ArgArrayOrNil: argArrayOrNil NumArgs: nArgs
  	"Generic callout. Does the actual work.  If argArrayOrNil is nil it takes args from the stack
  	 and the spec from the method.  If argArrayOrNil is not nil takes args from argArrayOrNil
  	 and the spec from the receiver."
  	| flags argTypeArray address argType oop argSpec argClass err theCalloutState calloutState requiredStackSize stackSize allocation result primNumArgs |
+ 	<inline: false>
- 	<inline: true>
  	<var: #theCalloutState type: #'CalloutState'>
  	<var: #calloutState type: #'CalloutState *'>
  	<var: #allocation type: #'char *'>
  
  	primNumArgs := interpreterProxy methodArgumentCount.
  	(interpreterProxy is: externalFunction KindOfClass: interpreterProxy classExternalFunction) ifFalse:
  		[^self ffiFail: FFIErrorNotFunction].
  	"Load and check the values in the externalFunction before we call out"
  	flags := interpreterProxy fetchInteger: ExternalFunctionFlagsIndex ofObject: externalFunction.
  	interpreterProxy failed ifTrue:
  		[^self ffiFail: FFIErrorBadArgs].
  
  	"This must come early for compatibility with the old FFIPlugin.  Image-level code
  	 may assume the function pointer is loaded eagerly.  Thanks to Nicolas Cellier."
  	address := self ffiLoadCalloutAddress: externalFunction.
  	interpreterProxy failed ifTrue:
  		[^0 "error code already set by ffiLoadCalloutAddress:"].
  	
  	argTypeArray := interpreterProxy fetchPointer: ExternalFunctionArgTypesIndex ofObject: externalFunction.
  	"must be array of arg types"
  	((interpreterProxy isArray: argTypeArray)
  	and: [(interpreterProxy slotSizeOf: argTypeArray) = (nArgs + 1)]) ifFalse:
  		[^self ffiFail: FFIErrorBadArgs].
  	"check if the calling convention is supported"
  	self cppIf: COGMTVM
  		ifTrue:
  			[(self ffiSupportsCallingConvention: (flags bitAnd: FFICallTypesMask)) ifFalse:
  				[^self ffiFail: FFIErrorCallType]]
  		ifFalse: "not masking causes threaded calls to fail, which is as they should if the plugin is not threaded."
  			[(self ffiSupportsCallingConvention: flags) ifFalse:
  				[^self ffiFail: FFIErrorCallType]].
  		
  	requiredStackSize := self externalFunctionHasStackSizeSlot
  							ifTrue: [interpreterProxy
  										fetchInteger: ExternalFunctionStackSizeIndex
  										ofObject: externalFunction]
  							ifFalse: [-1].
  	interpreterProxy failed ifTrue:
  		[^interpreterProxy primitiveFailFor: (argArrayOrNil isNil
  												ifTrue: [PrimErrBadMethod]
  												ifFalse: [PrimErrBadReceiver])].
  	stackSize := requiredStackSize < 0 ifTrue: [DefaultMaxStackSize] ifFalse: [requiredStackSize].
  	self cCode: [] inSmalltalk: [theCalloutState := self class calloutStateClass new].
  	calloutState := self addressOf: theCalloutState.
  	self cCode: [self memset: calloutState _: 0 _: (self sizeof: #CalloutState)].
  	calloutState callFlags: flags.
  	"Fetch return type and args"
  	argType := interpreterProxy fetchPointer: 0 ofObject: argTypeArray.
  	argSpec := interpreterProxy fetchPointer: 0 ofObject: argType.
  	argClass := interpreterProxy fetchPointer: 1 ofObject: argType.
  	(err := self ffiCheckReturn: argSpec With: argClass in: calloutState) ~= 0 ifTrue:
  		[^self ffiFail: err]. "cannot return"
  	"alloca the outgoing stack frame, leaving room for marshalling args, and including space for the return struct, if any.
  	Additional space reserved for saving register args like mandated by Win64 X64 or PPC ABI, will be managed by the call itself"
  	allocation := self alloca: stackSize + calloutState structReturnSize + self cStackAlignment.
  	self mustAlignStack ifTrue:
  		[allocation := self cCoerce: (allocation asUnsignedIntegerPtr bitClear: self cStackAlignment - 1) to: #'char *'].
  	calloutState
  		argVector: allocation;
  		currentArg: allocation;
  		limit: allocation + stackSize.
  	"This next bit overrides the ARM64 code to pass return struct pointer in A0"
  	(calloutState structReturnSize > 0
  	 and: [self nonRegisterStructReturnIsViaImplicitFirstArgument
  	 and: [(self returnStructInRegisters: calloutState) not]]) ifTrue:
  		[err := self ffiPushPointer: calloutState limit in: calloutState.
  		 err ~= 0 ifTrue:
  			[self cleanupCalloutState: calloutState.
  			 self cppIf: COGMTVM ifTrue:
  			 [err = PrimErrObjectMayMove negated ifTrue:
  				[^PrimErrObjectMayMove]]. "N.B. Do not fail if object may move because caller will GC and retry."
  			 ^self ffiFail: err]].
+ 	"Aside from the bit above, code identical with arm64"
- 	"Aside from the bit above, code identical with arn64"
  	1 to: nArgs do:
  		[:i|
  		argType := interpreterProxy fetchPointer: i ofObject: argTypeArray.
  		argSpec := interpreterProxy fetchPointer: 0 ofObject: argType.
  		argClass := interpreterProxy fetchPointer: 1 ofObject: argType.
  		oop := argArrayOrNil isNil
  				ifTrue: [interpreterProxy stackValue: nArgs - i]
  				ifFalse: [interpreterProxy fetchPointer: i - 1 ofObject: argArrayOrNil].
  		err := self ffiArgument: oop Spec: argSpec Class: argClass in: calloutState.
  		err ~= 0 ifTrue:
  			[self cleanupCalloutState: calloutState.
  			 self cppIf: COGMTVM ifTrue:
  			 [err = PrimErrObjectMayMove negated ifTrue:
  				[^PrimErrObjectMayMove]]. "N.B. Do not fail if object may move because caller will GC and retry."
  			 ^self ffiFail: err]]. "coercion failed or out of stack space"
  	"Failures must be reported back from ffiArgument:Spec:Class:in:.
  	 Should not fail from here on in."
  	self assert: interpreterProxy failed not.
  	self ffiLogCallout: externalFunction.
  	(requiredStackSize < 0
  	 and: [self externalFunctionHasStackSizeSlot]) ifTrue:
  		[stackSize := calloutState currentArg - calloutState argVector.
  		 interpreterProxy storeInteger: ExternalFunctionStackSizeIndex ofObject: externalFunction withValue: stackSize].
  	"Go out and call this guy"
  	result := self ffiCalloutTo: address SpecOnStack: argArrayOrNil notNil in: calloutState.
  	self cleanupCalloutState: calloutState.
  	"Can not safely use argumentCount (via e.g. methodReturnValue:) since it may have been changed by a callback."
  	interpreterProxy pop: primNumArgs + 1 thenPush: result. 
  	^result!

Item was added:
+ ----- Method: ThreadedRiscV64FFIPlugin>>ffiPushFloat32:in: (in category 'marshalling') -----
+ ffiPushFloat32: value in: calloutState
+ 	<var: #value type: #float>
+ 	<var: #calloutState type: #'CalloutState *'>
+ 	<inline: #always>
+ 	"N.B. the RISCV ABI states that unused part should be -1,
+ 	 [RISC-V Instruction Set Manual - Volume I: User Level ISA,
+ 	 12.2 NaN Boxing of Narrower Value"
+ 	calloutState floatRegisterIndex < NumFloatRegArgs
+ 		ifTrue: "Note: this is a 'memcopy', so size is preserved. Casting to #double changes the size"
+ 			[(self cCoerceSimple: 
+ 				(self addressOf: (calloutState floatRegisters at: calloutState floatRegisterIndex)) 
+ 					 to: #'long *')
+ 				at: 0
+ 				put: -1.
+ 			(self cCoerceSimple: 
+ 				(self addressOf: (calloutState floatRegisters at: calloutState floatRegisterIndex)) 
+ 					 to: #'float *')
+ 				at: 0
+ 				put: value.
+ 			 calloutState floatRegisterIndex: calloutState floatRegisterIndex + 1]
+ 		ifFalse:
+ 			[calloutState currentArg + self wordSize > calloutState limit ifTrue:
+ 				[^FFIErrorCallFrameTooBig].
+ 			 interpreterProxy
+ 				longAt: calloutState currentArg put: -1;
+ 				storeSingleFloatAtPointer: calloutState currentArg from: value.
+ 			 calloutState currentArg: calloutState currentArg + self wordSize].
+ 	^0!

Item was added:
+ Unsigned subclass: #Unsigned32
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-SmartSyntaxPlugins'!

Item was added:
+ ----- Method: Unsigned32 class>>ccg:prolog:expr:index: (in category 'plugin generation') -----
+ ccg: cg prolog: aBlock expr: aString index: anInteger
+ 
+ 	^cg ccgLoad: aBlock expr: aString asUnsigned32BitValueFrom: anInteger andThen: 'interpreterProxy failed not'!

Item was added:
+ ----- Method: Unsigned32 class>>ccgDeclareCForVar: (in category 'plugin generation') -----
+ ccgDeclareCForVar: aSymbolOrString
+ 
+ 	^ #'unsigned int', ' ', aSymbolOrString!



More information about the Vm-dev mailing list