[Vm-dev] VM Maker: VMMaker.oscog-eem.1692.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Feb 22 18:58:56 UTC 2016
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1692.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.1692
Author: eem
Time: 22 February 2016, 10:57:10.137377 am
UUID: 57b2f552-72d3-4db7-99d8-ef9872eb93f5
Ancestors: VMMaker.oscog-tfel.1691
ThreadedFFIPlugin fixes for 64 bits.
Make ffiAddressOf:startingAt:size: & primitiveFFIIntegerAt[Put] 64-bit capable.
Use signedMachineIntegerFor: to answer the result in primitiveCreateManualSurface.
Fix slips in testing for float and/or double in the ARM & X64 ffiCalloutTo:SpecOnStack:in: methods.
Add asUnsignedLongLong to Integer along with Slang support.
=============== Diff against VMMaker.oscog-tfel.1691 ===============
Item was added:
+ ----- Method: CCodeGenerator>>generateAsUnsignedLongLong:on:indent: (in category 'C translation') -----
+ generateAsUnsignedLongLong: msgNode on: aStream indent: level
+ "Generate the C code for this message onto the given stream."
+
+ aStream nextPutAll:'((unsigned long long)'.
+ self emitCExpression: msgNode receiver on: aStream.
+ aStream nextPut: $)!
Item was changed:
----- Method: CCodeGenerator>>initializeCTranslationDictionary (in category 'C translation support') -----
initializeCTranslationDictionary
"Initialize the dictionary mapping message names to actions for C code generation."
| pairs |
translationDict := Dictionary new: 200.
pairs := #(
#& #generateAnd:on:indent:
#| #generateOr:on:indent:
#and: #generateSequentialAnd:on:indent:
#or: #generateSequentialOr:on:indent:
#not #generateNot:on:indent:
#+ #generatePlus:on:indent:
#- #generateMinus:on:indent:
#negated #generateNegated:on:indent:
#* #generateTimes:on:indent:
#/ #generateDivide:on:indent:
#// #generateDivide:on:indent:
#\\ #generateModulo:on:indent:
#<< #generateShiftLeft:on:indent:
#>> #generateShiftRight:on:indent:
#>>> #generateSignedShiftRight:on:indent:
#min: #generateMin:on:indent:
#max: #generateMax:on:indent:
#between:and: #generateBetweenAnd:on:indent:
#bitAnd: #generateBitAnd:on:indent:
#bitOr: #generateBitOr:on:indent:
#bitXor: #generateBitXor:on:indent:
#bitShift: #generateBitShift:on:indent:
#signedBitShift: #generateSignedBitShift:on:indent:
#bitInvert32 #generateBitInvert:on:indent:
#bitInvert64 #generateBitInvert:on:indent:
#bitClear: #generateBitClear:on:indent:
#truncateTo: #generateTruncateTo:on:indent:
#rounded #generateRounded:on:indent:
#< #generateLessThan:on:indent:
#<= #generateLessThanOrEqual:on:indent:
#= #generateEqual:on:indent:
#> #generateGreaterThan:on:indent:
#>= #generateGreaterThanOrEqual:on:indent:
#~= #generateNotEqual:on:indent:
#== #generateEqual:on:indent:
#~~ #generateNotEqual:on:indent:
#isNil #generateIsNil:on:indent:
#notNil #generateNotNil:on:indent:
#whileTrue: #generateWhileTrue:on:indent:
#whileFalse: #generateWhileFalse:on:indent:
#whileTrue #generateDoWhileTrue:on:indent:
#whileFalse #generateDoWhileFalse:on:indent:
#to:do: #generateToDo:on:indent:
#to:by:do: #generateToByDo:on:indent:
#repeat #generateRepeat:on:indent:
#timesRepeat: #generateTimesRepeat:on:indent:
#ifTrue: #generateIfTrue:on:indent:
#ifFalse: #generateIfFalse:on:indent:
#ifTrue:ifFalse: #generateIfTrueIfFalse:on:indent:
#ifFalse:ifTrue: #generateIfFalseIfTrue:on:indent:
#ifNotNil: #generateIfNotNil:on:indent:
#ifNil: #generateIfNil:on:indent:
#ifNotNil:ifNil: #generateIfNotNilIfNil:on:indent:
#ifNil:ifNotNil: #generateIfNilIfNotNil:on:indent:
#at: #generateAt:on:indent:
#at:put: #generateAtPut:on:indent:
#basicAt: #generateAt:on:indent:
#basicAt:put: #generateAtPut:on:indent:
#integerValueOf: #generateIntegerValueOf:on:indent:
#integerObjectOf: #generateIntegerObjectOf:on:indent:
#isIntegerObject: #generateIsIntegerObject:on:indent:
#cCode: #generateInlineCCode:on:indent:
#cCode:inSmalltalk: #generateInlineCCode:on:indent:
#cPreprocessorDirective: #generateInlineCPreprocessorDirective:on:indent:
#cppIf:ifTrue:ifFalse: #generateInlineCppIfElse:on:indent:
#cppIf:ifTrue: #generateInlineCppIfElse:on:indent:
#cCoerce:to: #generateCCoercion:on:indent:
#cCoerceSimple:to: #generateCCoercion:on:indent:
#addressOf: #generateAddressOf:on:indent:
#addressOf:put: #generateAddressOf:on:indent:
#asAddress:put: #generateAsAddress:on:indent:
#signedIntFromLong64 #generateSignedIntFromLong64:on:indent:
#signedIntFromLong #generateSignedIntFromLong:on:indent:
#signedIntFromShort #generateSignedIntFromShort:on:indent:
#signedIntToLong64 #generateSignedIntToLong64:on:indent:
#signedIntToLong #generateSignedIntToLong:on:indent:
#signedIntToShort #generateSignedIntToShort:on:indent:
#preIncrement #generatePreIncrement:on:indent:
#preDecrement #generatePreDecrement:on:indent:
#inline: #generateInlineDirective:on:indent:
#asFloat #generateAsFloat:on:indent:
#asInteger #generateAsInteger:on:indent:
#asUnsignedInteger #generateAsUnsignedInteger:on:indent:
#asLong #generateAsLong:on:indent:
#asUnsignedLong #generateAsUnsignedLong:on:indent:
+ #asUnsignedLongLong #generateAsUnsignedLongLong:on:indent:
#asVoidPointer #generateAsVoidPointer:on:indent:
#asSymbol #generateAsSymbol:on:indent:
#flag: #generateFlag:on:indent:
#anyMask: #generateBitAnd:on:indent:
#allMask: #generateAllMask:on:indent:
#noMask: #generateNoMask:on:indent:
#raisedTo: #generateRaisedTo:on:indent:
#touch: #generateTouch:on:indent:
#bytesPerOop #generateBytesPerOop:on:indent:
#bytesPerWord #generateBytesPerWord:on:indent:
#wordSize #generateBytesPerWord:on:indent:
#baseHeaderSize #generateBaseHeaderSize:on:indent:
#minSmallInteger #generateSmallIntegerConstant:on:indent:
#maxSmallInteger #generateSmallIntegerConstant:on:indent:
#sharedCodeNamed:inCase: #generateSharedCodeDirective:on:indent:
#perform: #generatePerform:on:indent:
#perform:with: #generatePerform:on:indent:
#perform:with:with: #generatePerform:on:indent:
#perform:with:with:with: #generatePerform:on:indent:
#perform:with:with:with:with: #generatePerform:on:indent:
#perform:with:with:with:with:with: #generatePerform:on:indent:
#value #generateValue:on:indent:
#value: #generateValue:on:indent:
#value:value: #generateValue:on:indent:
#value:value:value: #generateValue:on:indent:
#value:value:value:value: #generateValue:on:indent:
#deny: #generateDeny:on:indent:
#shouldNotImplement #generateSmalltalkMetaError:on:indent:
#shouldBeImplemented #generateSmalltalkMetaError:on:indent:
#subclassResponsibility #generateSmalltalkMetaError:on:indent:
).
1 to: pairs size by: 2 do: [:i |
translationDict at: (pairs at: i) put: (pairs at: i + 1)].
pairs := #(
#ifTrue: #generateIfTrueAsArgument:on:indent:
#ifFalse: #generateIfFalseAsArgument:on:indent:
#ifTrue:ifFalse: #generateIfTrueIfFalseAsArgument:on:indent:
#ifFalse:ifTrue: #generateIfFalseIfTrueAsArgument:on:indent:
#ifNotNil: #generateIfNotNilAsArgument:on:indent:
#ifNil: #generateIfNilAsArgument:on:indent:
#ifNotNil:ifNil: #generateIfNotNilIfNilAsArgument:on:indent:
#ifNil:ifNotNil: #generateIfNilIfNotNilAsArgument:on:indent:
#cCode: #generateInlineCCodeAsArgument:on:indent:
#cCode:inSmalltalk: #generateInlineCCodeAsArgument:on:indent:
#cppIf:ifTrue:ifFalse: #generateInlineCppIfElseAsArgument:on:indent:
#cppIf:ifTrue: #generateInlineCppIfElseAsArgument:on:indent:
#value #generateValueAsArgument:on:indent:
#value: #generateValueAsArgument:on:indent:
#value:value: #generateValueAsArgument:on:indent:
).
asArgumentTranslationDict := Dictionary new: 8.
1 to: pairs size by: 2 do: [:i |
asArgumentTranslationDict at: (pairs at: i) put: (pairs at: i + 1)].
!
Item was added:
+ ----- Method: Integer>>asUnsignedLongLong (in category '*VMMaker-interpreter simulator') -----
+ asUnsignedLongLong
+ self assert: self >= 0.
+ ^self!
Item was changed:
----- Method: ThreadedARMFFIPlugin>>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 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 floatRegisterIndex > 0 ifTrue:
[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)].
atomicType := self atomicTypeOf: calloutState ffiRetHeader.
+ (atomicType >> 1) = (FFITypeSingleFloat >> 1)
- (atomicType >> 1) = (FFITypeSingleFloat > 1)
ifTrue:
[atomicType = FFITypeSingleFloat
ifTrue:
[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
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
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)
- (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: ThreadedFFIPlugin>>ffiAddressOf:startingAt:size: (in category 'primitive support') -----
ffiAddressOf: rcvr startingAt: byteOffset size: byteSize
+ "Answer a long of the address of the byteSize slot (byte, short, int, whatever) at byteOffset in rcvr.
+ Nominally intended for use with ExternalAddress objects, this code will work (for obscure historical
+ reasons) with plain Byte or Word Arrays as well. "
- "return an int of the address of the byteSize slot (byte, short, int, whatever) at byteOffset in rcvr. Nominally intended for use with ExternalAddress objects, this code will work (for obscure historical reasons) with plain Byte or Word Arrays as well. "
| rcvrClass rcvrSize addr |
- self flag: 'This needs more thought. It is 32-bit specific. What about 64-bit platforms?'.
(interpreterProxy isBytes: rcvr) ifFalse:[^interpreterProxy primitiveFail].
+ byteOffset > 0 ifFalse:[^interpreterProxy primitiveFail].
- (byteOffset > 0) ifFalse:[^interpreterProxy primitiveFail].
rcvrClass := interpreterProxy fetchClassOf: rcvr.
rcvrSize := interpreterProxy byteSizeOf: rcvr.
+ rcvrClass = interpreterProxy classExternalAddress
+ ifTrue:
+ [rcvrSize = BytesPerWord ifFalse:[^interpreterProxy primitiveFail].
+ addr := interpreterProxy fetchPointer: 0 ofObject: rcvr. "Hack!!!!"
+ "don't you dare to read from object memory (unless is pinned)!!"
+ (addr = 0 "or: [(interpreterProxy isInMemory: addr) or: [(interpreterProxy isPinned: rcvr) not]]") ifTrue:
+ [^interpreterProxy primitiveFail]]
+ ifFalse:
+ [byteOffset+byteSize-1 <= rcvrSize ifFalse:
+ [^interpreterProxy primitiveFail].
+ addr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: #long].
- rcvrClass = interpreterProxy classExternalAddress ifTrue:[
- (rcvrSize = 4) ifFalse:[^interpreterProxy primitiveFail].
- addr := interpreterProxy fetchPointer: 0 ofObject: rcvr.
- "don't you dare to read from object memory (unless is pinned)!!"
- (addr = 0" or: [(interpreterProxy isInMemory: addr) or: [(interpreterProxy isPinned: rcvr) not]]")
- ifTrue:[^interpreterProxy primitiveFail].
- ] ifFalse:[
- (byteOffset+byteSize-1 <= rcvrSize)
- ifFalse:[^interpreterProxy primitiveFail].
- addr := self cCoerce: (interpreterProxy firstIndexableField: rcvr) to: 'int'.
- ].
addr := addr + byteOffset - 1.
^addr!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveCreateManualSurface (in category 'primitives - surfaces') -----
primitiveCreateManualSurface
"arguments: name(type, stack offset)
width(Integer, 4)
height(Integer, 3)
rowPitch(Integer, 2)
depth(Integer, 1)
isMSB(Boolean, 0)"
| width height rowPitch depth isMSB result |
<export: true>
+ interpreterProxy methodArgumentCount = 5 ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadNumArgs].
- interpreterProxy methodArgumentCount == 5 ifFalse: [^interpreterProxy primitiveFail].
width := interpreterProxy stackIntegerValue: 4.
height := interpreterProxy stackIntegerValue: 3.
rowPitch := interpreterProxy stackIntegerValue: 2.
depth := interpreterProxy stackIntegerValue: 1.
isMSB := interpreterProxy stackObjectValue: 0.
isMSB := interpreterProxy booleanValueOf: isMSB.
interpreterProxy failed ifTrue: [^nil].
+ result := self cCode: 'createManualSurface(width, height, rowPitch, depth, isMSB)'
+ inSmalltalk: [self create: width Man: height ual: rowPitch Surf: depth ace: isMSB].
+ result < 0 ifTrue:
+ [^interpreterProxy primitiveFail].
+ result := interpreterProxy signedMachineIntegerFor: result.
- self touch: width; touch: height; touch: rowPitch; touch: depth; touch: isMSB.
-
- result := self cCode: 'createManualSurface(width, height, rowPitch, depth, isMSB)'.
- result < 0 ifTrue: [^interpreterProxy primitiveFail].
- result := interpreterProxy signed32BitIntegerFor: result.
^interpreterProxy pop: 6 thenPush: result
!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveFFIIntegerAt (in category 'primitives') -----
primitiveFFIIntegerAt
+ "Answer a (signed or unsigned) n byte integer from the given byte offset
+ in the receiver, using the platform's endianness."
+ | isSigned byteSize byteOffset rcvr addr value mask valueOop |
+ <var: 'value' type: #usqLong>
+ <var: 'mask' type: #usqLong>
- "Return a (signed or unsigned) n byte integer from the given byte offset."
- | isSigned byteSize byteOffset rcvr addr value mask |
<export: true>
<inline: false>
isSigned := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0).
byteSize := interpreterProxy stackIntegerValue: 1.
byteOffset := interpreterProxy stackIntegerValue: 2.
rcvr := interpreterProxy stackObjectValue: 3.
interpreterProxy failed ifTrue:[^0].
+ (byteOffset > 0
+ and: [(byteSize between: 1 and: 8)
+ and: [(byteSize bitAnd: byteSize - 1) = 0 "a.k.a. isPowerOfTwo"]]) ifFalse:
+ [^interpreterProxy primitiveFail].
- (byteOffset > 0 and:[byteSize = 1 or:[byteSize = 2 or:[byteSize = 4]]])
- ifFalse:[^interpreterProxy primitiveFail].
addr := self ffiAddressOf: rcvr startingAt: byteOffset size: byteSize.
interpreterProxy failed ifTrue:[^0].
+ byteSize <= 2
+ ifTrue:
+ [byteSize = 1
+ ifTrue: [value := self cCoerceSimple: (interpreterProxy byteAt: addr) to: #'unsigned char']
+ ifFalse: [value := self cCoerceSimple: (interpreterProxy shortAt: addr) to: #'unsigned short']]
+ ifFalse:
+ [byteSize = 4
+ ifTrue: [value := self cCoerceSimple: (interpreterProxy long32At: addr) to: #'unsigned int']
+ ifFalse: [value := interpreterProxy long64At: addr]].
+ byteSize < BytesPerWord
+ ifTrue:
+ [isSigned ifTrue: "sign extend value"
+ [mask := 1 << (byteSize * 8 - 1).
+ value := (value bitAnd: mask-1) - (value bitAnd: mask)].
+ "note: byte/short (&long if BytesPerWord=8) never exceed SmallInteger range"
+ valueOop := interpreterProxy integerObjectOf: value]
+ ifFalse: "general 64 bit integer; note these never fail"
+ [valueOop := isSigned
+ ifTrue:[interpreterProxy signed64BitIntegerFor: value]
+ ifFalse:[interpreterProxy positive64BitIntegerFor: value]].
+ ^interpreterProxy pop: 4 thenPush: valueOop!
- byteSize < 4 ifTrue:[
- "short/byte"
- byteSize = 1
- ifTrue:[value := interpreterProxy byteAt: addr]
- ifFalse:[ value := self cCode: '*((unsigned short int *) addr)'
- inSmalltalk: [interpreterProxy shortAt: addr]].
- isSigned ifTrue:["sign extend value"
- mask := 1 << (byteSize * 8 - 1).
- value := (value bitAnd: mask-1) - (value bitAnd: mask)].
- "note: byte/short never exceed SmallInteger range"
- value := interpreterProxy integerObjectOf: value.
- ] ifFalse:[
- "general 32 bit integer"
- value := interpreterProxy longAt: addr.
- value := isSigned
- ifTrue:[interpreterProxy signed32BitIntegerFor: value]
- ifFalse:[interpreterProxy positive32BitIntegerFor: value].
- ].
- ^interpreterProxy pop: 4 thenPush: value!
Item was changed:
----- Method: ThreadedFFIPlugin>>primitiveFFIIntegerAtPut (in category 'primitives') -----
primitiveFFIIntegerAtPut
+ "Store a (signed or unsigned) n byte integer at the given byte offset
+ in the receiver, using the platform's endianness."
- "Store a (signed or unsigned) n byte integer at the given byte offset."
| isSigned byteSize byteOffset rcvr addr value max valueOop |
+ <var: 'value' type: #sqLong>
+ <var: 'max' type: #sqLong>
<export: true>
<inline: false>
isSigned := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0).
byteSize := interpreterProxy stackIntegerValue: 1.
valueOop := interpreterProxy stackValue: 2.
byteOffset := interpreterProxy stackIntegerValue: 3.
rcvr := interpreterProxy stackObjectValue: 4.
interpreterProxy failed ifTrue:[^0].
+ (byteOffset > 0
+ and: [(byteSize between: 1 and: 8)
+ and: [(byteSize bitAnd: byteSize - 1) = 0 "a.k.a. isPowerOfTwo"]]) ifFalse:
+ [^interpreterProxy primitiveFail].
- (byteOffset > 0 and:[byteSize = 1 or:[byteSize = 2 or:[byteSize = 4]]])
- ifFalse:[^interpreterProxy primitiveFail].
addr := self ffiAddressOf: rcvr startingAt: byteOffset size: byteSize.
interpreterProxy failed ifTrue:[^0].
isSigned
+ ifTrue:[value := interpreterProxy signedMachineIntegerValueOf: valueOop]
+ ifFalse:[value := interpreterProxy positiveMachineIntegerValueOf: valueOop].
- ifTrue:[value := interpreterProxy signed32BitValueOf: valueOop]
- ifFalse:[value := interpreterProxy positive32BitValueOf: valueOop].
interpreterProxy failed ifTrue:[^0].
+ byteSize < BytesPerWord ifTrue:
+ [isSigned
+ ifTrue:
+ [max := 1 << (8 * byteSize - 1).
+ (value >= (0 - max) and: [value < max]) ifFalse: [^interpreterProxy primitiveFail]]
+ ifFalse:
+ [value asUnsignedLongLong < (1 << (8*byteSize)) ifFalse: [^interpreterProxy primitiveFail]]].
+ byteSize <= 2
+ ifTrue:
+ [byteSize = 1
+ ifTrue: [interpreterProxy byteAt: addr put: value]
+ ifFalse: [interpreterProxy shortAt: addr put: value]]
+ ifFalse:
+ [byteSize = 4
+ ifTrue: [interpreterProxy long32At: addr put: value]
+ ifFalse: [interpreterProxy long64At: addr put: value]].
- byteSize < 4 ifTrue:[
- isSigned ifTrue:[
- max := 1 << (8 * byteSize - 1).
- value >= max ifTrue:[^interpreterProxy primitiveFail].
- value < (0 - max) ifTrue:[^interpreterProxy primitiveFail].
- ] ifFalse:[
- value >= (1 << (8*byteSize)) ifTrue:[^interpreterProxy primitiveFail].
- ].
- "short/byte"
- byteSize = 1
- ifTrue:[interpreterProxy byteAt: addr put: value]
- ifFalse:[ self cCode: '*((short int *) addr) = value'
- inSmalltalk: [interpreterProxy shortAt: addr put: value]].
- ] ifFalse:[interpreterProxy longAt: addr put: value].
^interpreterProxy pop: 5 thenPush: valueOop!
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 loadFloatRegs oop |
<var: #floatRet type: #double>
<var: #intRet type: 'SixteenByteReturn'>
<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 floatRegisterIndex > 0 ifTrue:
[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)].
atomicType := self atomicTypeOf: calloutState ffiRetHeader.
+ (atomicType >> 1) = (FFITypeSingleFloat >> 1)
- (atomicType >> 1) = (FFITypeSingleFloat > 1)
ifTrue:
[atomicType = FFITypeSingleFloat
ifTrue:
[floatRet := self
dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(long, long, long, long, long, long)')
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 (*)(long, long, long, long, long, long)')
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:
[intRet := self
dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'SixteenByteReturn (*)(long, long, long, long, long, long)')
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)].
"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 a ofType: (self ffiReturnType: specOnStack) in: calloutState]
ifFalse:
[oop := self ffiReturnStruct: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState].
^oop].
+ (atomicType >> 1) = (FFITypeSingleFloat >> 1)
- (atomicType >> 1) = (FFITypeSingleFloat > 1)
ifTrue:
[oop := interpreterProxy floatObjectOf: floatRet]
ifFalse:
[oop := self ffiCreateIntegralResultOop: intRet a
ofAtomicType: atomicType
in: calloutState].
^interpreterProxy methodReturnValue: oop!
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 floatRegisterIndex > 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)
- (atomicType >> 1) = (FFITypeSingleFloat > 1)
ifTrue:
[atomicType = FFITypeSingleFloat
ifTrue:
[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
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
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)
- (atomicType >> 1) = (FFITypeSingleFloat > 1)
ifTrue:
[oop := interpreterProxy floatObjectOf: floatRet]
ifFalse:
[oop := self ffiCreateIntegralResultOop: intRet
ofAtomicType: atomicType
in: calloutState].
^interpreterProxy methodReturnValue: oop!
More information about the Vm-dev
mailing list