Merge in new code generator branch.

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

diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index e9bbc06..44311a4 100644 (file)
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -47,7 +47,8 @@ import Platform
 import BasicTypes
 import BlockId
 import PprCmm          ( pprExpr )
-import Cmm
+import OldCmm
+import OldPprCmm
 import CLabel
 import ClosureInfo     ( C_SRT(..) )
 
@@ -58,6 +59,7 @@ import OrdList
 import Pretty
 import qualified Outputable as O
 import Outputable
+import Unique
 import FastString
 import FastBool                ( isFastTrue )
 import Constants       ( wORD_SIZE )
@@ -93,11 +95,10 @@ cmmTopCodeGen
        -> RawCmmTop
        -> NatM [NatCmmTop Instr]
 
-cmmTopCodeGen dynflags 
-       (CmmProc info lab params (ListGraph blocks)) = do
+cmmTopCodeGen dynflags (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 dynflags
 
@@ -226,12 +227,12 @@ getRegisterReg use_sse2 (CmmLocal (LocalReg u pk))
        else RegVirtual (mkVirtualReg u sz)
 
 getRegisterReg _ (CmmGlobal mid)
-  = case get_GlobalReg_reg_or_addr mid of
-       Left reg -> RegReal $ reg
-       _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 -> RegReal $ 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 ...
 
 
 -- | Memory addressing modes passed up the tree.
@@ -271,8 +272,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)
 
 
 -- -----------------------------------------------------------------------------
@@ -991,11 +992,11 @@ getAmode (CmmMachOp (MO_Sub rep) [x, CmmLit lit@(CmmInt i _)])
        let off = ImmInt (-(fromInteger i))
        return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code)
   
-getAmode (CmmMachOp (MO_Add rep) [x, CmmLit lit@(CmmInt i _)])
+getAmode (CmmMachOp (MO_Add rep) [x, CmmLit lit])
   | is32BitLit lit
   -- ASSERT(rep == II32)???
   = do (x_reg, x_code) <- getSomeReg x
-       let off = ImmInt (fromInteger i)
+       let off = litToImm lit
        return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code)
 
 -- Turn (lit1 << n  + lit2) into  (lit2 + lit1 << n) so it will be 
@@ -1575,7 +1576,7 @@ genCCall target dest_regs args = do
              return (unitOL (CALL (Left fn_imm) []), conv)
           where fn_imm = ImmCLbl lbl
         CmmCallee expr conv
-           -> do { (dyn_c, dyn_r) <- get_op expr
+           -> do { (dyn_r, dyn_c) <- getSomeReg expr
                  ; ASSERT( isWord32 (cmmExprType expr) )
                    return (dyn_c `snocOL` CALL (Right dyn_r) [], conv) }
 
@@ -1655,13 +1656,11 @@ genCCall target dest_regs args = do
                             DELTA (delta-8)]
             )
 
-      | otherwise = do
-        (code, reg) <- get_op arg
+      | isFloatType arg_ty = do
+        (reg, code) <- getSomeReg arg
         delta <- getDeltaNat
-        let size = arg_size arg_ty     -- Byte size
         setDeltaNat (delta-size)
-        if (isFloatType arg_ty)
-           then return (code `appOL`
+        return (code `appOL`
                         toOL [SUB II32 (OpImm (ImmInt size)) (OpReg esp),
                               DELTA (delta-size),
                               let addr = AddrBaseIndex (EABaseReg esp) 
@@ -1674,18 +1673,18 @@ genCCall target dest_regs args = do
                                  else GST size reg addr
                              ]
                        )
-           else return (code `snocOL`
-                        PUSH II32 (OpReg reg) `snocOL`
-                        DELTA (delta-size)
-                       )
+
+      | otherwise = do
+        (operand, code) <- getOperand arg
+        delta <- getDeltaNat
+        setDeltaNat (delta-size)
+        return (code `snocOL`
+                PUSH II32 operand `snocOL`
+                DELTA (delta-size))
+
       where
          arg_ty = cmmExprType arg
-
-    ------------
-    get_op :: CmmExpr -> NatM (InstrBlock, Reg) -- code, reg
-    get_op op = do
-        (reg,code) <- getSomeReg op
-       return (code, reg)
+         size = arg_size arg_ty        -- Byte size
 
 #elif x86_64_TARGET_ARCH
 
@@ -1928,9 +1927,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)
 
             op = OpAddr (AddrBaseIndex (EABaseReg tableReg)
                                        (EAIndex reg wORD_SIZE) (ImmInt 0))