[Vm-dev] VM Maker: VMMaker.oscog-eem.3233.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Aug 2 17:08:54 UTC 2022
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3233.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.3233
Author: eem
Time: 2 August 2022, 10:08:41.069769 am
UUID: 60028028-036a-4aca-a304-29e77d6adc7d
Ancestors: VMMaker.oscog-eem.3232
Slang:
Abstract checking for names defineAtCompileTime: so that the VMPluginCodeGenerator can ask the pluyginClass and ence that BytesPerWord is considered defined at compile time, except within the ThreadedFFIPlugins.
ThreadedFFIPlugin:
Now that ffiCall:ArgArrayOrNil:NumArgs: is inlined, also inline ffiReturnType:, avoiding unnecessary duplication.
=============== Diff against VMMaker.oscog-eem.3232 ===============
Item was added:
+ ----- Method: CCodeGenerator>>defineAtCompileTime: (in category 'C translation support') -----
+ defineAtCompileTime: name
+ ^(vmClass ifNil: VMBasicConstants) defineAtCompileTime: name!
Item was changed:
----- Method: CCodeGenerator>>emitCConstants:on: (in category 'C code generator') -----
emitCConstants: constList on: aStream
"Store the global variable declarations on the given stream."
constList isEmpty ifTrue: [^self].
aStream cr; nextPutAll: '/*** Constants ***/'; cr.
(self sortStrings: constList) do:
[:varName| | node default value |
node := constants at: varName.
node name isEmpty ifFalse:
["If the definition includes a C comment, or looks like a conditional, take it as is, otherwise convert
the value from Smalltalk to C.
Allow the class to provide an alternative definition, either of just the value or the whole shebang."
default := (node value isString
and: [(node value includesSubstring: '/*')
or: [(node value includesSubstring: ' ? ') and: [node value includesSubstring: ' : ']]])
ifTrue: [node value]
ifFalse: [self cLiteralFor: node value name: varName].
default = #undefined
ifTrue: [aStream nextPutAll: '#undef '; nextPutAll: node name; cr]
ifFalse:
[value := vmClass
ifNotNil:
[(vmClass specialValueForConstant: node name default: default)
ifNotNil: [:specialDef| specialDef]
ifNil: [default]]
ifNil: [default].
+ (self defineAtCompileTime: node name)
- ((vmClass ifNil: VMBasicConstants) defineAtCompileTime: node name)
ifTrue: [self putConditionalDefineOf: node name
as: value
comment: 'Allow this to be overridden on the compiler command line'
on: aStream]
ifFalse: [self putDefineOf: node name as: value on: aStream]]]].
aStream cr!
Item was changed:
----- Method: CCodeGenerator>>isConstantNode:valueInto: (in category 'utilities') -----
isConstantNode: aNode valueInto: aBlock
"Answer if aNode evaluates to a constant, and if so, evaluate aBlock with the value of that constant."
aNode isConstant ifTrue:
[(aNode isDefine
+ and: [self defineAtCompileTime: aNode name]) ifTrue:
- and: [(vmClass ifNil: [VMBasicConstants]) defineAtCompileTime: aNode name]) ifTrue:
[^false].
aBlock value: aNode value.
^true].
(aNode isVariable
and: [aNode name = #nil]) ifTrue:
[aBlock value: nil.
^true].
aNode isSend ifTrue:
[(self anyMethodNamed: aNode selector)
ifNil:
[(VMBasicConstants valueOfBasicSelector: aNode selector) ifNotNil:
[:value|
aBlock value: value.
^true].
aNode constantNumbericValueOrNil ifNotNil:
[:value|
aBlock value: value.
^true]]
ifNotNil:
[:m|
(m definedAsMacro not
and: [m statements size = 1
and: [m statements last isReturn]]) ifTrue:
[^self isConstantNode: m statements last expression valueInto: aBlock]]].
^false!
Item was changed:
----- Method: CCodeGenerator>>nilOrBooleanConditionFor: (in category 'utilities') -----
nilOrBooleanConditionFor: nodeOrNil
"If nodeOrNil is one of the conditional sends for which we do translation-time dead code elimination
(i.e. cppIf:ifTrue: et al or ifTrue: et al) and the conditional does evaluate to a translation-time
boolean constant, answer that constant, otherwise answer nil. Used to prune dead code,
either for code generaton or dead variable elimination."
generateDeadCode ifTrue: [^nil].
nodeOrNil ifNil:
[^nil].
nodeOrNil isSend ifFalse:
[^nil].
(#(ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue:) includes: nodeOrNil selector) ifTrue:
[^self nilOrBooleanConstantReceiverOf: nodeOrNil receiver].
(#(and: or:) includes: nodeOrNil selector) ifTrue:
[^self nilOrBooleanConstantReceiverOf: nodeOrNil].
(#(cppIf:ifTrue: cppIf:ifTrue:ifFalse:) includes: nodeOrNil selector) ifTrue:
[| maybeName value |
(vmClass notNil
and: [nodeOrNil args first isConstant
and: [(value := nodeOrNil args first value) isSymbol
+ and: [(self defineAtCompileTime: value) not
- and: [((vmClass ifNil: [VMBasicConstants]) defineAtCompileTime: value) not
and: [(vmClass bindingOf: value) notNil]]]]) ifTrue:
[self logger
nextPutAll: 'Warning: cppIf: reference to ';
store: value;
nextPutAll: ' when variable of same name exists.'; cr].
maybeName := nodeOrNil args first isConstant ifTrue:
[nodeOrNil args first nameOrValue].
^(optionsDictionary notNil
and: [nodeOrNil args first isConstant
and: [(#(true false) includes: (optionsDictionary at: maybeName ifAbsent: [nil]))
+ and: [(self defineAtCompileTime: maybeName) not]]]) ifTrue:
- and: [((vmClass ifNil: [VMBasicConstants]) defineAtCompileTime: maybeName) not]]]) ifTrue:
[optionsDictionary at: nodeOrNil args first name]].
^nil!
Item was changed:
----- Method: CCodeGenerator>>shouldIncludeMethodFor:selector: (in category 'utilities') -----
shouldIncludeMethodFor: aClass selector: selector
"Answer whether a method should be translated. Process optional methods by
interpreting the argument to the option: pragma as either a Cogit class name
or a class variable name or a variable name in VMBasicConstants. Exclude
methods with the doNotGenerate pragma."
| options notOptions |
(aClass >> selector pragmaAt: #doNotGenerate) ifNotNil:
[^false].
"where is pragmasAt: ??"
options := (aClass >> selector) pragmas select: [:p| p keyword == #option:] thenCollect: [:p| p argumentAt: 1].
notOptions := (aClass >> selector) pragmas select: [:p| p keyword == #notOption:] thenCollect: [:p| p argumentAt: 1].
(options notEmpty or: [notOptions notEmpty]) ifTrue:
+ ["Anything defined at compile time must be included."
+ ((options anySatisfy: [:option| self defineAtCompileTime: option])
+ or: [notOptions anySatisfy: [:option| self defineAtCompileTime: option]]) ifTrue:
- ["Anything defined at compile tiome must be included."
- ((options anySatisfy: [:option| (vmClass ifNil: [VMBasicConstants]) defineAtCompileTime: option])
- or: [notOptions anySatisfy: [:option| (vmClass ifNil: [VMBasicConstants]) defineAtCompileTime: option]]) ifTrue:
[^true].
"We have to include the method if either
- any one of the options is false (because we want #if option...)
- any one of the notOptions is true (because we want #if !!option...)
- all of the options is true and all of the notOptions are false (because they have all been satisfied)"
^((options anySatisfy: [:option| (self optionIsTrue: option in: aClass) not])
and: [notOptions anySatisfy: [:option| (self optionIsFalse: option in: aClass) not]])
or: [(options allSatisfy: [:option| self optionIsTrue: option in: aClass])
and: [notOptions allSatisfy: [:option| self optionIsFalse: option in: aClass]]]].
^true!
Item was added:
+ ----- Method: InterpreterPlugin class>>defineAtCompileTime: (in category 'translation') -----
+ defineAtCompileTime: name
+ "BytesPerWord is defined at compile time for most plugins."
+ ^name = #BytesPerWord
+ or: [VMBasicConstants defineAtCompileTime: name]!
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 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:
+ [| returnType |
+ "Note: Order is important here since FFIFlagPointer + FFIFlagStructure is used to represent
- ["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."
+ returnType := self ffiReturnType: specOnStack.
(calloutState ffiRetHeader anyMask: FFIFlagPointer) ifTrue:
+ [^self ffiReturnPointer: intRet ofType: returnType in: calloutState].
+ ^self ffiReturnStruct: (self addressOf: intRet) ofType: returnType in: calloutState].
- [^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: ThreadedARM64FFIPlugin>>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 structRet specSize |
<var: #floatRet type: 'union { struct { float floats[8]; } f; struct dprr { double doubles[4]; } d; }'>
<var: #structRet type: #SixteenByteReturnII>
<var: #intRet type: #usqLong>
<inline: #always>
self cCode: [] inSmalltalk: [floatRet := ByteArray new: 32]. "Just a hack to placate the Smalltalk compiler; these should be proper struct types..."
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 allocaLiesSoSetSpBeforeCall or: [self mustAlignStack]) ifTrue:
[self setsp: calloutState argVector].
atomicType := self atomicTypeOf: calloutState ffiRetHeader.
((atomicType >> 1) = (FFITypeSingleFloat >> 1)
or: [(calloutState ffiRetHeader bitAnd: FFIFlagPointer+FFIFlagStructure) = FFIFlagStructure
and: [self structIsHomogenousFloatArrayOfSize: (calloutState ffiRetHeader bitAnd: FFIStructSizeMask)
typeSpec: (self cCoerce: (interpreterProxy firstIndexableField: calloutState ffiRetSpec) to: #'unsigned int *')
ofLength: (specSize := interpreterProxy byteSizeOf: calloutState ffiRetSpec) / (self sizeof: #'unsigned int')]]) ifTrue:
[floatRet d: (self
dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'struct dprr (*)(sqIntptr_t, sqIntptr_t, 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)
with: (calloutState integerRegisters at: 6)
with: (calloutState integerRegisters at: 7)).
"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.
atomicType = FFITypeDoubleFloat ifTrue:
[^interpreterProxy floatObjectOf: (floatRet d doubles at: 0)].
atomicType = FFITypeSingleFloat ifTrue:
[^interpreterProxy floatObjectOf: (floatRet f floats at: 0)].
"If the struct is a vector of floats then move float[2] to float[1], float[4] to float[2] and float[6] to float[3],
to pack the float data in the double fields. We can tell if the struct is composed of floats if its size is less
than the spec size, since the spec size is (1 + n fields) * 4 bytes, and the struct size is n fields * 4 bytes
for floats and n fields * 8 bytes for doubles. We can't access the spec post call because it may have moved."
specSize > calloutState structReturnSize ifTrue:
[floatRet f floats at: 1 put: (floatRet f floats at: 2).
floatRet f floats at: 2 put: (floatRet f floats at: 4).
floatRet f floats at: 3 put: (floatRet f floats at: 6)].
^self ffiReturnStruct: (self addressOf: floatRet) ofType: (self ffiReturnType: specOnStack) in: calloutState].
"Integer and Structure returns..."
"If struct address used for return value, call is special; struct return pointer must be in x8"
(self mustReturnStructOnStack: calloutState structReturnSize)
ifTrue:
[intRet := 0.
self setReturnRegister: (self cCoerceSimple: calloutState limit to: #sqLong) "stack alloca'd struct"
andCall: (self cCoerceSimple: procAddr to: #sqLong)
withArgsArray: (self cCoerceSimple: (self addressOf: calloutState integerRegisters) to: #sqLong)]
ifFalse:
[structRet := self
dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'SixteenByteReturnII (*)(sqIntptr_t, sqIntptr_t, 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)
with: (calloutState integerRegisters at: 6)
with: (calloutState integerRegisters at: 7).
intRet := structRet a]. "X1"
"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:
+ [| returnType |
+ "Note: Order is important here since FFIFlagPointer + FFIFlagStructure is used to represent
- ["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."
+ returnType := self ffiReturnType: specOnStack.
(calloutState ffiRetHeader anyMask: FFIFlagPointer) ifTrue:
+ [^self ffiReturnPointer: intRet ofType: returnType in: calloutState].
- [^self ffiReturnPointer: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState].
^self ffiReturnStruct: (((self returnStructInRegisters: calloutState)
ifTrue: [self cCoerceSimple: (self addressOf: structRet) to: #'char *']
ifFalse: [calloutState limit]))
+ ofType: returnType
- ofType: (self ffiReturnType: specOnStack)
in: calloutState].
^self ffiCreateIntegralResultOop: intRet ofAtomicType: atomicType in: calloutState!
Item was added:
+ ----- Method: ThreadedFFIPlugin class>>defineAtCompileTime: (in category 'translation') -----
+ defineAtCompileTime: name
+ "BytesPerWord is defined at compile time for most plugins, but not for the FFI plugins."
+ ^VMBasicConstants defineAtCompileTime: name!
Item was changed:
----- Method: ThreadedFFIPlugin>>ffiReturnType: (in category 'symbol loading') -----
ffiReturnType: specOnStack
"Answer the return type object for the current invocation"
+ <inline: #always>
| specLiteral argTypes |
specLiteral := specOnStack
ifTrue: [interpreterProxy stackValue: 1]
ifFalse: [interpreterProxy literal: 0 ofMethod: interpreterProxy primitiveMethod].
argTypes := interpreterProxy fetchPointer: ExternalFunctionArgTypesIndex ofObject: specLiteral.
^interpreterProxy fetchPointer: 0 ofObject: argTypes!
Item was changed:
----- Method: ThreadedIA32FFIPlugin>>ffiCalloutTo:SpecOnStack:in: (in category 'callout support') -----
ffiCalloutTo: procAddr SpecOnStack: specOnStack in: calloutState
<var: #procAddr type: #'void *'>
<var: #calloutState type: #'CalloutState *'>
"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> "Support up to int64_t or uint64_t"
<inline: #always>
myThreadIndex := interpreterProxy disownVM: (self disownFlagsFor: calloutState).
(self allocaLiesSoSetSpBeforeCall or: [self mustAlignStack]) ifTrue:
[self setsp: calloutState argVector].
atomicType := self atomicTypeOf: calloutState ffiRetHeader.
(atomicType >> 1) = (FFITypeSingleFloat >> 1) ifTrue:
[floatRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)()').
"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: 'usqLong (*)()').
"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:
+ [| returnType |
+ "Note: Order is important here since FFIFlagPointer + FFIFlagStructure is used to represent
- ["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."
+ returnType := self ffiReturnType: specOnStack.
(calloutState ffiRetHeader anyMask: FFIFlagPointer) ifTrue:
+ [^self ffiReturnPointer: intRet ofType: returnType in: calloutState].
+ ^self ffiReturnStruct: (self addressOf: intRet) ofType: returnType in: calloutState].
- [^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: ThreadedRiscV64FFIPlugin>>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 structRet specSize |
<var: #doubleRet type: #double>
<var: #floatRet type: 'union { struct { float floats[8]; } f; struct dprr { double doubles[4]; } d; }'>
<var: #structRet type: #SixteenByteReturnII>
<var: #intRet type: #usqLong>
<inline: #always>
self cCode: [] inSmalltalk: [floatRet := ByteArray new: 32]. "Just a hack to placate the Smalltalk compiler; these should be proper struct types..."
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 allocaLiesSoSetSpBeforeCall or: [self mustAlignStack]) ifTrue:
[self setsp: calloutState argVector].
"float or double returns"
atomicType := self atomicTypeOf: calloutState ffiRetHeader.
(atomicType >> 1) = (FFITypeSingleFloat >> 1) ifTrue:
[| doubleRet |
atomicType = FFITypeDoubleFloat ifTrue:
[doubleRet := (self
dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, sqIntptr_t, 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)
with: (calloutState integerRegisters at: 6)
with: (calloutState integerRegisters at: 7))]
ifFalse:
[doubleRet := (self
dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, sqIntptr_t, 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)
with: (calloutState integerRegisters at: 6)
with: (calloutState integerRegisters at: 7))].
"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.
^self floatObjectOf: doubleRet].
"homogenous array of float/double returns"
((calloutState ffiRetHeader bitAnd: FFIFlagPointer+FFIFlagStructure) = FFIFlagStructure
and: [self structIsHomogenousFloatArrayOfSize: (calloutState ffiRetHeader bitAnd: FFIStructSizeMask)
typeSpec: (self cCoerce: (interpreterProxy firstIndexableField: calloutState ffiRetSpec) to: #'unsigned int *')
ofLength: (specSize := interpreterProxy byteSizeOf: calloutState ffiRetSpec) / (self sizeof: #'unsigned int')]) ifTrue:
[floatRet d: (self
dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'struct dprr (*)(sqIntptr_t, sqIntptr_t, 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)
with: (calloutState integerRegisters at: 6)
with: (calloutState integerRegisters at: 7)).
"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.
"If the struct is a vector of floats then move float[2] to float[1], float[4] to float[2] and float[6] to float[3],
to pack the float data in the double fields. We can tell if the struct is composed of floats if its size is less
than the spec size, since the spec size is (1 + n fields) * 4 bytes, and the struct size is n fields * 4 bytes
for floats and n fields * 8 bytes for doubles. We can't access the spec post call because it may have moved."
specSize > calloutState structReturnSize ifTrue:
[floatRet f floats at: 1 put: (floatRet f floats at: 2).
floatRet f floats at: 2 put: (floatRet f floats at: 4).
floatRet f floats at: 3 put: (floatRet f floats at: 6)].
^self ffiReturnStruct: (self addressOf: floatRet) ofType: (self ffiReturnType: specOnStack) in: calloutState].
"Integer and Structure returns..."
(self mustReturnStructOnStack: calloutState structReturnSize)
ifTrue:
[intRet := 0.
self setReturnRegister: (self cCoerceSimple: calloutState limit to: #sqLong) "stack alloca'd struct"
andCall: (self cCoerceSimple: procAddr to: #sqLong)
withArgsArray: (self cCoerceSimple: (self addressOf: calloutState integerRegisters) to: #sqLong)]
ifFalse:
[structRet := self
dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'SixteenByteReturnII (*)(sqIntptr_t, sqIntptr_t, 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)
with: (calloutState integerRegisters at: 6)
with: (calloutState integerRegisters at: 7).
intRet := structRet a]. "X1"
"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:
+ [| returnType |
+ "Note: Order is important here since FFIFlagPointer + FFIFlagStructure is used to represent
- ["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."
+ returnType := self ffiReturnType: specOnStack.
(calloutState ffiRetHeader anyMask: FFIFlagPointer) ifTrue:
+ [^self ffiReturnPointer: intRet ofType: returnType in: calloutState].
- [^self ffiReturnPointer: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState].
^self ffiReturnStruct: (((self returnStructInRegisters: calloutState)
ifTrue: [self cCoerceSimple: (self addressOf: structRet) to: #'char *']
ifFalse: [calloutState limit]))
+ ofType: returnType
- ofType: (self ffiReturnType: specOnStack)
in: calloutState].
^self ffiCreateIntegralResultOop: intRet ofAtomicType: atomicType 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 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:
+ [| returnType |
+ "Note: Order is important here since FFIFlagPointer + FFIFlagStructure is used to represent
- ["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."
+ returnType := self ffiReturnType: specOnStack.
(calloutState ffiRetHeader anyMask: FFIFlagPointer) ifTrue:
+ [^self ffiReturnPointer: intRet ofType: returnType in: calloutState].
+ ^self ffiReturnStruct: (self addressOf: intRet) ofType: returnType in: calloutState].
- [^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 added:
+ ----- Method: VMPluginCodeGenerator>>defineAtCompileTime: (in category 'C translation support') -----
+ defineAtCompileTime: name
+ ^pluginClass
+ ifNotNil: [:pc| pc defineAtCompileTime: name]
+ ifNil: [super defineAtCompileTime: name]!
More information about the Vm-dev
mailing list