[commit: ghc] master: Specify unsupported ops, don't just use a catch all (53a1698)
David Terei
davidterei at gmail.com
Tue Nov 22 21:06:54 CET 2011
Repository : ssh://darcs.haskell.org//srv/darcs/ghc
On branch : master
http://hackage.haskell.org/trac/ghc/changeset/53a16984c1838d673cb4ab83defe2e9d105d914b
>---------------------------------------------------------------
commit 53a16984c1838d673cb4ab83defe2e9d105d914b
Author: David Terei <davidterei at gmail.com>
Date: Tue Nov 22 11:24:16 2011 -0800
Specify unsupported ops, don't just use a catch all
Better to specifically list the unsupported cases in code
than to have a catch all that panics. The later method hides
problems when new constructors are added such as the recent
additions to the supported Cmm prim ops that weren't ported
to the C backend since no one noticed.
>---------------------------------------------------------------
compiler/cmm/PprC.hs | 30 +++++++------
compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 72 +++++++++++++++++++++++++------
2 files changed, 75 insertions(+), 27 deletions(-)
diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index e60e9ba..6c18ee6 100644
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -580,21 +580,25 @@ pprMachOp_for_C mop = case mop of
-- noop casts
MO_UU_Conv from to | from == to -> empty
- MO_UU_Conv _from to -> parens (machRep_U_CType to)
+ MO_UU_Conv _from to -> parens (machRep_U_CType to)
MO_SS_Conv from to | from == to -> empty
- MO_SS_Conv _from to -> parens (machRep_S_CType to)
-
- -- TEMPORARY: the old code didn't check this case, so let's leave it out
- -- to facilitate comparisons against the old output code.
- --MO_FF_Conv from to | from == to -> empty
- MO_FF_Conv _from to -> parens (machRep_F_CType to)
-
- MO_SF_Conv _from to -> parens (machRep_F_CType to)
- MO_FS_Conv _from to -> parens (machRep_S_CType to)
-
- _ -> pprTrace "offending mop" (ptext $ sLit $ show mop) $
- panic "PprC.pprMachOp_for_C: unknown machop"
+ MO_SS_Conv _from to -> parens (machRep_S_CType to)
+
+ MO_FF_Conv from to | from == to -> empty
+ MO_FF_Conv _from to -> parens (machRep_F_CType to)
+
+ MO_SF_Conv _from to -> parens (machRep_F_CType to)
+ MO_FS_Conv _from to -> parens (machRep_S_CType to)
+
+ MO_S_MulMayOflo _ -> pprTrace "offending mop:"
+ (ptext $ sLit "MO_S_MulMayOflo")
+ (panic $ "PprC.pprMachOp_for_C: MO_S_MulMayOflo"
+ ++ " should have been handled earlier!")
+ MO_U_MulMayOflo _ -> pprTrace "offending mop:"
+ (ptext $ sLit "MO_U_MulMayOflo")
+ (panic $ "PprC.pprMachOp_for_C: MO_U_MulMayOflo"
+ ++ " should have been handled earlier!")
signedOp :: MachOp -> Bool -- Argument type(s) are signed ints
signedOp (MO_S_Quot _) = True
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index b4e2790..7144b85 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -458,7 +458,8 @@ cmmPrimOpFunctions env mop
(MO_PopCnt w) -> fsLit $ "llvm.ctpop." ++ show (widthToLlvmInt w)
- a -> panic $ "cmmPrimOpFunctions: Unknown callish op! (" ++ show a ++ ")"
+ MO_WriteBarrier -> panic $ "cmmPrimOpFunctions: MO_WriteBarrier not supported here"
+ MO_Touch -> panic $ "cmmPrimOpFunctions: MO_Touch not supported here"
where
intrinTy1 = (if getLlvmVer env >= 28
@@ -754,7 +755,46 @@ genMachOp env _ op [x] = case op of
MO_FF_Conv from to
-> sameConv from (widthToLlvmFloat to) LM_Fptrunc LM_Fpext
- a -> panic $ "genMachOp: unmatched unary CmmMachOp! (" ++ show a ++ ")"
+ -- Handle unsupported cases explicitly so we get a warning
+ -- of missing case when new MachOps added
+ MO_Add _ -> panicOp
+ MO_Mul _ -> panicOp
+ MO_Sub _ -> panicOp
+ MO_S_MulMayOflo _ -> panicOp
+ MO_S_Quot _ -> panicOp
+ MO_S_Rem _ -> panicOp
+ MO_U_MulMayOflo _ -> panicOp
+ MO_U_Quot _ -> panicOp
+ MO_U_Rem _ -> panicOp
+
+ MO_Eq _ -> panicOp
+ MO_Ne _ -> panicOp
+ MO_S_Ge _ -> panicOp
+ MO_S_Gt _ -> panicOp
+ MO_S_Le _ -> panicOp
+ MO_S_Lt _ -> panicOp
+ MO_U_Ge _ -> panicOp
+ MO_U_Gt _ -> panicOp
+ MO_U_Le _ -> panicOp
+ MO_U_Lt _ -> panicOp
+
+ MO_F_Add _ -> panicOp
+ MO_F_Sub _ -> panicOp
+ MO_F_Mul _ -> panicOp
+ MO_F_Quot _ -> panicOp
+ MO_F_Eq _ -> panicOp
+ MO_F_Ne _ -> panicOp
+ MO_F_Ge _ -> panicOp
+ MO_F_Gt _ -> panicOp
+ MO_F_Le _ -> panicOp
+ MO_F_Lt _ -> panicOp
+
+ MO_And _ -> panicOp
+ MO_Or _ -> panicOp
+ MO_Xor _ -> panicOp
+ MO_Shl _ -> panicOp
+ MO_U_Shr _ -> panicOp
+ MO_S_Shr _ -> panicOp
where
negate ty v2 negOp = do
@@ -780,6 +820,9 @@ genMachOp env _ op [x] = case op of
w | w > toWidth -> sameConv' reduce
_w -> return x'
+ panicOp = panic $ "LLVM.CodeGen.genMachOp: non unary op encourntered"
+ ++ "with one argument! (" ++ show op ++ ")"
+
-- Handle GlobalRegs pointers
genMachOp env opt o@(MO_Add _) e@[(CmmReg (CmmGlobal r)), (CmmLit (CmmInt n _))]
= genMachOp_fast env opt o r (fromInteger n) e
@@ -863,7 +906,15 @@ genMachOp_slow env opt op [x, y] = case op of
MO_U_Shr _ -> genBinMach LM_MO_LShr
MO_S_Shr _ -> genBinMach LM_MO_AShr
- a -> panic $ "genMachOp: unmatched binary CmmMachOp! (" ++ show a ++ ")"
+ MO_Not _ -> panicOp
+ MO_S_Neg _ -> panicOp
+ MO_F_Neg _ -> panicOp
+
+ MO_SF_Conv _ _ -> panicOp
+ MO_FS_Conv _ _ -> panicOp
+ MO_SS_Conv _ _ -> panicOp
+ MO_UU_Conv _ _ -> panicOp
+ MO_FF_Conv _ _ -> panicOp
where
binLlvmOp ty binOp = do
@@ -876,8 +927,7 @@ genMachOp_slow env opt op [x, y] = case op of
top1 ++ top2)
else do
- -- XXX: Error. Continue anyway so we can debug the generated
- -- ll file.
+ -- Error. Continue anyway so we can debug the generated ll file.
let cmmToStr = (lines . show . llvmSDoc . PprCmm.pprExpr (getLlvmPlatform env))
let dx = Comment $ map fsLit $ cmmToStr x
let dy = Comment $ map fsLit $ cmmToStr y
@@ -886,15 +936,6 @@ genMachOp_slow env opt op [x, y] = case op of
`snocOL` dy `snocOL` s1
return (env2, v1, allStmts, top1 ++ top2)
- -- let o = case binOp vx vy of
- -- Compare op _ _ -> show op
- -- LlvmOp op _ _ -> show op
- -- _ -> "unknown"
- -- panic $ "genMachOp: comparison between different types ("
- -- ++ o ++ " "++ show vx ++ ", " ++ show vy ++ ")"
- -- ++ "\ne1: " ++ (show.llvmSDoc.PprCmm.pprExpr (getLlvmPlatform env) $ x)
- -- ++ "\ne2: " ++ (show.llvmSDoc.PprCmm.pprExpr (getLlvmPlatform env) $ y)
-
-- | Need to use EOption here as Cmm expects word size results from
-- comparisons while LLVM return i1. Need to extend to llvmWord type
-- if expected
@@ -956,6 +997,9 @@ genMachOp_slow env opt op [x, y] = case op of
else
panic $ "isSMulOK: Not bit type! (" ++ show word ++ ")"
+ panicOp = panic $ "LLVM.CodeGen.genMachOp_slow: unary op encourntered"
+ ++ "with two arguments! (" ++ show op ++ ")"
+
-- More then two expression, invalid!
genMachOp_slow _ _ _ _ = panic "genMachOp: More then 2 expressions in MachOp!"
More information about the Cvs-ghc
mailing list