+
+#if !defined(x86_64_TARGET_ARCH)
+insertRetAddr CCallConv args = ret_addr_arg : args
+insertRetAddr _ args = args
+#else
+-- On x86_64 we insert the return address after the 6th
+-- integer argument, because this is the point at which we
+-- need to flush a register argument to the stack (See rts/Adjustor.c for
+-- details).
+insertRetAddr CCallConv args = go 0 args
+ where go 6 args = ret_addr_arg : args
+ go n (arg@(_,_,_,rep):args)
+ | I64 <- rep = arg : go (n+1) args
+ | otherwise = arg : go n args
+ go n [] = []
+insertRetAddr _ args = args
+#endif
+
+ret_addr_arg = (text "original_return_addr", text "void*", undefined,
+ typeMachRep addrPrimTy)
+
+-- This function returns the primitive type associated with the boxed
+-- type argument to a foreign export (eg. Int ==> Int#). It assumes
+-- that all the types we are interested in have a single constructor
+-- with a single primitive-typed argument, which is true for all of the legal
+-- foreign export argument types (see TcType.legalFEArgTyCon).
+getPrimTyOf :: Type -> Type
+getPrimTyOf ty =
+ case splitProductType_maybe (repType ty) of
+ Just (_, _, data_con, [prim_ty]) ->
+ ASSERT(dataConSourceArity data_con == 1)
+ ASSERT2(isUnLiftedType prim_ty, ppr prim_ty)
+ prim_ty
+ _other -> pprPanic "DsForeign.getPrimTyOf" (ppr ty)