[Vm-dev] VM Maker: VMMaker.oscog-eem.1408.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Jul 8 18:26:14 UTC 2015
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1408.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.1408
Author: eem
Time: 8 July 2015, 11:24:12.884 am
UUID: 51bc4e0f-a338-4394-8c6a-22b4b3e07c61
Ancestors: VMMaker.oscog-eem.1407
ThreadedFFIPlugin:
Allow ffiCreateIntegralResultOop:ofAtomicType:in: to be inlined. reduce the number of tests leading to the common case of an integral return in ffiCalloutTo:SpecOnStack:in: etc.
Refactor the remapOop:in: idiom up into InterpreterPlugin and use it in the ThreadedFFIPlugin.
=============== Diff against VMMaker.oscog-eem.1407 ===============
Item was added:
+ ----- Method: InterpreterPlugin>>remapOop:in: (in category 'simulation') -----
+ remapOop: oopOrList in: aBlock
+ "Call remapOop: for the variable oopOrList (or all of the variables in oopOrList) before evaluating
+ aBlock, and restore them after. If this is Spur, do nothing, since Spur does not GC on allocation
+ and the SmartSyntaxPluginCodeGenerator generates null code for this op in Spur."
+ <doNotGenerate>
+ | ctxt tempNames tempIndices |
+ interpreterProxy hasSpurMemoryManagerAPI ifTrue:
+ [^aBlock value].
+ ctxt := thisContext sender.
+ tempNames := ctxt tempNames.
+ oopOrList isArray
+ ifTrue:
+ [tempIndices := oopOrList collect: [:tempName| tempNames indexOf: tempName].
+ tempIndices do:
+ [:index| interpreterProxy pushRemappableOop: (ctxt namedTempAt: index)]]
+ ifFalse: [interpreterProxy pushRemappableOop: oopOrList].
+ ^aBlock ensure:
+ [oopOrList isArray
+ ifTrue:
+ [tempIndices reverseDo:
+ [:index| ctxt namedTempAt: index put: interpreterProxy popRemappableOop]]
+ ifFalse:
+ [1 to: ctxt numTemps do:
+ [:index|
+ (ctxt tempAt: index) = oopOrList ifTrue:
+ [ctxt tempAt: index put: interpreterProxy topRemappableOop]].
+ interpreterProxy popRemappableOop]]!
Item was removed:
- ----- Method: Object>>remapOop:in: (in category '*VMMaker-translation support') -----
- remapOop: oopOrList in: aBlock
- "For translation only; noop when running in Smalltalk."
- ^aBlock value!
Item was removed:
- ----- Method: SmartSyntaxInterpreterPlugin>>remapOop:in: (in category 'simulation') -----
- remapOop: oopOrList in: aBlock
- "Call remapOop: for the variable oopOrList (or all of the variables in oopOrList) before evaluating
- aBlock, and restore them after. If this is Spur, do nothing, since Spur does not GC on allocation
- and the SmartSyntaxPluginCodeGenerator generates null code for this op in Spur."
- <doNotGenerate>
- | ctxt tempNames tempIndices |
- interpreterProxy hasSpurMemoryManagerAPI ifTrue:
- [^aBlock value].
- ctxt := thisContext sender.
- tempNames := ctxt tempNames.
- oopOrList isArray
- ifTrue:
- [tempIndices := oopOrList collect: [:tempName| tempNames indexOf: tempName].
- tempIndices do:
- [:index| interpreterProxy pushRemappableOop: (ctxt namedTempAt: index)]]
- ifFalse: [interpreterProxy pushRemappableOop: oopOrList].
- ^aBlock ensure:
- [oopOrList isArray
- ifTrue:
- [tempIndices reverseDo:
- [:index| ctxt namedTempAt: index put: interpreterProxy popRemappableOop]]
- ifFalse:
- [1 to: ctxt numTemps do:
- [:index|
- (ctxt tempAt: index) = oopOrList ifTrue:
- [ctxt tempAt: index put: interpreterProxy topRemappableOop]].
- interpreterProxy popRemappableOop]]!
Item was removed:
- ----- Method: SmartSyntaxPluginCodeGenerator>>generateRemapOopIn:on:indent: (in category 'translating builtins') -----
- generateRemapOopIn: aNode on: aStream indent: level
- "Generate the C code for this message onto the given stream."
-
- aStream cr; nextPutAll: '#if SPURVM'; cr.
- self generateSpurRemapOopIn: aNode on: aStream indent: level.
- aStream cr; nextPutAll: '#else /* SPURVM */'; cr.
- self generateV3RemapOopIn: aNode on: aStream indent: level.
- aStream cr; nextPutAll: '#endif /* SPURVM */'; cr!
Item was removed:
- ----- Method: SmartSyntaxPluginCodeGenerator>>generateSpurRemapOopIn:on:indent: (in category 'translating builtins') -----
- generateSpurRemapOopIn: aNode on: aStream indent: level
- "Generate just the block argument for this message as Spur does not GC on allocation."
-
- aNode args second emitCCodeOn: aStream level: level generator: self!
Item was removed:
- ----- Method: SmartSyntaxPluginCodeGenerator>>generateV3RemapOopIn:on:indent: (in category 'translating builtins') -----
- generateV3RemapOopIn: aNode on: aStream indent: level
- "Generate call on remapOop: for the variable oopOrList (or all of the
- variables in oopOrList) before evaluating aBlock, and restore them after.
- This keeps the oops valid if, as V3 will, there is a GC on allocation."
-
- | idList |
- pluginFunctionsUsed add: #pushRemappableOop:; add: #popRemappableOop.
- idList := aNode args first nameOrValue.
- idList class == Array ifFalse: [idList := Array with: idList].
- idList do:
- [:each |
- aStream
- nextPutAll: 'pushRemappableOop(';
- nextPutAll: each asString;
- nextPutAll: ');']
- separatedBy: [aStream crtab: level].
- aStream cr.
- aNode args second emitCCodeOn: aStream level: level generator: self.
- level timesRepeat: [aStream tab].
- idList reversed do:
- [:each |
- aStream
- nextPutAll: each asString;
- nextPutAll: ' = popRemappableOop()']
- separatedBy: [aStream nextPut: $;; crtab: level]!
Item was changed:
----- Method: SmartSyntaxPluginCodeGenerator>>initializeCTranslationDictionary (in category 'translating builtins') -----
initializeCTranslationDictionary
"Initialize the dictionary mapping message names to actions for C code generation."
| pairs |
super initializeCTranslationDictionary.
pairs := #(
#asCInt #generateAsCInt:on:indent:
#asCUnsigned #generateAsCUnsigned:on:indent:
#asCBoolean #generateAsCBoolean:on:indent:
#asCDouble #generateAsCDouble:on:indent:
#asSmallIntegerObj #generateAsSmallIntegerObj:on:indent:
#asPositiveIntegerObj #generateAsPositiveIntegerObj:on:indent:
#asBooleanObj #generateAsBooleanObj:on:indent:
#asFloatObj #generateAsFloatObj:on:indent:
#asIf:var: #generateAsIfVar:on:indent:
#asIf:var:asValue: #generateAsIfVarAsValue:on:indent:
#asIf:var:put: #generateAsIfVarPut:on:indent:
#field: #generateField:on:indent:
#field:put: #generateFieldPut:on:indent:
#class #generateClass:on:indent:
#stSize #generateStSize:on:indent:
#stAt: #generateStAt:on:indent:
#stAt:put: #generateStAtPut:on:indent:
#asCharPtr #generateAsCharPtr:on:indent:
#asIntPtr #generateAsIntPtr:on:indent:
#cPtrAsOop #generateCPtrAsOop:on:indent:
#next #generateNext:on:indent:
#asOop: #generateAsOop:on:indent:
#asValue: #generateAsValue:on:indent:
#isFloat #generateIsFloat:on:indent:
#isIndexable #generateIsIndexable:on:indent:
#isIntegerOop #generateIsIntegerOop:on:indent:
#isIntegerValue #generateIsIntegerValue:on:indent:
"#FloatOop #generateIsFloatValue:on:indent:" "unused, never implemented"
#isWords #generateIsWords:on:indent:
#isWordsOrBytes #generateIsWordsOrBytes:on:indent:
#isPointers #generateIsPointers:on:indent:
#isNil #generateIsNil:on:indent:
#isMemberOf: #generateIsMemberOf:on:indent:
#isKindOf: #generateIsKindOf:on:indent:
#fromStack: #generateFromStack:on:indent:
"#clone #generateClone:on:indent:" "unused, never implemented"
"#new #generateNew:on:indent:" "unused, never implemented"
"#new: #generateNewSize:on:indent:" "unused, never implemented"
"#superclass #generateSuperclass:on:indent:" "unused, never implemented"
- #remapOop:in: #generateRemapOopIn:on:indent:
#debugCode: #generateDebugCode:on:indent:
).
1 to: pairs size by: 2 do: [:i |
translationDict at: (pairs at: i) put: (pairs at: i + 1)].
!
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 |
- | myThreadIndex atomicType floatRet intRet loadFloatRegs |
<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)].
- 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 = FFITypeSingleFloat
ifTrue:
+ [atomicType = FFITypeSingleFloat
+ ifTrue:
+ [floatRet := self
+ dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(int, int, int, int)')
+ 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 (*)(int, int, int, int)')
+ with: (calloutState integerRegisters at: 0)
+ with: (calloutState integerRegisters at: 1)
+ with: (calloutState integerRegisters at: 2)
+ with: (calloutState integerRegisters at: 3)]]
- [floatRet := self
- dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(int, int, int, int)')
- with: (calloutState integerRegisters at: 0)
- with: (calloutState integerRegisters at: 1)
- with: (calloutState integerRegisters at: 2)
- with: (calloutState integerRegisters at: 3)].
- atomicType = FFITypeDoubleFloat
- ifTrue:
- [floatRet := self
- dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(int, int, int, int)')
- 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 (*)(int, int, int, int)')
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:
+ [self ffiReturnPointer: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState]
+ ifFalse:
+ [self ffiReturnStruct: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState]].
- "Note: Order is important here since FFIFlagPointer + FFIFlagStructure is used to represent
- 'typedef void* VoidPointer' and VoidPointer must be returned as pointer *not* as struct."
- (calloutState ffiRetHeader anyMask: FFIFlagPointer) ifTrue:
- [^self ffiReturnPointer: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState].
-
- (calloutState ffiRetHeader anyMask: FFIFlagStructure) ifTrue:
- [^self ffiReturnStruct: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState].
+ (atomicType >> 1) = (FFITypeSingleFloat > 1)
+ ifTrue:
+ [oop := interpreterProxy floatObjectOf: floatRet]
+ ifFalse:
+ [oop := self ffiCreateIntegralResultOop: intRet
+ ofAtomicType: atomicType
+ in: calloutState].
+ ^interpreterProxy methodReturnValue: oop!
- (atomicType = FFITypeSingleFloat
- or: [atomicType = FFITypeDoubleFloat]) ifTrue:
- [^interpreterProxy methodReturnValue: (interpreterProxy floatObjectOf: floatRet)].
-
- ^interpreterProxy methodReturnValue: (self ffiCreateIntegralResultOop: intRet
- ofAtomicType: atomicType
- in: calloutState)!
Item was changed:
----- Method: ThreadedARMFFIPlugin>>ffiReturnStruct:ofType:in: (in category 'callout support') -----
ffiReturnStruct: longLongRet ofType: ffiRetType in: calloutState
<var: #longLongRet type: #usqLong>
<var: #calloutState type: #'CalloutState *'>
"Create a structure return value from an external function call. The value as been stored in
alloca'ed space pointed to by the calloutState."
| retOop retClass oop |
<inline: true>
retClass := interpreterProxy fetchPointer: 1 ofObject: ffiRetType.
retOop := interpreterProxy instantiateClass: retClass indexableSize: 0.
+ self remapOop: retOop
+ in: [oop := interpreterProxy
+ instantiateClass: interpreterProxy classByteArray
+ indexableSize: calloutState structReturnSize].
- interpreterProxy pushRemappableOop: retOop.
- oop := interpreterProxy
- instantiateClass: interpreterProxy classByteArray
- indexableSize: calloutState structReturnSize.
(self returnStructInRegisters: calloutState structReturnSize)
ifTrue:
[self mem: (interpreterProxy firstIndexableField: oop) cp: (self addressOf: longLongRet) y: calloutState structReturnSize]
ifFalse:
[self mem: (interpreterProxy firstIndexableField: oop) cp: calloutState limit y: calloutState structReturnSize].
- retOop := interpreterProxy popRemappableOop.
interpreterProxy storePointer: 0 ofObject: retOop withValue: oop.
^interpreterProxy methodReturnValue: retOop!
Item was changed:
----- Method: ThreadedFFIPlugin>>ffiCreateIntegralResultOop:ofAtomicType:in: (in category 'callout support') -----
ffiCreateIntegralResultOop: retVal ofAtomicType: atomicType in: calloutState
+ <inline: true>
<var: #calloutState type: #'CalloutState *'>
<var: #retVal type: #usqLong>
"Callout support. Return the appropriate oop for the given atomic type"
| shift value mask byteSize |
self assert: atomicType < FFITypeSingleFloat.
+ atomicType = FFITypeBool ifTrue:
+ ["Make sure bool honors the byte size requested"
+ byteSize := calloutState ffiRetHeader bitAnd: FFIStructSizeMask.
+ value := byteSize = (self sizeof: retVal)
+ ifTrue:[retVal]
+ ifFalse:[retVal bitAnd: 1 << (byteSize * 8) - 1].
+ ^value = 0
+ ifTrue:[interpreterProxy falseObject]
+ ifFalse:[interpreterProxy trueObject]].
+ atomicType <= FFITypeSignedInt ifTrue:
+ ["these are all generall integer returns"
+ atomicType <= FFITypeSignedShort ifTrue:
+ ["byte/short. first extract partial word, then sign extend"
- atomicType = FFITypeBool ifTrue:[
- "Make sure bool honors the byte size requested"
- byteSize := calloutState ffiRetHeader bitAnd: FFIStructSizeMask.
- value := byteSize = 4
- ifTrue:[retVal]
- ifFalse:[retVal bitAnd: 1 << (byteSize * 8) - 1].
- ^value = 0
- ifTrue:[interpreterProxy falseObject]
- ifFalse:[interpreterProxy trueObject]].
- atomicType <= FFITypeSignedInt ifTrue:[
- "these are all generall integer returns"
- atomicType <= FFITypeSignedShort ifTrue:[
- "byte/short. first extract partial word, then sign extend"
shift := (atomicType >> 1) * 8. "# of significant bits"
value := retVal bitAnd: (1 << shift - 1).
+ (atomicType anyMask: 1) ifTrue:
+ ["make the guy signed"
- (atomicType anyMask: 1) ifTrue:[
- "make the guy signed"
mask := 1 << (shift-1).
value := (value bitAnd: mask-1) - (value bitAnd: mask)].
^interpreterProxy integerObjectOf: value].
"32bit integer return"
^(atomicType anyMask: 1)
ifTrue:[interpreterProxy signed32BitIntegerFor: retVal] "signed return"
ifFalse:[interpreterProxy positive32BitIntegerFor: retVal]]. "unsigned return"
"longlong, char"
^(atomicType >> 1) = (FFITypeSignedLongLong >> 1)
ifTrue:
[(atomicType anyMask: 1)
ifTrue:[interpreterProxy signed64BitIntegerFor: retVal] "signed return"
ifFalse:[interpreterProxy positive64BitIntegerFor: retVal]]
ifFalse:
[interpreterProxy characterObjectOf:
(retVal bitAnd: (self cppIf: #SPURVM
ifTrue: [16rFFFFFFFF]
ifFalse: [255]))]!
Item was changed:
----- Method: ThreadedFFIPlugin>>ffiReturnPointer:ofType:in: (in category 'callout support') -----
ffiReturnPointer: retVal ofType: retType in: calloutState
<var: #calloutState type: #'CalloutState *'>
<var: #retVal type: #usqLong>
"Generic callout support. Create a pointer return value from an external function call"
| retClass atomicType retOop oop ptr classOop |
<var: #ptr type: #'sqInt *'>
retClass := interpreterProxy fetchPointer: 1 ofObject: retType.
retClass = interpreterProxy nilObject ifTrue:
["Create ExternalData upon return"
atomicType := self atomicTypeOf: calloutState ffiRetHeader.
(atomicType >> 1) = (FFITypeSignedChar >> 1) ifTrue: "String return"
[^self ffiReturnCStringFrom: (self cCoerceSimple: retVal to: #usqInt)].
"generate external data"
+ self remapOop: retType in:
+ [oop := interpreterProxy
+ instantiateClass: interpreterProxy classExternalAddress
+ indexableSize: 4.
+ ptr := interpreterProxy firstIndexableField: oop.
+ ptr at: 0 put: (self cCoerceSimple: retVal to: #sqInt).
+ self remapOop: oop in:
+ [retOop := interpreterProxy
+ instantiateClass: interpreterProxy classExternalData
+ indexableSize: 0].
+ interpreterProxy storePointer: 0 ofObject: retOop withValue: oop].
+ interpreterProxy storePointer: 1 ofObject: retOop withValue: retType.
- interpreterProxy pushRemappableOop: retType.
- oop := interpreterProxy
- instantiateClass: interpreterProxy classExternalAddress
- indexableSize: 4.
- ptr := interpreterProxy firstIndexableField: oop.
- ptr at: 0 put: (self cCoerceSimple: retVal to: #sqInt).
- interpreterProxy pushRemappableOop: oop. "preserve for gc"
- retOop := interpreterProxy
- instantiateClass: interpreterProxy classExternalData
- indexableSize: 0.
- oop := interpreterProxy popRemappableOop. "external address"
- interpreterProxy storePointer: 0 ofObject: retOop withValue: oop.
- oop := interpreterProxy popRemappableOop. "return type"
- interpreterProxy storePointer: 1 ofObject: retOop withValue: oop.
^interpreterProxy methodReturnValue: retOop].
"non-atomic pointer return"
- interpreterProxy pushRemappableOop: retClass. "preserve for gc"
classOop := (calloutState ffiRetHeader anyMask: FFIFlagStructure)
ifTrue:[interpreterProxy classByteArray]
ifFalse:[interpreterProxy classExternalAddress].
+ self remapOop: retClass in:
+ [oop := interpreterProxy
+ instantiateClass: classOop
+ indexableSize: 4].
- oop := interpreterProxy
- instantiateClass: classOop
- indexableSize: 4.
ptr := interpreterProxy firstIndexableField: oop.
ptr at: 0 put: (self cCoerceSimple: retVal to: #sqInt).
+ self remapOop: oop in:
+ [retOop := interpreterProxy instantiateClass: retClass indexableSize: 0].
- retClass := interpreterProxy popRemappableOop. "return class"
- interpreterProxy pushRemappableOop: oop. "preserve for gc"
- retOop := interpreterProxy instantiateClass: retClass indexableSize: 0.
- oop := interpreterProxy popRemappableOop. "external address"
interpreterProxy storePointer: 0 ofObject: retOop withValue: oop.
^interpreterProxy methodReturnValue: retOop!
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 oop |
- | myThreadIndex atomicType floatRet intRet |
<var: #floatRet type: #double>
<var: #intRet type: #usqLong>
<inline: true>
self cppIf: COGMTVM ifTrue:
[(calloutState callFlags anyMask: FFICallFlagThreaded) ifTrue:
[myThreadIndex := interpreterProxy disownVM: 0]].
self registerArgsSlop + self cStackAlignment > 0 ifTrue:
[self setsp: calloutState argVector].
atomicType := self atomicTypeOf: calloutState ffiRetHeader.
+ (atomicType >> 1) = (FFITypeSingleFloat > 1)
- (atomicType = FFITypeSingleFloat
- or: [atomicType = FFITypeDoubleFloat])
ifTrue:
[floatRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)()')]
ifFalse:
[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].
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:
+ [self ffiReturnPointer: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState]
+ ifFalse:
+ [self ffiReturnStruct: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState]].
- "Note: Order is important here since FFIFlagPointer + FFIFlagStructure is used to represent
- 'typedef void* VoidPointer' and VoidPointer must be returned as pointer *not* as struct."
- (calloutState ffiRetHeader anyMask: FFIFlagPointer) ifTrue:
- [^self ffiReturnPointer: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState].
-
- (calloutState ffiRetHeader anyMask: FFIFlagStructure) ifTrue:
- [^self ffiReturnStruct: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState].
+ (atomicType >> 1) = (FFITypeSingleFloat > 1)
+ ifTrue:
+ [oop := interpreterProxy floatObjectOf: floatRet]
+ ifFalse:
+ [oop := self ffiCreateIntegralResultOop: intRet
+ ofAtomicType: atomicType
+ in: calloutState].
+ ^interpreterProxy methodReturnValue: oop!
- (atomicType = FFITypeSingleFloat
- or: [atomicType = FFITypeDoubleFloat]) ifTrue:
- [^interpreterProxy methodReturnValue: (interpreterProxy floatObjectOf: floatRet)].
-
- ^interpreterProxy methodReturnValue: (self ffiCreateIntegralResultOop: intRet
- ofAtomicType: atomicType
- in: calloutState)!
Item was changed:
----- Method: ThreadedIA32FFIPlugin>>ffiReturnStruct:ofType:in: (in category 'callout support') -----
ffiReturnStruct: longLongRet ofType: ffiRetType in: calloutState
<var: #longLongRet type: #usqLong>
<var: #calloutState type: #'CalloutState *'>
"Create a structure return value from an external function call. The value as been stored in
alloca'ed space pointed to by the calloutState."
| retOop retClass oop |
<inline: true>
retClass := interpreterProxy fetchPointer: 1 ofObject: ffiRetType.
retOop := interpreterProxy instantiateClass: retClass indexableSize: 0.
+ self remapOop: retOop
+ in: [oop := interpreterProxy
+ instantiateClass: interpreterProxy classByteArray
+ indexableSize: calloutState structReturnSize].
- interpreterProxy pushRemappableOop: retOop.
- oop := interpreterProxy
- instantiateClass: interpreterProxy classByteArray
- indexableSize: calloutState structReturnSize.
(self returnStructInRegisters: calloutState structReturnSize)
ifTrue:
[self mem: (interpreterProxy firstIndexableField: oop) cp: (self addressOf: longLongRet) y: calloutState structReturnSize]
ifFalse:
[self mem: (interpreterProxy firstIndexableField: oop) cp: calloutState limit y: calloutState structReturnSize].
- retOop := interpreterProxy popRemappableOop.
interpreterProxy storePointer: 0 ofObject: retOop withValue: oop.
^interpreterProxy methodReturnValue: retOop!
Item was added:
+ ----- Method: VMPluginCodeGenerator>>generateRemapOopIn:on:indent: (in category 'C translation') -----
+ generateRemapOopIn: aNode on: aStream indent: level
+ "Generate the C code for this message onto the given stream."
+
+ aStream cr; nextPutAll: '#if SPURVM'; cr.
+ self generateSpurRemapOopIn: aNode on: aStream indent: level.
+ aStream cr; nextPutAll: '#else /* SPURVM */'; cr.
+ self generateV3RemapOopIn: aNode on: aStream indent: level.
+ aStream cr; nextPutAll: '#endif /* SPURVM */'; cr!
Item was added:
+ ----- Method: VMPluginCodeGenerator>>generateSpurRemapOopIn:on:indent: (in category 'C translation') -----
+ generateSpurRemapOopIn: aNode on: aStream indent: level
+ "Generate just the block argument for this message as Spur does not GC on allocation."
+
+ aNode args second emitCCodeOn: aStream level: level generator: self!
Item was added:
+ ----- Method: VMPluginCodeGenerator>>generateV3RemapOopIn:on:indent: (in category 'C translation') -----
+ generateV3RemapOopIn: aNode on: aStream indent: level
+ "Generate call on remapOop: for the variable oopOrList (or all of the
+ variables in oopOrList) before evaluating aBlock, and restore them after.
+ This keeps the oops valid if, as V3 will, there is a GC on allocation."
+
+ | idList |
+ pluginFunctionsUsed add: #pushRemappableOop:; add: #popRemappableOop.
+ idList := aNode args first nameOrValue.
+ idList class == Array ifFalse: [idList := Array with: idList].
+ idList do:
+ [:each |
+ aStream
+ tab: level;
+ nextPutAll: 'pushRemappableOop(';
+ nextPutAll: each asString;
+ nextPutAll: ');']
+ separatedBy: [aStream cr].
+ aStream cr.
+ aNode args second emitCCodeOn: aStream level: level generator: self.
+ level timesRepeat: [aStream tab].
+ idList reversed do:
+ [:each |
+ aStream
+ nextPutAll: each asString;
+ nextPutAll: ' = popRemappableOop()']
+ separatedBy: [aStream nextPut: $;; crtab: level]!
Item was changed:
----- Method: VMPluginCodeGenerator>>initializeCTranslationDictionary (in category 'public') -----
initializeCTranslationDictionary
"Initialize the dictionary mapping message names to actions for C code generation."
super initializeCTranslationDictionary.
translationDict
at: #expandDereferenceInterpreterProxyFunctionTable
+ put: #generateInterpreterProxyFunctionDeference:on:indent:;
+ at: #remapOop:in:
+ put: #generateRemapOopIn:on:indent:!
- put: #generateInterpreterProxyFunctionDeference:on:indent:!
More information about the Vm-dev
mailing list