X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FMachCodeGen.hs;h=081d3ef6c780b6d807e7936c8119ed82152ae338;hb=d5938fb228511bfdce45e148ea4906129692e67f;hp=e1ef465e98cae09f5e398f304ea2909aa246ed8d;hpb=7fc749a43b4b6b85d234fa95d4928648259584f4;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/MachCodeGen.hs b/compiler/nativeGen/MachCodeGen.hs
index e1ef465..081d3ef 100644
--- a/compiler/nativeGen/MachCodeGen.hs
+++ b/compiler/nativeGen/MachCodeGen.hs
@@ -71,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
@@ -2969,7 +2969,7 @@ genCondJump id bool = do
 
 genCCall
     :: CmmCallTarget		-- function to call
-    -> CmmHintFormals		-- where to put the result
+    -> CmmFormals		-- where to put the result
     -> CmmActuals		-- arguments (of mixed type)
     -> NatM InstrBlock
 
@@ -3203,7 +3203,7 @@ genCCall target dest_regs args = do
 
 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
 
-outOfLineFloatOp :: CallishMachOp -> CmmFormal -> CmmActuals
+outOfLineFloatOp :: CallishMachOp -> CmmFormalWithoutKind -> CmmActuals
   -> NatM InstrBlock
 outOfLineFloatOp mop res args
   = do
@@ -3217,7 +3217,7 @@ outOfLineFloatOp mop res args
         else do
           uq <- getUniqueNat
           let 
-            tmp = LocalReg uq F64 KindNonPtr
+            tmp = LocalReg uq F64 GCKindNonPtr
           -- in
           code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args CmmUnsafe CmmMayReturn)
           code2 <- stmtToInstrs (CmmAssign (CmmLocal res) (CmmReg (CmmLocal tmp)))
@@ -3896,7 +3896,8 @@ genSwitch expr ids
             op = OpAddr (AddrBaseIndex (EABaseReg tableReg)
                                        (EAIndex reg wORD_SIZE) (ImmInt 0))
 
-#if x86_64_TARGET_ARCH && darwin_TARGET_OS
+#if x86_64_TARGET_ARCH
+#if darwin_TARGET_OS
     -- on Mac OS X/x86_64, put the jump table in the text section
     -- to work around a limitation of the linker.
     -- ld64 is unable to handle the relocations for
@@ -3909,6 +3910,23 @@ genSwitch expr ids
                             LDATA Text (CmmDataLabel lbl : jumpTable)
                     ]
 #else
+    -- HACK: On x86_64 binutils<2.17 is only able to generate PC32
+    -- relocations, hence we only get 32-bit offsets in the jump
+    -- table. As these offsets are always negative we need to properly
+    -- sign extend them to 64-bit. This hack should be removed in
+    -- conjunction with the hack in PprMach.hs/pprDataItem once
+    -- binutils 2.17 is standard.
+            code = e_code `appOL` t_code `appOL` toOL [
+			    LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
+			    MOVSxL I32
+				   (OpAddr (AddrBaseIndex (EABaseReg tableReg)
+							  (EAIndex reg wORD_SIZE) (ImmInt 0)))
+				   (OpReg reg),
+			    ADD wordRep (OpReg reg) (OpReg tableReg),
+			    JMP_TBL (OpReg tableReg) [ id | Just id <- ids ]
+		   ]
+#endif
+#else
             code = e_code `appOL` t_code `appOL` toOL [
                             LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
                             ADD wordRep op (OpReg tableReg),