[Vm-dev] VM Maker: VMMaker.oscogLLP64-nice.1983.mcz
commits at source.squeak.org
commits at source.squeak.org
Sun Nov 6 20:59:04 UTC 2016
Nicolas Cellier uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscogLLP64-nice.1983.mcz
==================== Summary ====================
Name: VMMaker.oscogLLP64-nice.1983
Author: nice
Time: 6 November 2016, 9:57:28.22625 pm
UUID: 40de0ca4-1f11-4afe-a938-2384056c979b
Ancestors: VMMaker.oscog-nice.1982
Rebase remaining LLP64 changes on VMMaker.oscog-nice.1982
These changes are not strictly necessary and may have side effects on code generation, so they will eventually be introduced later.
Mainly:
- forbid usage of 'long' and 'unsigned long' in VMMaker since they are ambiguous.
- correctly generateShiftLeft: for plugins too: we can't rely on (vmClass objectMemoryClass wordSize), because a plugin #isForBoth32Or64Bits
- correctly generateShiftRight: by using appropriate unsigned type. Prepare for casting back to original type after shift, but do not apply yet, it uncovers a bug currently...
- correctly generateIntegerObjectOf: without UB, that is with usqInt cast.
- apply same optimization as #positive32BitIntegerFor: to positive32BitValueOf: and signed32BitValueOf: for 64bits
- avoid using loadFloatRegs hack in FFI: there are only 16 different combinations of floating point/integer register in X64 Win64, so explicitely handle them with a switch.
- Fix FFI preamble: X64 may need to getsp/setsp and WIN64 PLATFORM_API_USES_CALLEE_POPS_CONVENTION
=============== Diff against VMMaker.oscog-nice.1982 ===============
Item was changed:
----- Method: CCodeGenerator>>generateIntegerObjectOf:on:indent: (in category 'C translation') -----
generateIntegerObjectOf: msgNode on: aStream indent: level
"Generate the C code for this message onto the given stream."
+ | expr mustCastToUnsigned type typeIsUnsigned |
- | expr castToSqint |
expr := msgNode args first.
aStream nextPutAll: '(('.
"Note that the default type of an integer constant in C is int. Hence we /must/
+ cast expression to long if in the 64-bit world, since e.g. in 64-bits
- cast constants to long if in the 64-bit world, since e.g. in 64-bits
(int)(16r1FFFFF << 3) = (int)16rFFFFFFF8 = -8
whereas
(long)(16r1FFFFF << 3) = (long) 16rFFFFFFF8 = 4294967288."
+ type := self typeFor: expr in: currentMethod.
+ typeIsUnsigned := type first = $u.
+ mustCastToUnsigned := typeIsUnsigned not
+ or: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqInt)].
+ mustCastToUnsigned ifTrue:
+ [aStream nextPutAll: '(usqInt)'].
- castToSqint := expr isConstant and: [vmClass isNil or: [vmClass objectMemoryClass wordSize = 8]].
- castToSqint ifTrue:
- [aStream nextPutAll: '(sqInt)'].
self emitCExpression: expr on: aStream.
aStream
nextPutAll: ' << ';
print: vmClass objectMemoryClass numSmallIntegerTagBits;
nextPutAll: ') | 1)'!
Item was changed:
----- Method: CCodeGenerator>>generateShiftLeft:on:indent: (in category 'C translation') -----
generateShiftLeft: msgNode on: aStream indent: level
"Generate a C bitShift. If we can determine the result
would overflow the word size, cast to a long integer."
| rcvr arg castToLong type mustCastBackToSign mustCastToUnsigned canSuffixTheConstant typeIsUnsigned |
rcvr := msgNode receiver.
arg := msgNode args first.
castToLong := false.
rcvr constantNumbericValueOrNil ifNotNil:
[:rcvrVal |
arg constantNumbericValueOrNil
+ ifNil: [castToLong := self isForBoth32Or64Bits or: [vmClass notNil and: [vmClass objectMemoryClass wordSize = 8]]]
- ifNil: [castToLong := vmClass notNil and: [vmClass objectMemoryClass wordSize = 8]]
ifNotNil:
[:argVal |
| valueBeyondInt |
valueBeyondInt := 1 bitShift: 32. "The default type of const << N is int."
castToLong := rcvrVal < valueBeyondInt
and: [(rcvrVal bitShift: argVal) >= valueBeyondInt]]].
canSuffixTheConstant := rcvr isConstant and: [rcvr name isEmpty and: [rcvr value >= 0]].
canSuffixTheConstant
ifTrue:
[aStream nextPutAll: (self cLiteralForUnsignedInteger: rcvr value longlong: castToLong).
aStream nextPutAll: ' << '.
self emitCExpression: arg on: aStream indent: level.
^self].
type := self typeFor: rcvr in: currentMethod.
castToLong := castToLong and: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong)].
typeIsUnsigned := type first = $u.
mustCastToUnsigned := typeIsUnsigned not
or: [castToLong
or: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqInt)]].
mustCastBackToSign := typeIsUnsigned not.
mustCastBackToSign
ifTrue:
[| promotedType |
promotedType := castToLong
ifTrue: [#sqLong]
ifFalse: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #sqInt)
ifTrue: [#sqInt]
ifFalse: [type]].
aStream nextPutAll: '(('; nextPutAll: promotedType; nextPut: $)].
mustCastToUnsigned
ifTrue:
[| unsigned |
unsigned := castToLong
ifTrue: [#usqLong]
ifFalse: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong)
ifTrue: [#usqInt]
ifFalse: [self unsignedTypeForIntegralType: type]].
aStream nextPutAll: '(('; nextPutAll: unsigned; nextPutAll: ')('].
self emitCExpression: rcvr on: aStream indent: level.
mustCastToUnsigned ifTrue: [aStream nextPut: $)].
aStream nextPutAll: ' << '.
self emitCExpression: arg on: aStream indent: level.
mustCastToUnsigned ifTrue: [aStream nextPut: $)].
mustCastBackToSign ifTrue: [aStream nextPut: $)].!
Item was changed:
----- Method: CCodeGenerator>>generateShiftRight:on:indent: (in category 'C translation') -----
generateShiftRight: msgNode on: aStream indent: level
"Generate the C code for this message onto the given stream."
+ | type isUnsigned mustCastBackToSigned mustCastToUnsigned |
- | type |
"If the variable is a 64-bit type then don't cast it to usqInt (typically a 32-bit type)"
+ type := self typeFor: msgNode receiver in: currentMethod.
+ isUnsigned := type first = $u.
+ mustCastToUnsigned := isUnsigned not.
+ mustCastBackToSigned := false "isUnsigned not". "FOR COMPATIBILITY WITH OLDER BEHAVIOUR, THIS MUST BE SO..."
+
+ "If not unsigned, cast it to unsigned, and eventually cast the result back to original type."
+ mustCastBackToSigned ifTrue:
+ [aStream nextPut: $(; nextPut: $(; nextPutAll: type; nextPut: $)].
+ mustCastToUnsigned ifTrue:
+ [aStream nextPut: $(; nextPut: $(; nextPutAll: (self unsignedTypeForIntegralType: type); nextPut: $)].
+ self emitCExpression: msgNode receiver on: aStream indent: level.
+ mustCastToUnsigned ifTrue:
+ [aStream nextPut: $)].
- (self is64BitIntegralVariable: msgNode receiver typeInto: [:t| type := t])
- ifTrue:
- ["If not unsigned cast it to unsigned."
- type first ~= $u ifTrue:
- [aStream nextPutAll: '((unsigned '; nextPutAll: type; nextPut: $)].
- self emitCExpression: msgNode receiver on: aStream indent: level.
- type first ~= $u ifTrue:
- [aStream nextPut: $)]]
- ifFalse:
- [aStream nextPutAll: '((usqInt) '.
- self emitCExpression: msgNode receiver on: aStream indent: level.
- aStream nextPut: $)].
aStream nextPutAll: ' >> '.
+ self emitCExpression: msgNode args first on: aStream indent: level.
+ mustCastBackToSigned ifTrue:
+ [aStream nextPut: $)]!
- self emitCExpression: msgNode args first on: aStream indent: level!
Item was added:
+ ----- Method: CCodeGenerator>>isForBoth32Or64Bits (in category 'testing') -----
+ isForBoth32Or64Bits
+ "Answer true if the code is generated for both 32 and 64 bits.
+ Answer false otherwise.
+ Currently, VM source is generated for specific WordSize.
+ But plugins source are generated in common directory for both."
+
+ ^self isGeneratingPluginCode!
Item was changed:
----- Method: CCodeGenerator>>sizeOfIntegralCType: (in category 'inlining') -----
sizeOfIntegralCType: anIntegralCType "<String>"
"N.B. Only works for values for which isIntegralCType: answers true."
| prunedCType index |
(anIntegralCType beginsWith: 'register ') ifTrue:
[^self sizeOfIntegralCType: (anIntegralCType allButFirst: 9)].
prunedCType := (anIntegralCType beginsWith: 'unsigned ')
ifTrue: [(anIntegralCType allButFirst: 9) withBlanksTrimmed]
ifFalse: [(anIntegralCType beginsWith: 'signed ')
ifTrue: [(anIntegralCType allButFirst: 7) withBlanksTrimmed]
ifFalse: [anIntegralCType]].
^prunedCType asString caseOf: {
['sqLong'] -> [8].
['usqLong'] -> [8].
['long long'] -> [8].
['sqInt'] -> [BytesPerOop].
['usqInt'] -> [BytesPerOop].
['sqIntptr_t'] -> [BytesPerWord].
['usqIntptr_t'] -> [BytesPerWord].
['int'] -> [4].
['short'] -> [2].
['short int'] -> [2].
['char'] -> [1].
- ['long'] -> [BytesPerWord]. "It's ambiguous on LLP64 and we'll later remove it"
['size_t'] -> [BytesPerWord].
['pid_t'] -> [BytesPerWord].
}
otherwise:
+ [prunedCType = #long ifTrue: [self error: 'long is ambiguous on 64bits architecture, don''t use it'. ^BytesPerWord].
+ ((anIntegralCType beginsWith: 'unsigned') "e.g. 'unsigned : 8'"
- [((anIntegralCType beginsWith: 'unsigned') "e.g. 'unsigned : 8'"
and: [(anIntegralCType includesAnyOf: '[*]') not
and: [(index := anIntegralCType indexOf: $:) > 0]])
ifTrue: [(Integer readFrom: (anIntegralCType copyFrom: index + 1 to: anIntegralCType size) withBlanksTrimmed readStream) + 7 // 8]
ifFalse: [self error: 'unrecognized integral type']]!
Item was changed:
----- Method: InterpreterPlugin>>sizeof: (in category 'simulation support') -----
sizeof: objectSymbolOrClass
<doNotGenerate>
- objectSymbolOrClass isInteger ifTrue:
- [^interpreterProxy wordSize].
objectSymbolOrClass isSymbol ifTrue:
["In the simulator file handles are just integer indices into openFiles and so need
only be BytesPerWord big. But in the actual VM they are at least 5 words long."
objectSymbolOrClass == #SQFile ifTrue:
[^interpreterProxy wordSize * 5].
"SQSocket is typedef struct { int sessionID; int socketType; void *privateSocketPtr; } SQSocket"
objectSymbolOrClass == #SQSocket ifTrue:
[^8 + interpreterProxy wordSize].
"We assume the file offset type is always 64-bits."
objectSymbolOrClass == #squeakFileOffsetType ifTrue:
[^8].
(objectSymbolOrClass last == $*
- or: [#long == objectSymbolOrClass
- or: [#'unsigned long' == objectSymbolOrClass
or: [#'sqIntptr_t' == objectSymbolOrClass
or: [#'usqIntptr_t' == objectSymbolOrClass
+ or: [#'size_t' == objectSymbolOrClass]]]) ifTrue:
- or: [#'size_t' == objectSymbolOrClass]]]]]) ifTrue:
[^interpreterProxy wordSize].
(#(usqInt sqInt) includes: objectSymbolOrClass) ifTrue:
[^interpreterProxy bytesPerOop]].
^super sizeof: objectSymbolOrClass!
Item was added:
+ ----- Method: InterpreterPrimitives>>maybeInlinePositive32BitValueOf: (in category 'primitive support') -----
+ maybeInlinePositive32BitValueOf: oop
+ "Convert the given object into an integer value.
+ The object may be either a positive SmallInteger or a four-byte LargePositiveInteger."
+ <notOption: #Spur64BitMemoryManager>
+ <returnTypeC: #'unsigned int'>
+ | value ok sz |
+ (objectMemory isIntegerObject: oop) ifTrue:
+ [value := objectMemory integerValueOf: oop.
+ (value < 0) ifTrue:
+ [self primitiveFail. value := 0].
+ ^value].
+
+ (objectMemory isNonIntegerImmediate: oop)
+ ifTrue:
+ [self primitiveFail.
+ ^0]
+ ifFalse:
+ [ok := objectMemory
+ isClassOfNonImm: oop
+ equalTo: (objectMemory splObj: ClassLargePositiveInteger)
+ compactClassIndex: ClassLargePositiveIntegerCompactIndex.
+ ok ifFalse:
+ [self primitiveFail.
+ ^0].
+ sz := objectMemory numBytesOfBytes: oop.
+ sz > 4 ifTrue:
+ [self primitiveFail.
+ ^0].
+ ^self cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop)) to: #'unsigned int']!
Item was added:
+ ----- Method: InterpreterPrimitives>>noInlineSigned32BitValueOf: (in category 'primitive support') -----
+ noInlineSigned32BitValueOf: oop
+ "Convert the given object into an integer value.
+ The object may be either a SmallInteger or a four-byte LargeInteger."
+ | value negative ok magnitude |
+ <notOption: #Spur64BitMemoryManager>
+ <inline: false>
+ <returnTypeC: #int>
+ <var: #value type: #int>
+ <var: #magnitude type: #'unsigned int'>
+ self deny: objectMemory hasSixtyFourBitImmediates.
+ (objectMemory isIntegerObject: oop) ifTrue:
+ [^objectMemory integerValueOf: oop].
+
+ (objectMemory isNonIntegerImmediate: oop) ifTrue:
+ [self primitiveFail.
+ ^0].
+
+ ok := objectMemory
+ isClassOfNonImm: oop
+ equalTo: (objectMemory splObj: ClassLargePositiveInteger)
+ compactClassIndex: ClassLargePositiveIntegerCompactIndex.
+ ok
+ ifTrue: [negative := false]
+ ifFalse:
+ [negative := true.
+ ok := objectMemory isClassOfNonImm: oop
+ equalTo: (objectMemory splObj: ClassLargeNegativeInteger)
+ compactClassIndex: ClassLargeNegativeIntegerCompactIndex.
+ ok ifFalse:
+ [self primitiveFail.
+ ^0]].
+ (objectMemory numBytesOfBytes: oop) > 4 ifTrue:
+ [^self primitiveFail].
+
+ magnitude := self cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop)) to: #'unsigned int'.
+
+ (negative
+ ifTrue: [magnitude > 16r80000000]
+ ifFalse: [magnitude >= 16r80000000])
+ ifTrue:
+ [self primitiveFail.
+ ^0].
+ negative
+ ifTrue: [value := 0 - magnitude]
+ ifFalse: [value := magnitude].
+ ^value!
Item was changed:
----- Method: InterpreterPrimitives>>positive32BitValueOf: (in category 'primitive support') -----
positive32BitValueOf: oop
"Convert the given object into an integer value.
The object may be either a positive SmallInteger or a four-byte LargePositiveInteger."
+ <returnTypeC: #'unsigned int'>
+ objectMemory hasSixtyFourBitImmediates
- <returnTypeC: #usqInt>
- | value ok sz |
- (objectMemory isIntegerObject: oop) ifTrue:
- [value := objectMemory integerValueOf: oop.
- (value < 0
- or: [objectMemory wordSize > 4
- and: [self cCode: [(self cCoerceSimple: value to: #'unsigned int') ~= value]
- inSmalltalk: [value >> 32 ~= 0]]]) ifTrue:
- [self primitiveFail. value := 0].
- ^value].
-
- (objectMemory hasSixtyFourBitImmediates
- or: [objectMemory isNonIntegerImmediate: oop])
ifTrue:
+ [(objectMemory isIntegerObject: oop) ifTrue:
+ [| value64 |
+ value64 := objectMemory integerValueOf: oop.
+ (value64 < 0
+ or: [self cCode: [(self cCoerceSimple: value64 to: #'unsigned int') ~= value64]
+ inSmalltalk: [value64 >> 32 ~= 0]]) ifTrue:
+ [self primitiveFail. value64 := 0].
+ ^value64].
+ self primitiveFail.
+ ^0]
- [self primitiveFail.
- ^0]
ifFalse:
+ [^self maybeInlinePositive32BitValueOf: oop]!
- [ok := objectMemory
- isClassOfNonImm: oop
- equalTo: (objectMemory splObj: ClassLargePositiveInteger)
- compactClassIndex: ClassLargePositiveIntegerCompactIndex.
- ok ifFalse:
- [self primitiveFail.
- ^0].
- sz := objectMemory numBytesOfBytes: oop.
- sz > 4 ifTrue:
- [self primitiveFail.
- ^0].
- ^self cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop)) to: #'unsigned int']!
Item was changed:
----- Method: InterpreterPrimitives>>signed32BitValueOf: (in category 'primitive support') -----
signed32BitValueOf: oop
"Convert the given object into an integer value.
+ The object may be either a SmallInteger or a four-byte LargeInteger."
- The object may be either a positive SmallInteger or a four-byte LargeInteger."
- | value negative ok magnitude |
- <inline: false>
<returnTypeC: #int>
+
+ objectMemory hasSixtyFourBitImmediates
+ ifTrue:
+ [(objectMemory isIntegerObject: oop) ifTrue:
- <var: #value type: #int>
- <var: #magnitude type: #'unsigned int'>
- <var: #value64 type: #long>
- (objectMemory isIntegerObject: oop) ifTrue:
- [objectMemory wordSize = 4
- ifTrue:
- [^objectMemory integerValueOf: oop]
- ifFalse: "Must fail for SmallIntegers with digitLength > 4"
[| value64 |
value64 := objectMemory integerValueOf: oop.
(self cCode: [(self cCoerceSimple: value64 to: #int) ~= value64]
inSmalltalk: [value64 >> 31 ~= 0 and: [value64 >> 31 ~= -1]]) ifTrue:
[self primitiveFail. value64 := 0].
+ ^value64].
+ self primitiveFail.
+ ^0]
- ^value64]].
-
- (objectMemory isNonIntegerImmediate: oop) ifTrue:
- [self primitiveFail.
- ^0].
-
- ok := objectMemory
- isClassOfNonImm: oop
- equalTo: (objectMemory splObj: ClassLargePositiveInteger)
- compactClassIndex: ClassLargePositiveIntegerCompactIndex.
- ok
- ifTrue: [negative := false]
ifFalse:
+ [^self noInlineSigned32BitValueOf: oop]!
- [negative := true.
- ok := objectMemory isClassOfNonImm: oop
- equalTo: (objectMemory splObj: ClassLargeNegativeInteger)
- compactClassIndex: ClassLargeNegativeIntegerCompactIndex.
- ok ifFalse:
- [self primitiveFail.
- ^0]].
- (objectMemory numBytesOfBytes: oop) > 4 ifTrue:
- [^self primitiveFail].
-
- magnitude := self cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop)) to: #'unsigned int'.
-
- (negative
- ifTrue: [magnitude > 16r80000000]
- ifFalse: [magnitude >= 16r80000000])
- ifTrue:
- [self primitiveFail.
- ^0].
- negative
- ifTrue: [value := 0 - magnitude]
- ifFalse: [value := magnitude].
- ^value!
Item was changed:
----- Method: InterpreterProxy>>ioLoadSymbol:OfLength:FromModule: (in category 'FFI support') -----
ioLoadSymbol: functionNameIndex OfLength: functionLength FromModule: moduleHandle
<returnTypeC: #'void *'>
+ <var: 'moduleHandle' type: #'void *'>
"Dummy - provided by support code"
^0!
Item was changed:
----- Method: LargeIntegersPlugin>>anyBitOfLargeInt:from:to: (in category 'util') -----
anyBitOfLargeInt: anOop from: start to: stopArg
"Argument has to be a Large Integer!!"
"Tests for any magnitude bits in the interval from start to stopArg."
| magnitude stop firstDigitIx lastDigitIx firstMask lastMask |
<var: #digit type: #'unsigned int'>
<var: #firstMask type: #'unsigned int'>
<var: #lastMask type: #'unsigned int'>
<var: #firstDigitIx type: #usqInt>
<var: #lastDigitIx type: #usqInt>
<var: #ix type: #usqInt>
self
debugCode: [self msg: 'anyBitOfLargeInt: anOop from: start to: stopArg'].
start < 1 | (stopArg < 1)
ifTrue: [^ interpreterProxy primitiveFail].
magnitude := anOop.
stop := stopArg min: (self highBitOfLargeInt: magnitude).
start > stop
ifTrue: [^ false].
firstDigitIx := start - 1 // 32 + 1.
lastDigitIx := stop - 1 // 32 + 1.
+ firstMask := 16rFFFFFFFF << (start - 1 bitAnd: 31).
- firstMask := 16rFFFFFFFF asUnsignedLong << (start - 1 bitAnd: 31). "Note asUnsignedLong required to avoid ULLL suffix bug"
lastMask := 16rFFFFFFFF >> (31 - (stop - 1 bitAnd: 31)).
firstDigitIx = lastDigitIx
ifTrue: [| digit |
digit := self unsafeDigitOfLargeInt: magnitude at: firstDigitIx.
^ (digit bitAnd: (firstMask bitAnd: lastMask))
~= 0].
((self unsafeDigitOfLargeInt: magnitude at: firstDigitIx) bitAnd: firstMask)
~= 0
ifTrue: [^ true].
firstDigitIx + 1
to: lastDigitIx - 1
do: [:ix | (self unsafeDigitOfLargeInt: magnitude at: ix)
~= 0
ifTrue: [^ true]].
((self unsafeDigitOfLargeInt: magnitude at: lastDigitIx) bitAnd: lastMask)
~= 0
ifTrue: [^ true].
^ false!
Item was changed:
----- Method: TMethod>>isFunctional (in category 'inlining') -----
isFunctional
"Answer true if the receiver is a functional method. That is, if it
consists of a single return statement of an expression that contains
no other returns.
Answer false for methods with return types other than the simple
integer types to work around bugs in the inliner."
parseTree statements isEmpty ifTrue:
[^false].
parseTree statements last isReturn ifFalse:
[^false].
parseTree statements size = 1 ifFalse:
[(parseTree statements size = 2
and: [parseTree statements first isSend
and: [parseTree statements first selector == #flag:]]) ifFalse:
[^false]].
parseTree statements last expression nodesDo:
[ :n | n isReturn ifTrue: [^false]].
+ ^#(int #'unsigned int' #'long long' #'unsigned long long'
- ^#(int #'unsigned int' #long #'unsigned long' #'long long' #'unsigned long long'
sqInt usqInt #'sqIntptr_t' #'usqIntptr_t' sqLong usqLong
#'int *' #'unsigned int *' #'sqInt *' #'usqInt *' #'sqLong *' #'usqLong *' #'CogMethod *' #'char *') includes: returnType!
Item was changed:
----- Method: ThreadedFFIPlugin class>>preambleCCode (in category 'translation') -----
preambleCCode
"For a source of builtin defines grep for builtin_define in a gcc release config directory."
^'
#include "sqAssert.h" /* for assert */
#define ThreadedFFIPlugin 1 /* to filter-out unwanted declarations from sqFFI.h */
#include "sqFFI.h" /* for logging and surface functions */
#ifdef _MSC_VER
# define alloca _alloca
#endif
#if defined(__GNUC__) && (defined(_X86_) || defined(i386) || defined(__i386) || defined(__i386__))
# define setsp(sp) asm volatile ("movl %0,%%esp" : : "m"(sp))
# define getsp() ({ void *esp; asm volatile ("movl %%esp,%0" : "=r"(esp) : ); esp;})
+ # elif defined(__GNUC__) && (defined(__amd64__) || defined(__x86_64__) || defined(__amd64) || defined(__x86_64))
+ # define setsp(sp) asm volatile ("movq %0,%%rsp" : : "m"(sp))
+ # define getsp() ({ void *rsp; asm volatile ("movq %%rsp,%0" : "=r"(rsp) : ); rsp;})
# elif defined(__GNUC__) && (defined(__arm__))
# define setsp(sp) asm volatile ("ldr %%sp, %0" : : "m"(sp))
# define getsp() ({ void *sp; asm volatile ("mov %0, %%sp" : "=r"(sp) : ); sp;})
#endif
#if !!defined(getsp)
# define getsp() 0
#endif
#if !!defined(setsp)
# define setsp(ignored) 0
#endif
#if !!defined(STACK_ALIGN_BYTES)
# if __APPLE__ && __MACH__ && __i386__
# define STACK_ALIGN_BYTES 16
# elif __linux__ && __i386__
# define STACK_ALIGN_BYTES 16
# elif defined(__amd64__) || defined(__x86_64__) || defined(__amd64) || defined(__x86_64)
# define STACK_ALIGN_BYTES 16
# elif defined(powerpc) || defined(__powerpc__) || defined(_POWER) || defined(__POWERPC__) || defined(__PPC__)
# define STACK_ALIGN_BYTES 16
# elif defined(__sparc64__) || defined(__sparcv9__) || defined(__sparc_v9__) /* must precede 32-bit sparc defs */
# define STACK_ALIGN_BYTES 16
# elif defined(sparc) || defined(__sparc__) || defined(__sparclite__)
# define STACK_ALIGN_BYTES 8
# elif defined(__arm__)
# define STACK_ALIGN_BYTES 8
# else
# define STACK_ALIGN_BYTES 0
# endif
#endif /* !!defined(STACK_ALIGN_BYTES) */
#if !!defined(STACK_OFFSET_BYTES)
# define STACK_OFFSET_BYTES 0
#endif
#if defined(_X86_) || defined(i386) || defined(__i386) || defined(__i386__)
/* Both Mac OS X x86 and Win32 x86 return structs of a power of two in size
* less than or equal to eight bytes in length in registers. Linux never does so.
*/
# if __linux__
# define WIN32_X86_STRUCT_RETURN 0
# else
# define WIN32_X86_STRUCT_RETURN 1
# endif
# if WIN32
# define PLATFORM_API_USES_CALLEE_POPS_CONVENTION 1
# endif
+ # elif defined(__amd64__) || defined(__x86_64__) || defined(__amd64) || defined(__x86_64)
+ # if WIN32 | WIN64
+ # define PLATFORM_API_USES_CALLEE_POPS_CONVENTION 1
+ # endif
#endif /* defined(_X86_) || defined(i386) || defined(__i386) || defined(__i386__) */
#if !!defined(ALLOCA_LIES_SO_USE_GETSP)
+ # if defined(__MINGW32__) && (__GNUC__ >= 3) && (defined(_X86_) || defined(i386) || defined(__i386) || defined(__i386__))
- # if defined(__MINGW32__) && (__GNUC__ >= 3)
/*
* cygwin -mno-cygwin (MinGW) gcc 3.4.x''s alloca is a library routine that answers
* %esp + 4, so the outgoing stack is offset by one word if uncorrected.
* Grab the actual stack pointer to correct.
*/
# define ALLOCA_LIES_SO_USE_GETSP 1
# else
# define ALLOCA_LIES_SO_USE_GETSP 0
# endif
#endif /* !!defined(ALLOCA_LIES_SO_USE_GETSP) */
#if !!defined(PLATFORM_API_USES_CALLEE_POPS_CONVENTION)
# define PLATFORM_API_USES_CALLEE_POPS_CONVENTION 0
#endif
/* The dispatchOn:in:with:with: generates an unwanted call on error. Just squash it. */
#define error(foo) 0
#ifndef SQUEAK_BUILTIN_PLUGIN
/* but print assert failures. */
void
warning(char *s) { /* Print an error message but don''t exit. */
printf("\n%s\n", s);
}
#endif
/* sanitize */
#ifdef SQUEAK_BUILTIN_PLUGIN
# define EXTERN
#else
# define EXTERN extern
#endif
'!
Item was added:
+ ----- Method: ThreadedX64Win64FFIPlugin>>ffiCalloutDoubleRetTo:in: (in category 'callout support') -----
+ ffiCalloutDoubleRetTo: procAddr in: calloutState
+ <var: #procAddr type: #'void *'>
+ <var: #calloutState type: #'CalloutState *'>
+ | floatRet |
+ <var: #floatRet type: #double>
+ <returnTypeC: #double>
+ <inline: true>
+ calloutState floatRegisterSignature caseOf: {
+ [0]-> [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)].
+ [1]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(double, sqIntptr_t, sqIntptr_t, sqIntptr_t)')
+ with: (calloutState floatRegisters at: 0)
+ with: (calloutState integerRegisters at: 1)
+ with: (calloutState integerRegisters at: 2)
+ with: (calloutState integerRegisters at: 3)].
+ [2]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, double, sqIntptr_t, sqIntptr_t)')
+ with: (calloutState integerRegisters at: 0)
+ with: (calloutState floatRegisters at: 1)
+ with: (calloutState integerRegisters at: 2)
+ with: (calloutState integerRegisters at: 3)].
+ [3]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(double, double, sqIntptr_t, sqIntptr_t)')
+ with: (calloutState floatRegisters at: 0)
+ with: (calloutState floatRegisters at: 1)
+ with: (calloutState integerRegisters at: 2)
+ with: (calloutState integerRegisters at: 3)].
+ [4]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, sqIntptr_t, double, sqIntptr_t)')
+ with: (calloutState integerRegisters at: 0)
+ with: (calloutState integerRegisters at: 1)
+ with: (calloutState floatRegisters at: 2)
+ with: (calloutState integerRegisters at: 3)].
+ [5]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(double, sqIntptr_t, double, sqIntptr_t)')
+ with: (calloutState floatRegisters at: 0)
+ with: (calloutState integerRegisters at: 1)
+ with: (calloutState floatRegisters at: 2)
+ with: (calloutState integerRegisters at: 3)].
+ [6]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, double, double, sqIntptr_t)')
+ with: (calloutState integerRegisters at: 0)
+ with: (calloutState floatRegisters at: 1)
+ with: (calloutState floatRegisters at: 2)
+ with: (calloutState integerRegisters at: 3)].
+ [7]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(double, double, double, sqIntptr_t)')
+ with: (calloutState floatRegisters at: 0)
+ with: (calloutState floatRegisters at: 1)
+ with: (calloutState floatRegisters at: 2)
+ with: (calloutState integerRegisters at: 3)].
+
+ [8]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, double)')
+ with: (calloutState integerRegisters at: 0)
+ with: (calloutState integerRegisters at: 1)
+ with: (calloutState integerRegisters at: 2)
+ with: (calloutState floatRegisters at: 3)].
+ [9]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(double, sqIntptr_t, sqIntptr_t, double)')
+ with: (calloutState floatRegisters at: 0)
+ with: (calloutState integerRegisters at: 1)
+ with: (calloutState integerRegisters at: 2)
+ with: (calloutState floatRegisters at: 3)].
+ [10]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, double, sqIntptr_t, double)')
+ with: (calloutState integerRegisters at: 0)
+ with: (calloutState floatRegisters at: 1)
+ with: (calloutState integerRegisters at: 2)
+ with: (calloutState floatRegisters at: 3)].
+ [11]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(double, double, sqIntptr_t, double)')
+ with: (calloutState floatRegisters at: 0)
+ with: (calloutState floatRegisters at: 1)
+ with: (calloutState integerRegisters at: 2)
+ with: (calloutState floatRegisters at: 3)].
+ [12]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, sqIntptr_t, double, double)')
+ with: (calloutState integerRegisters at: 0)
+ with: (calloutState integerRegisters at: 1)
+ with: (calloutState floatRegisters at: 2)
+ with: (calloutState floatRegisters at: 3)].
+ [13]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(double, sqIntptr_t, double, double)')
+ with: (calloutState floatRegisters at: 0)
+ with: (calloutState integerRegisters at: 1)
+ with: (calloutState floatRegisters at: 2)
+ with: (calloutState floatRegisters at: 3)].
+ [14]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, double, double, double)')
+ with: (calloutState integerRegisters at: 0)
+ with: (calloutState floatRegisters at: 1)
+ with: (calloutState floatRegisters at: 2)
+ with: (calloutState floatRegisters at: 3)].
+ [15]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(double, double, double, double)')
+ with: (calloutState floatRegisters at: 0)
+ with: (calloutState floatRegisters at: 1)
+ with: (calloutState floatRegisters at: 2)
+ with: (calloutState floatRegisters at: 3)].} otherwise: [floatRet := 0].
+ ^floatRet!
Item was added:
+ ----- Method: ThreadedX64Win64FFIPlugin>>ffiCalloutFloatRetTo:in: (in category 'callout support') -----
+ ffiCalloutFloatRetTo: procAddr in: calloutState
+ <var: #procAddr type: #'void *'>
+ <var: #calloutState type: #'CalloutState *'>
+ | floatRet |
+ <var: #floatRet type: #double> "It's double rather than float because it will be converted to a squeak Float object (a.k.a. double precision)"
+ <returnTypeC: #double>
+ <inline: true>
+ calloutState floatRegisterSignature caseOf: {
+ [0]-> [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)].
+ [1]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(double, sqIntptr_t, sqIntptr_t, sqIntptr_t)')
+ with: (calloutState floatRegisters at: 0)
+ with: (calloutState integerRegisters at: 1)
+ with: (calloutState integerRegisters at: 2)
+ with: (calloutState integerRegisters at: 3)].
+ [2]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, double, sqIntptr_t, sqIntptr_t)')
+ with: (calloutState integerRegisters at: 0)
+ with: (calloutState floatRegisters at: 1)
+ with: (calloutState integerRegisters at: 2)
+ with: (calloutState integerRegisters at: 3)].
+ [3]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(double, double, sqIntptr_t, sqIntptr_t)')
+ with: (calloutState floatRegisters at: 0)
+ with: (calloutState floatRegisters at: 1)
+ with: (calloutState integerRegisters at: 2)
+ with: (calloutState integerRegisters at: 3)].
+ [4]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, sqIntptr_t, double, sqIntptr_t)')
+ with: (calloutState integerRegisters at: 0)
+ with: (calloutState integerRegisters at: 1)
+ with: (calloutState floatRegisters at: 2)
+ with: (calloutState integerRegisters at: 3)].
+ [5]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(double, sqIntptr_t, double, sqIntptr_t)')
+ with: (calloutState floatRegisters at: 0)
+ with: (calloutState integerRegisters at: 1)
+ with: (calloutState floatRegisters at: 2)
+ with: (calloutState integerRegisters at: 3)].
+ [6]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, double, double, sqIntptr_t)')
+ with: (calloutState integerRegisters at: 0)
+ with: (calloutState floatRegisters at: 1)
+ with: (calloutState floatRegisters at: 2)
+ with: (calloutState integerRegisters at: 3)].
+ [7]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(double, double, double, sqIntptr_t)')
+ with: (calloutState floatRegisters at: 0)
+ with: (calloutState floatRegisters at: 1)
+ with: (calloutState floatRegisters at: 2)
+ with: (calloutState integerRegisters at: 3)].
+
+ [8]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, double)')
+ with: (calloutState integerRegisters at: 0)
+ with: (calloutState integerRegisters at: 1)
+ with: (calloutState integerRegisters at: 2)
+ with: (calloutState floatRegisters at: 3)].
+ [9]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(double, sqIntptr_t, sqIntptr_t, double)')
+ with: (calloutState floatRegisters at: 0)
+ with: (calloutState integerRegisters at: 1)
+ with: (calloutState integerRegisters at: 2)
+ with: (calloutState floatRegisters at: 3)].
+ [10]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, double, sqIntptr_t, double)')
+ with: (calloutState integerRegisters at: 0)
+ with: (calloutState floatRegisters at: 1)
+ with: (calloutState integerRegisters at: 2)
+ with: (calloutState floatRegisters at: 3)].
+ [11]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(double, double, sqIntptr_t, double)')
+ with: (calloutState floatRegisters at: 0)
+ with: (calloutState floatRegisters at: 1)
+ with: (calloutState integerRegisters at: 2)
+ with: (calloutState floatRegisters at: 3)].
+ [12]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, sqIntptr_t, double, double)')
+ with: (calloutState integerRegisters at: 0)
+ with: (calloutState integerRegisters at: 1)
+ with: (calloutState floatRegisters at: 2)
+ with: (calloutState floatRegisters at: 3)].
+ [13]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(double, sqIntptr_t, double, double)')
+ with: (calloutState floatRegisters at: 0)
+ with: (calloutState integerRegisters at: 1)
+ with: (calloutState floatRegisters at: 2)
+ with: (calloutState floatRegisters at: 3)].
+ [14]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, double, double, double)')
+ with: (calloutState integerRegisters at: 0)
+ with: (calloutState floatRegisters at: 1)
+ with: (calloutState floatRegisters at: 2)
+ with: (calloutState floatRegisters at: 3)].
+ [15]-> [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(double, double, double, double)')
+ with: (calloutState floatRegisters at: 0)
+ with: (calloutState floatRegisters at: 1)
+ with: (calloutState floatRegisters at: 2)
+ with: (calloutState floatRegisters at: 3)].} otherwise: [floatRet := 0].
+ ^floatRet!
Item was added:
+ ----- Method: ThreadedX64Win64FFIPlugin>>ffiCalloutIntRetTo:in: (in category 'callout support') -----
+ ffiCalloutIntRetTo: procAddr in: calloutState
+ <var: #procAddr type: #'void *'>
+ <var: #calloutState type: #'CalloutState *'>
+ | intRet |
+ <var: #intRet type: #usqLong>
+ <returnTypeC: #usqLong>
+ <inline: true>
+ calloutState floatRegisterSignature caseOf: {
+ [0]-> [intRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(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)].
+ [1]-> [intRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(double, sqIntptr_t, sqIntptr_t, sqIntptr_t)')
+ with: (calloutState floatRegisters at: 0)
+ with: (calloutState integerRegisters at: 1)
+ with: (calloutState integerRegisters at: 2)
+ with: (calloutState integerRegisters at: 3)].
+ [2]-> [intRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(sqIntptr_t, double, sqIntptr_t, sqIntptr_t)')
+ with: (calloutState integerRegisters at: 0)
+ with: (calloutState floatRegisters at: 1)
+ with: (calloutState integerRegisters at: 2)
+ with: (calloutState integerRegisters at: 3)].
+ [3]-> [intRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(double, double, sqIntptr_t, sqIntptr_t)')
+ with: (calloutState floatRegisters at: 0)
+ with: (calloutState floatRegisters at: 1)
+ with: (calloutState integerRegisters at: 2)
+ with: (calloutState integerRegisters at: 3)].
+ [4]-> [intRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(sqIntptr_t, sqIntptr_t, double, sqIntptr_t)')
+ with: (calloutState integerRegisters at: 0)
+ with: (calloutState integerRegisters at: 1)
+ with: (calloutState floatRegisters at: 2)
+ with: (calloutState integerRegisters at: 3)].
+ [5]-> [intRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(double, sqIntptr_t, double, sqIntptr_t)')
+ with: (calloutState floatRegisters at: 0)
+ with: (calloutState integerRegisters at: 1)
+ with: (calloutState floatRegisters at: 2)
+ with: (calloutState integerRegisters at: 3)].
+ [6]-> [intRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(sqIntptr_t, double, double, sqIntptr_t)')
+ with: (calloutState integerRegisters at: 0)
+ with: (calloutState floatRegisters at: 1)
+ with: (calloutState floatRegisters at: 2)
+ with: (calloutState integerRegisters at: 3)].
+ [7]-> [intRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(double, double, double, sqIntptr_t)')
+ with: (calloutState floatRegisters at: 0)
+ with: (calloutState floatRegisters at: 1)
+ with: (calloutState floatRegisters at: 2)
+ with: (calloutState integerRegisters at: 3)].
+
+ [8]-> [intRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, double)')
+ with: (calloutState integerRegisters at: 0)
+ with: (calloutState integerRegisters at: 1)
+ with: (calloutState integerRegisters at: 2)
+ with: (calloutState floatRegisters at: 3)].
+ [9]-> [intRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(double, sqIntptr_t, sqIntptr_t, double)')
+ with: (calloutState floatRegisters at: 0)
+ with: (calloutState integerRegisters at: 1)
+ with: (calloutState integerRegisters at: 2)
+ with: (calloutState floatRegisters at: 3)].
+ [10]-> [intRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(sqIntptr_t, double, sqIntptr_t, double)')
+ with: (calloutState integerRegisters at: 0)
+ with: (calloutState floatRegisters at: 1)
+ with: (calloutState integerRegisters at: 2)
+ with: (calloutState floatRegisters at: 3)].
+ [11]-> [intRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(double, double, sqIntptr_t, double)')
+ with: (calloutState floatRegisters at: 0)
+ with: (calloutState floatRegisters at: 1)
+ with: (calloutState integerRegisters at: 2)
+ with: (calloutState floatRegisters at: 3)].
+ [12]-> [intRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(sqIntptr_t, sqIntptr_t, double, double)')
+ with: (calloutState integerRegisters at: 0)
+ with: (calloutState integerRegisters at: 1)
+ with: (calloutState floatRegisters at: 2)
+ with: (calloutState floatRegisters at: 3)].
+ [13]-> [intRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(double, sqIntptr_t, double, double)')
+ with: (calloutState floatRegisters at: 0)
+ with: (calloutState integerRegisters at: 1)
+ with: (calloutState floatRegisters at: 2)
+ with: (calloutState floatRegisters at: 3)].
+ [14]-> [intRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(sqIntptr_t, double, double, double)')
+ with: (calloutState integerRegisters at: 0)
+ with: (calloutState floatRegisters at: 1)
+ with: (calloutState floatRegisters at: 2)
+ with: (calloutState floatRegisters at: 3)].
+ [15]-> [intRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(double, double, double, double)')
+ with: (calloutState floatRegisters at: 0)
+ with: (calloutState floatRegisters at: 1)
+ with: (calloutState floatRegisters at: 2)
+ with: (calloutState floatRegisters at: 3)].} otherwise: [intRet := 0].
+ ^intRet!
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 loadFloatRegs oop |
<var: #floatRet type: #double>
<var: #intRet type: #usqLong>
<inline: true>
self cCode: '' inSmalltalk: [loadFloatRegs := #used. loadFloatRegs class].
self cppIf: COGMTVM ifTrue:
[(calloutState callFlags anyMask: FFICallFlagThreaded) ifTrue:
[myThreadIndex := interpreterProxy disownVM: 0]].
self registerArgsSlop + self cStackAlignment > 0 ifTrue:
[self setsp: calloutState argVector].
- calloutState floatRegisterSignature > 0 ifTrue:
- [self
- load: (calloutState floatRegisters at: 0)
- Flo: (calloutState floatRegisters at: 1)
- at: (calloutState floatRegisters at: 2)
- Re: (calloutState floatRegisters at: 3)
- gs: (calloutState floatRegisters at: 4)].
-
atomicType := self atomicTypeOf: calloutState ffiRetHeader.
(atomicType >> 1) = (FFITypeSingleFloat >> 1)
ifTrue:
[atomicType = FFITypeSingleFloat
ifTrue:
+ [floatRet := self ffiCalloutFloatRetTo: procAddr in: calloutState]
- [floatRet := self
- dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(long, long, long, long)')
- 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 ffiCalloutDoubleRetTo: procAddr in: calloutState]]
- [floatRet := self
- dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(long, long, long, long)')
- with: (calloutState integerRegisters at: 0)
- with: (calloutState integerRegisters at: 1)
- with: (calloutState integerRegisters at: 2)
- with: (calloutState integerRegisters at: 3)]]
ifFalse:
+ [intRet := self ffiCalloutIntRetTo: procAddr in: calloutState].
- [intRet := self
- dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)(long, long, long, long)')
- 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].
self cppIf: COGMTVM ifTrue:
[(calloutState callFlags anyMask: FFICallFlagThreaded) ifTrue:
[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:
[oop := self ffiReturnPointer: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState]
ifFalse:
[oop := self ffiReturnStruct: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState].
^oop].
(atomicType >> 1) = (FFITypeSingleFloat >> 1)
ifTrue:
[oop := interpreterProxy floatObjectOf: floatRet]
ifFalse:
[oop := self ffiCreateIntegralResultOop: intRet
ofAtomicType: atomicType
in: calloutState].
^interpreterProxy methodReturnValue: oop!
Item was changed:
----- Method: VMClass>>sizeof: (in category 'translation support') -----
sizeof: objectSymbolOrClass
<doNotGenerate>
| index |
objectSymbolOrClass isInteger ifTrue:
[^self class objectMemoryClass wordSize].
(#(usqInt sqInt) includes: objectSymbolOrClass) ifTrue: [^self class objectMemoryClass bytesPerOop].
objectSymbolOrClass isSymbol ifTrue:
[(objectSymbolOrClass last == $*
+ or: [#(#'sqIntptr_t' #'usqIntptr_t' #'size_t') includes: objectSymbolOrClass]) ifTrue:
- or: [#(#long #'unsigned long' #'sqIntptr_t' #'usqIntptr_t' #'size_t') includes: objectSymbolOrClass]) ifTrue:
[^self class objectMemoryClass wordSize].
index := #( #sqLong #usqLong #double
#int #'unsigned int' #float
#short #'unsigned short'
#char #'unsigned char' #'signed char')
indexOf: objectSymbolOrClass
ifAbsent:
+ [(#(long #'unsigned long') includes: objectSymbolOrClass)
+ ifTrue:
+ [self error: 'long is ambiguous on 64bits architecture, don''t use it'.
+ ^self class objectMemoryClass wordSize].
+ self error: 'unrecognized C type name'].
- [self error: 'unrecognized C type name'].
^#(8 8 8
4 4 4
2 2
1 1 1) at: index].
^(objectSymbolOrClass isBehavior
ifTrue: [objectSymbolOrClass]
ifFalse: [objectSymbolOrClass class])
alignedByteSizeOf: objectSymbolOrClass
forClient: self!
More information about the Vm-dev
mailing list