X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FMachCodeGen.hs;h=2d53ffb58ffc806dfed8bbfcb37825470683299e;hb=b7f448a4ebb2b924f279bf49432f07338f41a764;hp=e6cb6fc05d2046228a864c9af9e68796f38fb36b;hpb=1c5499d4d5d506ce0cc971e98c09bfbf7bc290a1;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/MachCodeGen.hs b/compiler/nativeGen/MachCodeGen.hs
index e6cb6fc..2d53ffb 100644
--- a/compiler/nativeGen/MachCodeGen.hs
+++ b/compiler/nativeGen/MachCodeGen.hs
@@ -11,6 +11,13 @@
 -- (c) the #if blah_TARGET_ARCH} things, the
 -- structure should not be too overwhelming.
 
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 module MachCodeGen ( cmmTopCodeGen, InstrBlock ) where
 
 #include "HsVersions.h"
@@ -64,10 +71,10 @@ import Data.Int
 type InstrBlock = OrdList Instr
 
 cmmTopCodeGen :: RawCmmTop -> NatM [NatCmmTop]
-cmmTopCodeGen (CmmProc info lab params blocks) = do
+cmmTopCodeGen (CmmProc info lab params (ListGraph blocks)) = do
   (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
   picBaseMb <- getPicBaseMaybeNat
-  let proc = CmmProc info lab params (concat nat_blocks)
+  let proc = CmmProc info lab params (ListGraph $ concat nat_blocks)
       tops = proc : concat statics
   case picBaseMb of
       Just picBase -> initializePicBase picBase tops
@@ -121,7 +128,7 @@ stmtToInstrs stmt = case stmt of
       | otherwise	 -> assignMem_IntCode kind addr src
 	where kind = cmmExprRep src
 
-    CmmCall target result_regs args _
+    CmmCall target result_regs args _ _
        -> genCCall target result_regs args
 
     CmmBranch id	  -> genBranch id
@@ -3206,13 +3213,13 @@ outOfLineFloatOp mop res args
         
       if localRegRep res == F64
         then
-          stmtToInstrs (CmmCall target [(res,FloatHint)] args CmmUnsafe)
+          stmtToInstrs (CmmCall target [(res,FloatHint)] args CmmUnsafe CmmMayReturn)
         else do
           uq <- getUniqueNat
           let 
             tmp = LocalReg uq F64 KindNonPtr
           -- in
-          code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args CmmUnsafe)
+          code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args CmmUnsafe CmmMayReturn)
           code2 <- stmtToInstrs (CmmAssign (CmmLocal res) (CmmReg (CmmLocal tmp)))
           return (code1 `appOL` code2)
   where