Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/53a16984c1838d673cb4ab83defe2e9d105d914b

>---------------------------------------------------------------

commit 53a16984c1838d673cb4ab83defe2e9d105d914b
Author: David Terei <[email protected]>
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!"
 



_______________________________________________
Cvs-ghc mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/cvs-ghc

Reply via email to