Merge in new code generator branch.

[ghc-hetmet.git] / compiler / nativeGen / PPC / CodeGen.hs

diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index e57d3ca..29b9a54 100644 (file)
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -22,7 +22,7 @@ where
 
 #include "HsVersions.h"
 #include "nativeGen/NCG.h"
-#include "MachDeps.h"
+#include "../includes/MachDeps.h"
 
 -- NCG stuff:
 import PPC.Instr
@@ -35,12 +35,13 @@ import PIC
 import Size
 import RegClass
 import Reg
+import TargetReg
 import Platform
 
 -- Our intermediate code:
 import BlockId
 import PprCmm          ( pprExpr )
-import Cmm
+import OldCmm
 import CLabel
 
 -- The rest:
@@ -48,6 +49,7 @@ import StaticFlags    ( opt_PIC )
 import OrdList
 import qualified Outputable as O
 import Outputable
+import Unique
 import DynFlags
 
 import Control.Monad   ( mapAndUnzipM )
@@ -73,10 +75,10 @@ cmmTopCodeGen
        -> RawCmmTop 
        -> NatM [NatCmmTop Instr]
 
-cmmTopCodeGen dflags (CmmProc info lab params (ListGraph blocks)) = do
+cmmTopCodeGen dflags (CmmProc info lab (ListGraph blocks)) = do
   (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
   picBaseMb <- getPicBaseMaybeNat
-  let proc = CmmProc info lab params (ListGraph $ concat nat_blocks)
+  let proc = CmmProc info lab (ListGraph $ concat nat_blocks)
       tops = proc : concat statics
       os   = platformOS $ targetPlatform dflags
   case picBaseMb of
@@ -176,15 +178,15 @@ swizzleRegisterRep (Any _ codefn)     size = Any   size codefn
 getRegisterReg :: CmmReg -> Reg
 
 getRegisterReg (CmmLocal (LocalReg u pk))
-  = mkVReg u (cmmTypeSize pk)
+  = RegVirtual $ mkVirtualReg u (cmmTypeSize pk)
 
 getRegisterReg (CmmGlobal mid)
-  = case get_GlobalReg_reg_or_addr mid of
-       Left (RealReg rrno) -> RealReg rrno
-       _other -> pprPanic "getRegisterReg-memory" (ppr $ CmmGlobal mid)
-          -- By this stage, the only MagicIds remaining should be the
-          -- ones which map to a real machine register on this
-          -- platform.  Hence ...
+  = case globalRegMaybe mid of
+        Just reg -> reg
+        Nothing  -> pprPanic "getRegisterReg-memory" (ppr $ CmmGlobal mid)
+        -- By this stage, the only MagicIds remaining should be the
+        -- ones which map to a real machine register on this
+        -- platform.  Hence ...
 
 
 {-
@@ -220,8 +222,8 @@ is32BitInteger i = i64 <= 0x7fffffff && i64 >= -0x80000000
 -- | Convert a BlockId to some CmmStatic data
 jumpTableEntry :: Maybe BlockId -> CmmStatic
 jumpTableEntry Nothing = CmmStaticLit (CmmInt 0 wordWidth)
-jumpTableEntry (Just (BlockId id)) = CmmStaticLit (CmmLabel blockLabel)
-    where blockLabel = mkAsmTempLabel id
+jumpTableEntry (Just blockid) = CmmStaticLit (CmmLabel blockLabel)
+    where blockLabel = mkAsmTempLabel (getUnique blockid)
 
 
 
@@ -305,7 +307,7 @@ assignReg_I64Code :: CmmReg  -> CmmExpr -> NatM InstrBlock
 assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do
    ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
    let 
-         r_dst_lo = mkVReg u_dst II32
+         r_dst_lo = RegVirtual $ mkVirtualReg u_dst II32
          r_dst_hi = getHiVRegFromLo r_dst_lo
          r_src_hi = getHiVRegFromLo r_src_lo
          mov_lo = MR r_dst_lo r_src_lo
@@ -329,7 +331,7 @@ iselExpr64 (CmmLoad addrTree ty) | isWord64 ty = do
                          rlo
 
 iselExpr64 (CmmReg (CmmLocal (LocalReg vu ty))) | isWord64 ty
-   = return (ChildCode64 nilOL (mkVReg vu II32))
+   = return (ChildCode64 nilOL (RegVirtual $ mkVirtualReg vu II32))
 
 iselExpr64 (CmmLit (CmmInt i _)) = do
   (rlo,rhi) <- getNewRegPairNat II32
@@ -376,6 +378,11 @@ iselExpr64 expr
 
 getRegister :: CmmExpr -> NatM Register
 
+getRegister (CmmReg (CmmGlobal PicBaseReg))
+  = do
+      reg <- getPicBaseNat archWordSize
+      return (Fixed archWordSize reg nilOL)
+
 getRegister (CmmReg reg) 
   = return (Fixed (cmmTypeSize (cmmRegType reg)) 
                  (getRegisterReg reg) nilOL)
@@ -413,7 +420,7 @@ getRegister (CmmLoad mem pk)
   | not (isWord64 pk)
   = do
         Amode addr addr_code <- getAmode mem
-        let code dst = ASSERT((regClass dst == RcDouble) == isFloatType pk)
+        let code dst = ASSERT((targetClassOfReg dst == RcDouble) == isFloatType pk)
                        addr_code `snocOL` LD size dst addr
         return (Any size code)
           where size = cmmTypeSize pk
@@ -1058,7 +1065,7 @@ genCCall target dest_regs argsAndHints
             do
                 dflags <- getDynFlagsNat
                 mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference $
-                              mkForeignLabel functionName Nothing True IsFunction
+                              mkForeignLabel functionName Nothing ForeignLabelInThisPackage IsFunction
                 let mopLabelOrExpr = case mopExpr of
                         CmmLit (CmmLabel lbl) -> Left lbl
                         _ -> Right mopExpr
@@ -1124,9 +1131,9 @@ genSwitch expr ids
             
             jumpTableEntryRel Nothing
                 = CmmStaticLit (CmmInt 0 wordWidth)
-            jumpTableEntryRel (Just (BlockId id))
+            jumpTableEntryRel (Just blockid)
                 = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0)
-                where blockLabel = mkAsmTempLabel id
+                where blockLabel = mkAsmTempLabel (getUnique blockid)
 
             code = e_code `appOL` t_code `appOL` toOL [
                             LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),