X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FabsCSyn%2FAbsCUtils.lhs;h=fef7bf56a7f30e2ba8cf3430abef33870f92f440;hb=c9a32c38c1d80b5df0f816f57a2d11555b7eadb4;hp=24067c0a87569c91200358a0e5d72a8bc3a1ff86;hpb=98688c6e8fd33f31c51218cf93cbf03fe3a5e73d;p=ghc-hetmet.git

diff --git a/ghc/compiler/absCSyn/AbsCUtils.lhs b/ghc/compiler/absCSyn/AbsCUtils.lhs
index 24067c0..fef7bf5 100644
--- a/ghc/compiler/absCSyn/AbsCUtils.lhs
+++ b/ghc/compiler/absCSyn/AbsCUtils.lhs
@@ -12,7 +12,8 @@ module AbsCUtils (
 	getAmodeRep,
 	mixedTypeLocn, mixedPtrLocn,
 	flattenAbsC,
-	mkAbsCStmtList
+	mkAbsCStmtList,
+	shimFCallArg
 	-- printing/forcing stuff comes from PprAbsC
     ) where
 
@@ -20,6 +21,10 @@ module AbsCUtils (
 #include "../includes/config.h"
 
 import AbsCSyn
+import Type		( tyConAppTyCon, repType )
+import TysPrim		( foreignObjPrimTyCon, arrayPrimTyCon, 
+			  byteArrayPrimTyCon, mutableByteArrayPrimTyCon,
+			  mutableArrayPrimTyCon )
 import CLabel		( mkMAP_FROZEN_infoLabel )
 import Digraph		( stronglyConnComp, SCC(..) )
 import DataCon		( fIRST_TAG, dataConTag )
@@ -32,7 +37,7 @@ import UniqSupply	( uniqFromSupply, uniqsFromSupply, splitUniqSupply,
 			  UniqSupply )
 import CmdLineOpts      ( opt_EmitCExternDecls, opt_Unregisterised )
 import ForeignCall	( ForeignCall(..), CCallSpec(..), isDynamicTarget )
-import StgSyn		( StgOp(..) )
+import StgSyn		( StgOp(..), stgArgType )
 import CoreSyn		( AltCon(..) )
 import SMRep		( arrPtrsHdrSize, arrWordsHdrSize, fixedHdrSize )
 import Outputable
@@ -1292,5 +1297,19 @@ translateOp [r] EqForeignObj [a1,a2]  = Just (r, MO_Nat_Eq,    [a1,a2])
 translateOp [r] EqStablePtrOp [a1,a2]  = Just (r, MO_Nat_Eq,    [a1,a2])
 
 translateOp _ _ _ = Nothing
+\end{code}
+
 
+\begin{code}
+shimFCallArg arg amode
+  | tycon == foreignObjPrimTyCon
+	= CMacroExpr AddrRep ForeignObj_CLOSURE_DATA [amode]
+  | tycon == arrayPrimTyCon || tycon == mutableArrayPrimTyCon
+	= CMacroExpr PtrRep PTRS_ARR_CTS [amode]
+  | tycon == byteArrayPrimTyCon || tycon == mutableByteArrayPrimTyCon
+	= CMacroExpr AddrRep BYTE_ARR_CTS [amode]
+  | otherwise = amode
+  where	
+	-- should be a tycon app, since this is a foreign call
+	tycon = tyConAppTyCon (repType (stgArgType arg))
 \end{code}