+pprFCall call uniq args results vol_regs
+ = case call of
+ CCall (CCallSpec target _cconv safety) ->
+ vcat [ char '{',
+ declare_local_vars, -- local var for *result*
+ vcat local_arg_decls,
+ makeCall target safety
+ (process_casm local_vars pp_non_void_args (call_str target)),
+ assign_results,
+ char '}'
+ ]
+ DNCall (DNCallSpec isStatic kind assem nm argTys resTy) ->
+ let
+ resultVar = "_ccall_result"
+ hasAssemArg = isStatic || kind == DNConstructor
+ invokeOp =
+ case kind of
+ DNMethod
+ | isStatic -> "DN_invokeStatic"
+ | otherwise -> "DN_invokeMethod"
+ DNField
+ | isStatic ->
+ if resTy == DNUnit
+ then "DN_setStatic"
+ else "DN_getStatic"
+ | otherwise ->
+ if resTy == DNUnit
+ then "DN_setField"
+ else "DN_getField"
+ DNConstructor -> "DN_createObject"
+
+ (methArrDecl, methArrInit, methArrName, methArrLen)
+ | null argTys = (empty, empty, text "NULL", text "0")
+ | otherwise =
+ ( text "DotnetArg __meth_args[" <> int (length argTys) <> text "];"
+ , vcat (zipWith3 (\ idx arg argTy ->
+ text "__meth_args[" <> int idx <> text "].arg." <> text (toDotnetArgField argTy) <> equals <> ppr_amode arg <> semi $$
+ text "__meth_args[" <> int idx <> text "].arg_type=" <> text (toDotnetTy argTy) <> semi)
+ [0..]
+ non_void_args
+ argTys)
+ , text "__meth_args"
+ , int (length non_void_args)
+ )
+ in
+ vcat [ char '{',
+ declare_local_vars,
+ vcat local_arg_decls,
+ vcat [ methArrDecl
+ , methArrInit
+ , text "_ccall_result1 =" <+> text invokeOp <> parens (
+ hcat (punctuate comma $
+ (if hasAssemArg then
+ ((if null assem then
+ text "NULL"
+ else
+ doubleQuotes (text assem)):)
+ else
+ id) $
+ [ doubleQuotes $ text nm
+ , methArrName
+ , methArrLen
+ , text (toDotnetTy resTy)
+ , text "(void*)&" <> text resultVar
+ ])) <> semi
+ ],
+ assign_results,
+ char '}'
+ ]