[project @ 2005-08-02 14:04:19 by simonmar]

[ghc-hetmet.git] / ghc / compiler / nativeGen / AsmCodeGen.lhs

diff --git a/ghc/compiler/nativeGen/AsmCodeGen.lhs b/ghc/compiler/nativeGen/AsmCodeGen.lhs
index b8fd0e3..93b385f 100644 (file)
--- a/ghc/compiler/nativeGen/AsmCodeGen.lhs
+++ b/ghc/compiler/nativeGen/AsmCodeGen.lhs
@@ -36,8 +36,8 @@ import FastTypes
 import List            ( groupBy, sortBy )
 import CLabel           ( pprCLabel )
 import ErrUtils                ( dumpIfSet_dyn )
-import CmdLineOpts     ( DynFlags, DynFlag(..), dopt, opt_Static,
-                         opt_EnsureSplittableC, opt_PIC )
+import DynFlags                ( DynFlags, DynFlag(..), dopt )
+import StaticFlags     ( opt_Static, opt_PIC )
 
 import Digraph
 import qualified Pretty
@@ -111,23 +111,33 @@ The machine-dependent bits break down as follows:
 
 nativeCodeGen :: DynFlags -> [Cmm] -> UniqSupply -> IO Pretty.Doc
 nativeCodeGen dflags cmms us
-  = let ((ppr_cmms, insn_sdoc, imports), _) = initUs us $
+  = let (res, _) = initUs us $
           cgCmm (concat (map add_split cmms))
 
        cgCmm :: [CmmTop] -> UniqSM (Cmm, Pretty.Doc, [CLabel])
        cgCmm tops = 
           lazyMapUs (cmmNativeGen dflags) tops  `thenUs` \ results -> 
-          let (cmms,docs,imps) = unzip3 results in
+          case unzip3 results of { (cmms,docs,imps) ->
           returnUs (Cmm cmms, my_vcat docs, concat imps)
-    in do
+          }
+    in 
+    case res of { (ppr_cmms, insn_sdoc, imports) -> do
     dumpIfSet_dyn dflags Opt_D_dump_opt_cmm "Optimised Cmm" (pprCmms [ppr_cmms])
-    return (insn_sdoc Pretty.$$ dyld_stubs imports)
+    return (insn_sdoc Pretty.$$ dyld_stubs imports
+#if HAVE_SUBSECTIONS_VIA_SYMBOLS
+                -- On recent versions of Darwin, the linker supports
+                -- dead-stripping of code and data on a per-symbol basis.
+                -- There's a hack to make this work in PprMach.pprNatCmmTop.
+            Pretty.$$ Pretty.text ".subsections_via_symbols"
+#endif
+            )
+   }
 
   where
 
     add_split (Cmm tops)
-       | opt_EnsureSplittableC = split_marker : tops
-       | otherwise             = tops
+       | dopt Opt_SplitObjs dflags = split_marker : tops
+       | otherwise                 = tops
 
     split_marker = CmmProc [] mkSplitMarkerLabel [] []
 
@@ -336,8 +346,14 @@ fixAssign (CmmAssign (CmmGlobal reg) src)
 
 fixAssign (CmmCall target results args vols)
   = mapAndUnzipUs fixResult results `thenUs` \ (results',stores) ->
-    returnUs (CmmCall target results' args vols : concat stores)
+    returnUs (caller_save ++
+             CmmCall target results' args vols :
+             caller_restore ++
+             concat stores)
   where
+       -- we also save/restore any caller-saves STG registers here
+       (caller_save, caller_restore) = callerSaveVolatileRegs vols
+
        fixResult g@(CmmGlobal reg,hint) = 
          case get_GlobalReg_reg_or_addr reg of
                Left realreg -> returnUs (g, [])
@@ -372,6 +388,9 @@ Ideas for other things we could do (ToDo):
 
   - shortcut jumps-to-jumps
   - eliminate dead code blocks
+  - simple CSE: if an expr is assigned to a temp, then replace later occs of
+    that expr with the temp, until the expr is no longer valid (can push through
+    temp assignments, and certain assigns to mem...)
 -}
 
 cmmToCmm :: CmmTop -> (CmmTop, [CLabel])
@@ -537,20 +556,53 @@ cmmMachOpFold op arg@[CmmLit (CmmInt x rep)]
        -- "from" type, in order to truncate to the correct size.
        -- The final narrow/widen to the destination type
        -- is implicit in the CmmLit.
-      MO_S_Conv from to -> CmmLit (CmmInt (narrowS from x) to)
+      MO_S_Conv from to
+          | isFloatingRep to -> CmmLit (CmmFloat (fromInteger x) to)
+          | otherwise        -> CmmLit (CmmInt (narrowS from x) to)
       MO_U_Conv from to -> CmmLit (CmmInt (narrowU from x) to)
-      _  -> panic "cmmMachOpFold: unknown unary op"
+
+      _ -> panic "cmmMachOpFold: unknown unary op"
+
 
 -- Eliminate conversion NOPs
 cmmMachOpFold (MO_S_Conv rep1 rep2) [x] | rep1 == rep2 = x
 cmmMachOpFold (MO_U_Conv rep1 rep2) [x] | rep1 == rep2 = x
 
--- ToDo: eliminate multiple conversions.  Be careful though: can't remove
--- a narrowing, and can't remove conversions to/from floating point types.
-
--- ToDo: eliminate nested comparisons:
---    CmmMachOp MO_Lt [CmmMachOp MO_Eq [x,y], CmmLit (CmmInt 0 _)]
--- turns into a simple equality test.
+-- Eliminate nested conversions where possible
+cmmMachOpFold conv_outer args@[CmmMachOp conv_inner [x]]
+  | Just (rep1,rep2,signed1) <- isIntConversion conv_inner,
+    Just (_,   rep3,signed2) <- isIntConversion conv_outer
+  = case () of
+       -- widen then narrow to the same size is a nop
+      _ | rep1 < rep2 && rep1 == rep3 -> x
+       -- Widen then narrow to different size: collapse to single conversion
+       -- but remember to use the signedness from the widening, just in case
+       -- the final conversion is a widen.
+       | rep1 < rep2 && rep2 > rep3 ->
+           cmmMachOpFold (intconv signed1 rep1 rep3) [x]
+       -- Nested widenings: collapse if the signedness is the same
+       | rep1 < rep2 && rep2 < rep3 && signed1 == signed2 ->
+           cmmMachOpFold (intconv signed1 rep1 rep3) [x]
+       -- Nested narrowings: collapse
+       | rep1 > rep2 && rep2 > rep3 ->
+           cmmMachOpFold (MO_U_Conv rep1 rep3) [x]
+       | otherwise ->
+           CmmMachOp conv_outer args
+  where
+       isIntConversion (MO_U_Conv rep1 rep2) 
+         | not (isFloatingRep rep1) && not (isFloatingRep rep2) 
+         = Just (rep1,rep2,False)
+       isIntConversion (MO_S_Conv rep1 rep2)
+         | not (isFloatingRep rep1) && not (isFloatingRep rep2) 
+         = Just (rep1,rep2,True)
+       isIntConversion _ = Nothing
+
+       intconv True  = MO_S_Conv
+       intconv False = MO_U_Conv
+
+-- ToDo: a narrow of a load can be collapsed into a narrow load, right?
+-- but what if the architecture only supports word-sized loads, should
+-- we do the transformation anyway?
 
 cmmMachOpFold mop args@[CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)]
   = case mop of