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

commits at source.squeak.org commits at source.squeak.org
Tue Sep 21 00:13:46 UTC 2021


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

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

Name: VMMaker.oscog-eem.3072
Author: eem
Time: 20 September 2021, 5:13:35.70563 pm
UUID: 11a316ba-c087-4847-85b0-5aa2626e4155
Ancestors: VMMaker.oscog-eem.3071

StackInterpreter: provide access control for FFI exception catch and throw as failure.
Primitive 220 is primitiveGetSetFFIExceptionHandling. VM parameter 65 bit 4 is bit flagging if VM is capable of catching FFI exceptions (e.g. currently 64-bit Windows Vm isn't).
Eliminate a compilaiton warning in primitiveExternalCall.

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

Item was changed:
  ----- Method: StackInterpreter class>>initializePrimitiveTable (in category 'initialization') -----
(excessive size, no diff calculated)

Item was changed:
  ----- Method: StackInterpreter>>getCogVMFeatureFlags (in category 'internal interpreter access') -----
  getCogVMFeatureFlags
  	"Answer an array of flags indicating various optional features of the Cog VM.
  	 Bit 0: supports two bytecode sets (MULTIPLEBYTECODESETS)
  	 Bit 1: supports immutablity (IMMUTABILITY)
  	 Bit 2: suffers from a UNIX setitimer signal-based heartbeat
  	 Bit 3: the VM provides cross-platform bit-identical floating point"
  	^objectMemory integerObjectOf: (MULTIPLEBYTECODESETS ifTrue: [1] ifFalse: [0])
  									+ (IMMUTABILITY ifTrue: [2] ifFalse: [0])
  									+ (self cppIf: #'ITIMER_HEARTBEAT' ifTrue: [4] ifFalse: [0])
+ 									+ (self cppIf: #'BIT_IDENTICAL_FLOATING_POINT' ifTrue: [8] ifFalse: [0])
+ 									+ (self ioCanCatchFFIExceptions ifTrue: [16] ifFalse: [0])!
- 									+ (self cppIf: #'BIT_IDENTICAL_FLOATING_POINT' ifTrue: [8] ifFalse: [0])!

Item was added:
+ ----- Method: StackInterpreter>>ioCanCatchFFIExceptions (in category 'simulation') -----
+ ioCanCatchFFIExceptions
+ 	<doNotGenerate>
+ 	^true!

Item was changed:
  ----- Method: StackInterpreter>>rewriteMethodCacheEntryForExternalPrimitiveToFunction: (in category 'method lookup cache') -----
  rewriteMethodCacheEntryForExternalPrimitiveToFunction: localPrimAddress
  	"Rewrite an existing entry in the method cache with a new primitive function address.
  	 Used by primitiveExternalCall to make direct calls to found external prims, or quickly
  	 fail not found external prims."
  	<inline: false>
+ 	<var: #localPrimAddress declareC: 'void (*localPrimAddress)()'>
- 	<var: #localPrimAddress declareC: 'void (*localPrimAddress)(void)'>
  	(methodCache at: lastMethodCacheProbeWrite + MethodCacheMethod) = newMethod ifTrue:
  		[methodCache
  			at: lastMethodCacheProbeWrite + MethodCachePrimFunction
  			put: (self cCoerce: localPrimAddress to: #'sqIntptr_t')]!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveExternalCall (in category 'plugin primitives') -----
  primitiveExternalCall
  	"Call an external primitive. External primitive methods first literals are an array of
  		* The module name (String | Symbol)
  		* The function name (String | Symbol)
  		* The session ID (SmallInteger) [OBSOLETE], or in Spur, the metadata (accessorDepth and flags; Integer))
  		* The function index (Integer) in the externalPrimitiveTable
  	For fast interpreter dispatch in subsequent invocations the primitiveFunctionPointer
  	in the method cache is rewritten, either to the function itself, or to zero if the external
  	function is not found.   This allows for fast responses as long as the method stays in
  	the cache. The cache rewrite relies on lastMethodCacheProbeWrite which is set in
  	addNewMethodToCache:.
  	Now that the VM flushes function addresses from its tables, the session ID is obsolete,
  	but it is kept for backward compatibility. Also, a failed lookup is reported specially. If a
  	method has been  looked up and not been found, the function address is stored as -1
  	(i.e., the SmallInteger -1 to distinguish from 16rFFFFFFFF which may be returned from
  	lookup), and the primitive fails with PrimErrNotFound."
  	| lit addr index |
+ 	<var: #addr declareC: 'void (*addr)()'>
  	
  	"Check for it being a method for primitiveDoPrimitiveWithArgs.
  	 Fetch the first literal of the method; check its an Array of length 4.
  	 Look at the function index in case it has been loaded before"
  	((objectMemory isOopCompiledMethod: newMethod)
  	 and: [(objectMemory literalCountOf: newMethod) > 0
  	 and: [lit := self literal: 0 ofMethod: newMethod.
  		(objectMemory isArray: lit)
  	 and: [(objectMemory numSlotsOf: lit) = 4
  	 and: [index := objectMemory fetchPointer: ExternalCallLiteralTargetFunctionIndex ofObject: lit.
  		objectMemory isIntegerObject: index]]]]) ifFalse:
  		[^self primitiveFailFor: PrimErrBadMethod].
  
  	index := objectMemory integerValueOf: index.
  	"Check if we have already looked up the function and failed."
  	index < 0 ifTrue:
  		["Function address was not found in this session, 
  		  Void the primitive function."
  		 self rewriteMethodCacheEntryForExternalPrimitiveToFunction: 0.
  		 ^self primitiveFailFor: PrimErrNotFound].
  
  	"Try to call the function directly"
  	(index > 0 and: [index <= MaxExternalPrimitiveTableSize]) ifTrue:
  		[addr := externalPrimitiveTable at: index - 1.
  		 addr ~= 0 ifTrue:
  			[self rewriteMethodCacheEntryForExternalPrimitiveToFunction: (self cCode: 'addr' inSmalltalk: [1000 + index]).
  			 self callExternalPrimitive: addr. "On Spur, sets primitiveFunctionPointer"
  			 self maybeRetryPrimitiveOnFailure.
  			 ^nil].
  		"if we get here, then an index to the external prim was 
  		kept on the ST side although the underlying prim 
  		table was already flushed"
  		^self primitiveFailFor: PrimErrNamedInternal].
  
  	"Clean up session id/metadata and external primitive index"
  	objectMemory storePointerUnchecked: ExternalCallLiteralFlagsIndex ofObject: lit withValue: ConstZero.
  	objectMemory storePointerUnchecked: ExternalCallLiteralTargetFunctionIndex ofObject: lit withValue: ConstZero.
  
  	"The function has not been loaded yet. Attempt to link it, cache it, and call it."
  	addr := self linkExternalCall: lit errInto: (self addressOf: primFailCode put: [:v| primFailCode := v]).
  	addr = 0 ifTrue:
  		[self assert: (objectMemory fetchPointer: ExternalCallLiteralFlagsIndex ofObject: lit) = ConstZero.
  		 ^self primitiveFailFor: (primFailCode = 0 ifTrue: [PrimErrNotFound] ifFalse: [primFailCode])].
  
  	self callExternalPrimitive: addr.
  	self maybeRetryPrimitiveOnFailure	!

Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitiveGetSetFFIExceptionHandling (in category 'system control primitives') -----
+ primitiveGetSetFFIExceptionHandling
+ 	| arg |
+ 	argumentCount = 0 ifTrue:
+ 		[^self methodReturnInteger: (self ioCanCatchFFIExceptions
+ 										ifTrue: [ffiExceptionResponse]
+ 										ifFalse: [-1])].
+ 	self ioCanCatchFFIExceptions ifFalse:
+ 		[^self primitiveFailFor: PrimErrUnsupported].
+ 	argumentCount = 1 ifFalse:
+ 		[^self primitiveFailFor: PrimErrBadNumArgs].
+ 	arg := self stackTop.
+ 	((objectMemory isIntegerObject: arg)
+ 	 and: [(arg := objectMemory integerValueOf: arg) between: -1 and: 1]) ifFalse:
+ 		[^self primitiveFailFor: PrimErrBadArgument].
+ 	ffiExceptionResponse := arg.
+ 	self methodReturnReceiver!

Item was changed:
  ----- Method: ThreadedARM32FFIPlugin>>ffiCalloutTo:SpecOnStack:in: (in category 'callout support') -----
  ffiCalloutTo: procAddr SpecOnStack: specOnStack in: calloutState
  	<var: #procAddr type: #'void *'>
  	<var: #calloutState type: #'CalloutState *'>
  	<var: #loadFloatRegs declareC: 'extern void loadFloatRegs(double, double, double, double, double, double, double, double)'>
  	"Go out, call this guy and create the return value.  This *must* be inlined because of
  	 the alloca of the outgoing stack frame in ffiCall:WithFlags:NumArgs:Args:AndTypes:"
  	| myThreadIndex atomicType floatRet intRet |
  	<var: #floatRet type: #double>
  	<var: #intRet type: #usqLong>
  	<inline: #always>
  	myThreadIndex := interpreterProxy disownVM: (self disownFlagsFor: calloutState).
  
  	calloutState floatRegisterIndex > 0 ifTrue:
+ 		[self loadFloatRegs:
+ 				((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 0)) to: #'double *') at: 0)
+ 			_:	((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 2)) to: #'double *') at: 0)
+ 			_:	((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 4)) to: #'double *') at: 0)
+ 			_:	((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 6)) to: #'double *') at: 0)
+ 			_:	((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 8)) to: #'double *') at: 0)
+ 			_:	((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 10)) to: #'double *') at: 0)
+ 			_:	((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 12)) to: #'double *') at: 0)
+ 			_:	((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 14)) to: #'double *') at: 0)].
- 		[self 
- 			load: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 0)) to: 'double *') at: 0)
- 			Flo: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 2)) to: 'double *') at: 0)
- 			a: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 4)) to: 'double *') at: 0)
- 			t: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 6)) to: 'double *') at: 0)
- 			R: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 8)) to: 'double *') at: 0)
- 			e: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 10)) to: 'double *') at: 0)
- 			g: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 12)) to: 'double *') at: 0)
- 			s: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 14)) to: 'double *') at: 0)].
  
  	(self allocaLiesSoSetSpBeforeCall or: [self mustAlignStack]) ifTrue:
  		[self setsp: calloutState argVector].
  
  	atomicType := self atomicTypeOf: calloutState ffiRetHeader.
  	(atomicType >> 1) = (FFITypeSingleFloat >> 1) ifTrue:
  		[atomicType = FFITypeSingleFloat
  			ifTrue:
  				[floatRet := self 
  					dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') 
  					with: (calloutState integerRegisters at: 0)
  					with: (calloutState integerRegisters at: 1)
  					with: (calloutState integerRegisters at: 2)
  					with: (calloutState integerRegisters at: 3)]
  			ifFalse: "atomicType = FFITypeDoubleFloat"
  				[floatRet := self 
  					dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') 
  					with: (calloutState integerRegisters at: 0)
  					with: (calloutState integerRegisters at: 1)
  					with: (calloutState integerRegisters at: 2)
  					with: (calloutState integerRegisters at: 3)].
  
  		 "undo any callee argument pops because it may confuse stack management with the alloca."
  		 (self isCalleePopsConvention: calloutState callFlags) ifTrue:
  			[self setsp: calloutState argVector].
  		 interpreterProxy ownVM: myThreadIndex.
  
  		 ^interpreterProxy floatObjectOf: floatRet].
  
  	intRet := self 
  				dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqIntptr_t (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') 
  				with: (calloutState integerRegisters at: 0)
  				with: (calloutState integerRegisters at: 1)
  				with: (calloutState integerRegisters at: 2)
  				with: (calloutState integerRegisters at: 3).
  
  	"undo any callee argument pops because it may confuse stack management with the alloca."
  	(self isCalleePopsConvention: calloutState callFlags) ifTrue:
  		[self setsp: calloutState argVector].
  	interpreterProxy ownVM: myThreadIndex.
  
  	(calloutState ffiRetHeader anyMask: FFIFlagPointer+FFIFlagStructure) ifTrue:
  		["Note: Order is important here since FFIFlagPointer + FFIFlagStructure is used to represent
  		 'typedef void* VoidPointer' and VoidPointer must be returned as pointer *not* as struct."
  		 (calloutState ffiRetHeader anyMask: FFIFlagPointer) ifTrue:
  			[^self ffiReturnPointer: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState].
  		 ^self ffiReturnStruct: (self addressOf: intRet) ofType: (self ffiReturnType: specOnStack) in: calloutState].
  	
  	^self ffiCreateIntegralResultOop: intRet ofAtomicType: atomicType in: calloutState!

Item was changed:
  ----- Method: ThreadedX64SysVFFIPlugin>>ffiCalloutTo:SpecOnStack:in: (in category 'callout support') -----
  ffiCalloutTo: procAddr SpecOnStack: specOnStack in: calloutState
  	<var: #procAddr type: #'void *'>
  	<var: #calloutState type: #'CalloutState *'>
  	<var: #loadFloatRegs declareC: 'extern void loadFloatRegs(double, double, double, double, double, double, double, double)'>
  	"Go out, call this guy and create the return value.  This *must* be inlined because of
  	 the alloca of the outgoing stack frame in ffiCall:WithFlags:NumArgs:Args:AndTypes:"
  	| myThreadIndex atomicType floatRet intRet sddRet sdiRet sidRet siiRet returnStructByValue registerType sRetPtr |
  	<var: #floatRet type: #double>
  	<var: #intRet type: #sqInt>
  	<var: #siiRet type: #SixteenByteReturnII>
  	<var: #sidRet type: #SixteenByteReturnID>
  	<var: #sdiRet type: #SixteenByteReturnDI>
  	<var: #sddRet type: #SixteenByteReturnDD>
  	<var: #sRetPtr type: #'void *'>
  	<inline: #always>
  	
  	returnStructByValue := (calloutState ffiRetHeader bitAnd: FFIFlagStructure + FFIFlagPointer + FFIFlagAtomic) = FFIFlagStructure.
  	
  	myThreadIndex := interpreterProxy disownVM: (self disownFlagsFor: calloutState).
  
  	calloutState floatRegisterIndex > 0 ifTrue:
+ 		[self loadFloatRegs:
+ 			   (calloutState floatRegisters at: 0)
+ 			_: (calloutState floatRegisters at: 1)
+ 			_: (calloutState floatRegisters at: 2)
+ 			_: (calloutState floatRegisters at: 3)
+ 			_: (calloutState floatRegisters at: 4)
+ 			_: (calloutState floatRegisters at: 5)
+ 			_: (calloutState floatRegisters at: 6)
+ 			_: (calloutState floatRegisters at: 7)].
- 		[self 
- 			load: (calloutState floatRegisters at: 0)
- 			Flo: (calloutState floatRegisters at: 1)
- 			a: (calloutState floatRegisters at: 2)
- 			t: (calloutState floatRegisters at: 3)
- 			R: (calloutState floatRegisters at: 4)
- 			e: (calloutState floatRegisters at: 5)
- 			g: (calloutState floatRegisters at: 6)
- 			s: (calloutState floatRegisters at: 7)].
  
  	(self allocaLiesSoSetSpBeforeCall or: [self mustAlignStack]) ifTrue:
  		[self setsp: calloutState argVector].
  
  	atomicType := self atomicTypeOf: calloutState ffiRetHeader.
  	(atomicType >> 1) = (FFITypeSingleFloat >> 1) ifTrue:
  		[atomicType = FFITypeSingleFloat
  			ifTrue:
  				[floatRet := self 
  					dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') 
  					with: (calloutState integerRegisters at: 0)
  					with: (calloutState integerRegisters at: 1)
  					with: (calloutState integerRegisters at: 2)
  					with: (calloutState integerRegisters at: 3)
  					with: (calloutState integerRegisters at: 4)
  					with: (calloutState integerRegisters at: 5)]
  			ifFalse: "atomicType = FFITypeDoubleFloat"
  				[floatRet := self 
  					dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') 
  					with: (calloutState integerRegisters at: 0)
  					with: (calloutState integerRegisters at: 1)
  					with: (calloutState integerRegisters at: 2)
  					with: (calloutState integerRegisters at: 3)
  					with: (calloutState integerRegisters at: 4)
  					with: (calloutState integerRegisters at: 5)].
  
  		 interpreterProxy ownVM: myThreadIndex.
  
  		 ^interpreterProxy floatObjectOf: floatRet].
  
  	returnStructByValue  ifFalse:
  		[intRet := self 
  					dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'sqInt (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') 
  					with: (calloutState integerRegisters at: 0)
  					with: (calloutState integerRegisters at: 1)
  					with: (calloutState integerRegisters at: 2)
  					with: (calloutState integerRegisters at: 3)
  					with: (calloutState integerRegisters at: 4)
  					with: (calloutState integerRegisters at: 5).
  		interpreterProxy ownVM: myThreadIndex.
  		(calloutState ffiRetHeader anyMask: FFIFlagPointer) ifTrue:
  			[^self ffiReturnPointer: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState].
  		^self ffiCreateIntegralResultOop: intRet ofAtomicType: atomicType in: calloutState].
  
  	registerType := calloutState structReturnType.
  	registerType
  		caseOf:
  			{[2r00] ->
  				[sddRet := self 
  					dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'SixteenByteReturnDD (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') 
  					with: (calloutState integerRegisters at: 0)
  					with: (calloutState integerRegisters at: 1)
  					with: (calloutState integerRegisters at: 2)
  					with: (calloutState integerRegisters at: 3)
  					with: (calloutState integerRegisters at: 4)
  					with: (calloutState integerRegisters at: 5).
  				sRetPtr := (self addressOf: sddRet) asVoidPointer].
  			 [2r01] ->
  				[sidRet := self 
  					dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'SixteenByteReturnID (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') 
  					with: (calloutState integerRegisters at: 0)
  					with: (calloutState integerRegisters at: 1)
  					with: (calloutState integerRegisters at: 2)
  					with: (calloutState integerRegisters at: 3)
  					with: (calloutState integerRegisters at: 4)
  					with: (calloutState integerRegisters at: 5).
  				sRetPtr := (self addressOf: sidRet) asVoidPointer].
  			 [2r10] ->
  				[sdiRet := self 
  					dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'SixteenByteReturnDI (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') 
  					with: (calloutState integerRegisters at: 0)
  					with: (calloutState integerRegisters at: 1)
  					with: (calloutState integerRegisters at: 2)
  					with: (calloutState integerRegisters at: 3)
  					with: (calloutState integerRegisters at: 4)
  					with: (calloutState integerRegisters at: 5).
  				sRetPtr := (self addressOf: sdiRet) asVoidPointer].
  			 [2r11] ->
  				[siiRet := self 
  					dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'SixteenByteReturnII (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') 
  					with: (calloutState integerRegisters at: 0)
  					with: (calloutState integerRegisters at: 1)
  					with: (calloutState integerRegisters at: 2)
  					with: (calloutState integerRegisters at: 3)
  					with: (calloutState integerRegisters at: 4)
  					with: (calloutState integerRegisters at: 5).
  				sRetPtr := (self addressOf: siiRet) asVoidPointer].
  			 [2r100] ->
  				[floatRet := self 
  					dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') 
  					with: (calloutState integerRegisters at: 0)
  					with: (calloutState integerRegisters at: 1)
  					with: (calloutState integerRegisters at: 2)
  					with: (calloutState integerRegisters at: 3)
  					with: (calloutState integerRegisters at: 4)
  					with: (calloutState integerRegisters at: 5).
  				sRetPtr := (self addressOf: floatRet) asVoidPointer].
  			 [2r101] ->
  				[intRet := self 
  					dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'sqInt (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') 
  					with: (calloutState integerRegisters at: 0)
  					with: (calloutState integerRegisters at: 1)
  					with: (calloutState integerRegisters at: 2)
  					with: (calloutState integerRegisters at: 3)
  					with: (calloutState integerRegisters at: 4)
  					with: (calloutState integerRegisters at: 5).
  				sRetPtr := (self addressOf: intRet) asVoidPointer].
  			 [2r110] ->
  				["return a pointer to alloca'd memory"
  				intRet := self 
  					dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'sqInt (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)')
  					with: (calloutState integerRegisters at: 0)
  					with: (calloutState integerRegisters at: 1)
  					with: (calloutState integerRegisters at: 2)
  					with: (calloutState integerRegisters at: 3)
  					with: (calloutState integerRegisters at: 4)
  					with: (calloutState integerRegisters at: 5).
  				sRetPtr := intRet asVoidPointer "address of struct is returned in RAX, which also is calloutState limit"]}
  		otherwise:
  			[interpreterProxy ownVM: myThreadIndex.
  			self ffiFail: FFIErrorWrongType. ^nil].
  
  	interpreterProxy ownVM: myThreadIndex.
  	^self ffiReturnStruct: sRetPtr ofType: (self ffiReturnType: specOnStack) in: calloutState!

