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:!
vm-dev@lists.squeakfoundation.org