[project @ 2001-10-26 11:53:34 by sewardj]

merge from stable, revs:

  1.74.4.1  +12 -11    fptools/ghc/compiler/nativeGen/MachCode.lhs
  1.30.4.1  +23 -0     fptools/ghc/compiler/nativeGen/Stix.lhs
  1.70.4.1  +2 -5      fptools/ghc/compiler/nativeGen/StixPrim.lhs

  Route all NCG panics to do with missing primop implementations and any
  other panic which could be caused by compiling legitimate sources
  through the function Stix.ncgPrimopMoan.  This emits a helpful message
  explaining what has happened, advises the use of -fvia-C as a
  workaround, and says please mail us.

diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs
index d4ea026..341c889 100644 (file)
--- a/ghc/compiler/nativeGen/MachCode.lhs
+++ b/ghc/compiler/nativeGen/MachCode.lhs
@@ -33,7 +33,8 @@ import Stix           ( getNatLabelNCG, StixTree(..),
                           pprStixTree, 
                           NatM, thenNat, returnNat, mapNat, 
                           mapAndUnzipNat, mapAccumLNat,
-                          getDeltaNat, setDeltaNat
+                          getDeltaNat, setDeltaNat,
+                          ncgPrimopMoan
                        )
 import Outputable
 import CmdLineOpts     ( opt_Static )
@@ -705,8 +706,8 @@ getRegister (StPrim primop [x]) -- unary PrimOps
              DoubleTanhOp  -> (False, SLIT("tanh"))
 
               other
-                 -> pprPanic "getRegister(x86,unary primop)" 
-                             (pprStixTree (StPrim primop [x]))
+                 -> ncgPrimopMoan "getRegister(x86,unary primop)" 
+                                  (pprStixTree (StPrim primop [x]))
 
 getRegister (StPrim primop [x, y]) -- dyadic PrimOps
   = case primop of
@@ -797,8 +798,8 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
       DoublePowerOp -> getRegister (StCall SLIT("pow") CCallConv DoubleRep 
                                            [x, y])
       other
-         -> pprPanic "getRegister(x86,dyadic primop)" 
-                     (pprStixTree (StPrim primop [x, y]))
+         -> ncgPrimopMoan "getRegister(x86,dyadic primop)" 
+                          (pprStixTree (StPrim primop [x, y]))
   where
 
     --------------------
@@ -967,7 +968,7 @@ getRegister leaf
     in
        returnNat (Any PtrRep code)
   | otherwise
-  = pprPanic "getRegister(x86)" (pprStixTree leaf)
+  = ncgPrimopMoan "getRegister(x86)" (pprStixTree leaf)
   where
     imm = maybeImm leaf
     imm__2 = case imm of Just x -> x
@@ -1074,8 +1075,8 @@ getRegister (StPrim primop [x]) -- unary PrimOps
              DoubleTanhOp  -> (False, SLIT("tanh"))
 
               other
-                 -> pprPanic "getRegister(sparc,monadicprimop)" 
-                             (pprStixTree (StPrim primop [x]))
+                 -> ncgPrimopMoan "getRegister(sparc,monadicprimop)" 
+                                  (pprStixTree (StPrim primop [x]))
 
 getRegister (StPrim primop [x, y]) -- dyadic PrimOps
   = case primop of
@@ -1164,8 +1165,8 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
                                            [x, y])
 
       other
-         -> pprPanic "getRegister(sparc,dyadic primop)" 
-                     (pprStixTree (StPrim primop [x, y]))
+         -> ncgPrimopMoan "getRegister(sparc,dyadic primop)" 
+                          (pprStixTree (StPrim primop [x, y]))
 
   where
     imul_div fn x y = getRegister (StCall fn CCallConv IntRep [x, y])
@@ -1197,7 +1198,7 @@ getRegister leaf
     in
        returnNat (Any PtrRep code)
   | otherwise
-  = pprPanic "getRegister(sparc)" (pprStixTree leaf)
+  = ncgPrimopMoan "getRegister(sparc)" (pprStixTree leaf)
   where
     imm = maybeImm leaf
     imm__2 = case imm of Just x -> x

diff --git a/ghc/compiler/nativeGen/Stix.lhs b/ghc/compiler/nativeGen/Stix.lhs
index ac10ae2..10a015e 100644 (file)
--- a/ghc/compiler/nativeGen/Stix.lhs
+++ b/ghc/compiler/nativeGen/Stix.lhs
@@ -22,11 +22,14 @@ module Stix (
         uniqOfNatM_State, deltaOfNatM_State,
 
        getUniqLabelNCG, getNatLabelNCG,
+        ncgPrimopMoan
     ) where
 
 #include "HsVersions.h"
 
 import Ratio           ( Rational )
+import IOExts          ( unsafePerformIO )
+import IO              ( hPutStrLn, stderr )
 
 import AbsCSyn         ( node, tagreg, MagicId(..) )
 import ForeignCall     ( CCallConv )
@@ -404,3 +407,23 @@ setDeltaNat :: Int -> NatM ()
 setDeltaNat delta (NatM_State us _)
    = ((), NatM_State us delta)
 \end{code}
+
+Giving up in a not-too-inelegant way.
+
+\begin{code}
+ncgPrimopMoan :: String -> SDoc -> a
+ncgPrimopMoan msg pp_rep
+   = unsafePerformIO (
+        hPutStrLn stderr (
+        "\n" ++
+        "You've fallen across an unimplemented case in GHC's native code generation\n" ++
+        "machinery.  You can work around this for the time being by compiling\n" ++ 
+        "this module via the C route, by giving the flag -fvia-C.\n" ++
+        "The panic below contains information, intended for the GHC implementors,\n" ++
+        "about the exact place where GHC gave up.  Please send it to us\n" ++
+        "at glasgow-haskell-bugs@haskell.org, so as to encourage us to fix this.\n"
+        )
+     )
+     `seq`
+     pprPanic msg pp_rep
+\end{code}

diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs
index fecca7e..14d90ca 100644 (file)
--- a/ghc/compiler/nativeGen/StixPrim.lhs
+++ b/ghc/compiler/nativeGen/StixPrim.lhs
@@ -110,7 +110,7 @@ foreignCallCode lhs (CCall (CCallSpec (StaticTarget fn) cconv safety)) rhs
                         other     -> IntRep
 
 foreignCallCode lhs call rhs
-  = pprPanic "Native code generator can't handle foreign call" (ppr call)
+  = ncgPrimopMoan "Native code generator can't handle foreign call" (ppr call)
 \end{code}
 
 
@@ -598,10 +598,7 @@ Now look for something more conventional.
 
 \begin{code}
 simplePrim pk [lhs] op rest  = StAssign pk lhs (StPrim op rest)
-simplePrim pk as    op bs    = simplePrim_error op
-
-simplePrim_error op
-    = error ("ERROR: primitive operation `"++show op++"'cannot be handled\nby the native-code generator.  Workaround: use -fvia-C.\n(Perhaps you should report it as a GHC bug, also.)\n")
+simplePrim pk as    op bs    = ncgPrimopMoan "simplPrim(all targets)" (ppr op)
 \end{code}
 
 %---------------------------------------------------------------------