Item was changed:
  ----- Method: ThreadedX64Win64FFIPlugin>>ffiCalloutTo:SpecOnStack:in: (in category 'callout support') -----
  ffiCalloutTo: procAddr SpecOnStack: specOnStack in: calloutState
  	<var: #procAddr type: #'void *'>
  	<var: #calloutState type: #'CalloutState *'>
  	<var: #loadFloatRegs declareC: 'extern void loadFloatRegs(double, double, double, double)'>
  	"Go out, call this guy and create the return value.  This *must* be inlined because of
  	 the alloca of the outgoing stack frame in ffiCall:WithFlags:NumArgs:Args:AndTypes:"
  	| myThreadIndex atomicType floatRet intRet |
  	<var: #floatRet type: #double>
  	<var: #intRet type: #usqLong>
  	<inline: #always>
  	myThreadIndex := interpreterProxy disownVM: (self disownFlagsFor: calloutState).
  
  	calloutState floatRegisterSignature > 0 ifTrue:
+ 		[self loadFloatRegs:
+ 			   (calloutState floatRegisters at: 0)
+ 			_: (calloutState floatRegisters at: 1)
+ 			_: (calloutState floatRegisters at: 2)
+ 			_: (calloutState floatRegisters at: 3)].
- 		[self 
- 			load: (calloutState floatRegisters at: 0)
- 			Flo: (calloutState floatRegisters at: 1)
- 			atR: (calloutState floatRegisters at: 2)
- 			egs: (calloutState floatRegisters at: 3)].
  
  	(self allocaLiesSoSetSpBeforeCall or: [self mustAlignStack]) ifTrue:
  		[self setsp: calloutState argVector].
  
  	atomicType := self atomicTypeOf: calloutState ffiRetHeader.
  	(atomicType >> 1) = (FFITypeSingleFloat >> 1) ifTrue:
  		[atomicType = FFITypeSingleFloat
  			ifTrue:
  				[floatRet := self 
  					dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') 
  					with: (calloutState integerRegisters at: 0)
  					with: (calloutState integerRegisters at: 1)
  					with: (calloutState integerRegisters at: 2)
  					with: (calloutState integerRegisters at: 3)]
  			ifFalse: "atomicType = FFITypeDoubleFloat"
  				[floatRet := self 
  					dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') 
  					with: (calloutState integerRegisters at: 0)
  					with: (calloutState integerRegisters at: 1)
  					with: (calloutState integerRegisters at: 2)
  					with: (calloutState integerRegisters at: 3)].
  
  		 "undo any callee argument pops because it may confuse stack management with the alloca."
  		 (self isCalleePopsConvention: calloutState callFlags) ifTrue:
  			[self setsp: calloutState argVector].
  		 interpreterProxy ownVM: myThreadIndex.
  
  		 ^interpreterProxy floatObjectOf: floatRet].
  
  	intRet := self 
  				dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqIntptr_t (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') 
  				with: (calloutState integerRegisters at: 0)
  				with: (calloutState integerRegisters at: 1)
  				with: (calloutState integerRegisters at: 2)
  				with: (calloutState integerRegisters at: 3).
  
  	"undo any callee argument pops because it may confuse stack management with the alloca."
  	(self isCalleePopsConvention: calloutState callFlags) ifTrue:
  		[self setsp: calloutState argVector].
  	interpreterProxy ownVM: myThreadIndex.
  
  	(calloutState ffiRetHeader anyMask: FFIFlagPointer+FFIFlagStructure) ifTrue:
  		["Note: Order is important here since FFIFlagPointer + FFIFlagStructure is used to represent
  		 'typedef void* VoidPointer' and VoidPointer must be returned as pointer *not* as struct."
  		 (calloutState ffiRetHeader anyMask: FFIFlagPointer) ifTrue:
  			[^self ffiReturnPointer: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState].
  		 ^self ffiReturnStruct: (self addressOf: intRet) ofType: (self ffiReturnType: specOnStack) in: calloutState].
  	
  	^self ffiCreateIntegralResultOop: intRet ofAtomicType: atomicType in: calloutState!



More information about the Vm-dev mailing list