diff options
| -rw-r--r-- | compiler/cmm/CmmCvt.hs | 18 | ||||
| -rw-r--r-- | compiler/cmm/CmmNode.hs | 8 | ||||
| -rw-r--r-- | compiler/cmm/PprCmm.hs | 2 |
3 files changed, 7 insertions, 21 deletions
diff --git a/compiler/cmm/CmmCvt.hs b/compiler/cmm/CmmCvt.hs index de542fbe1b..3d312caac4 100644 --- a/compiler/cmm/CmmCvt.hs +++ b/compiler/cmm/CmmCvt.hs @@ -24,17 +24,13 @@ cmmOfZgraph tops = map mapTop tops data ValueDirection = Arguments | Results -add_hints :: Convention -> ValueDirection -> [a] -> [Old.CmmHinted a] +add_hints :: ForeignTarget -> ValueDirection -> [a] -> [Old.CmmHinted a] add_hints conv vd args = zipWith Old.CmmHinted args (get_hints conv vd) -get_hints :: Convention -> ValueDirection -> [ForeignHint] -get_hints (Foreign (ForeignConvention _ hints _)) Arguments = hints -get_hints (Foreign (ForeignConvention _ _ hints)) Results = hints -get_hints _other_conv _vd = repeat NoHint - -get_conv :: ForeignTarget -> Convention -get_conv (PrimTarget _) = NativeNodeCall -- JD: SUSPICIOUS -get_conv (ForeignTarget _ fc) = Foreign fc +get_hints :: ForeignTarget -> ValueDirection -> [ForeignHint] +get_hints (ForeignTarget _ (ForeignConvention _ hints _)) Arguments = hints +get_hints (ForeignTarget _ (ForeignConvention _ _ hints)) Results = hints +get_hints (PrimTarget _) _vd = repeat NoHint cmm_target :: ForeignTarget -> Old.CmmCallTarget cmm_target (PrimTarget op) = Old.CmmPrim op @@ -89,8 +85,8 @@ ofZgraph g = Old.ListGraph $ mapMaybe convert_block $ postorderDfs g CmmUnsafeForeignCall (PrimTarget MO_Touch) _ _ -> Old.CmmNop CmmUnsafeForeignCall target ress args -> Old.CmmCall (cmm_target target) - (add_hints (get_conv target) Results ress) - (add_hints (get_conv target) Arguments args) + (add_hints target Results ress) + (add_hints target Arguments args) Old.CmmMayReturn last :: CmmNode O C -> () -> [Old.CmmStmt] diff --git a/compiler/cmm/CmmNode.hs b/compiler/cmm/CmmNode.hs index 971b351320..2a491e9b6b 100644 --- a/compiler/cmm/CmmNode.hs +++ b/compiler/cmm/CmmNode.hs @@ -223,14 +223,6 @@ data Convention | GC -- Entry to the garbage collector: uses the node reg! | PrimOpCall -- Calling prim ops | PrimOpReturn -- Returning from prim ops - | Foreign -- Foreign call/return - ForeignConvention - | Private - -- Used for control transfers within a (pre-CPS) procedure All - -- jump sites known, never pushed on the stack (hence no SRT) - -- You can choose whatever calling convention you please - -- (provided you make sure all the call sites agree)! - -- This data type eventually to be extended to record the convention. deriving( Eq ) data ForeignConvention diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs index d32f129247..81c9b9ea93 100644 --- a/compiler/cmm/PprCmm.hs +++ b/compiler/cmm/PprCmm.hs @@ -147,8 +147,6 @@ pprConvention Slow = text "<slow-convention>" pprConvention GC = text "<gc-convention>" pprConvention PrimOpCall = text "<primop-call-convention>" pprConvention PrimOpReturn = text "<primop-ret-convention>" -pprConvention (Foreign c) = ppr c -pprConvention (Private {}) = text "<private-convention>" pprForeignConvention :: ForeignConvention -> SDoc pprForeignConvention (ForeignConvention c as rs) = ppr c <> ppr as <> ppr rs |