From 9551c28bf72a42112a0cdf3c147758c8b14848b1 Mon Sep 17 00:00:00 2001 From: sewardj Date: Fri, 26 Oct 2001 11:53:34 +0000 Subject: [PATCH] [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. --- ghc/compiler/nativeGen/MachCode.lhs | 23 ++++++++++++----------- ghc/compiler/nativeGen/Stix.lhs | 23 +++++++++++++++++++++++ ghc/compiler/nativeGen/StixPrim.lhs | 7 ++----- 3 files changed, 37 insertions(+), 16 deletions(-) diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs index d4ea026..341c889 100644 --- 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 --- 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 --- 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} %--------------------------------------------------------------------- -- 1.7.10.4