Merging in the new codegen branch

[ghc-hetmet.git] / compiler / cmm / CmmInfo.hs

diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index 49a77e2..eb226da 100644 (file)
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -16,7 +16,6 @@ import Cmm
 import CmmUtils
 
 import CLabel
-import MachOp
 
 import Bitmap
 import ClosureInfo
@@ -26,6 +25,7 @@ import CgUtils
 import SMRep
 
 import Constants
+import Outputable
 import StaticFlags
 import Unique
 import UniqSupply
@@ -78,19 +78,20 @@ mkInfoTable :: Unique -> CmmTop -> [RawCmmTop]
 mkInfoTable uniq (CmmData sec dat) = [CmmData sec dat]
 mkInfoTable uniq (CmmProc (CmmInfo _ _ info) entry_label arguments blocks) =
     case info of
-      -- | Code without an info table.  Easy.
+      -- Code without an info table.  Easy.
       CmmNonInfoTable -> [CmmProc [] entry_label arguments blocks]
 
       CmmInfoTable (ProfilingInfo ty_prof cl_prof) type_tag type_info ->
           let info_label = entryLblToInfoLbl entry_label
-              ty_prof' = makeRelativeRefTo info_label ty_prof
-              cl_prof' = makeRelativeRefTo info_label cl_prof
+              ty_prof'   = makeRelativeRefTo info_label ty_prof
+              cl_prof'   = makeRelativeRefTo info_label cl_prof
           in case type_info of
-          -- | A function entry point.
-          FunInfo (ptrs, nptrs) srt fun_type fun_arity pap_bitmap slow_entry ->
+          -- A function entry point.
+          FunInfo (ptrs, nptrs) srt fun_arity pap_bitmap slow_entry ->
               mkInfoTableAndCode info_label std_info fun_extra_bits entry_label
                                  arguments blocks
             where
+              fun_type = argDescrType pap_bitmap
               fun_extra_bits =
                  [packHalfWordsCLit fun_type fun_arity] ++
                  case pap_bitmap of
@@ -104,7 +105,7 @@ mkInfoTable uniq (CmmProc (CmmInfo _ _ info) entry_label arguments blocks) =
               (srt_label, srt_bitmap) = mkSRTLit info_label srt
               layout = packHalfWordsCLit ptrs nptrs
 
-          -- | A constructor.
+          -- A constructor.
           ConstrInfo (ptrs, nptrs) con_tag descr ->
               mkInfoTableAndCode info_label std_info [con_name] entry_label
                                  arguments blocks
@@ -112,8 +113,7 @@ mkInfoTable uniq (CmmProc (CmmInfo _ _ info) entry_label arguments blocks) =
                 std_info = mkStdInfoTable ty_prof' cl_prof' type_tag con_tag layout
                 con_name = makeRelativeRefTo info_label descr
                 layout = packHalfWordsCLit ptrs nptrs
-
-          -- | A thunk.
+          -- A thunk.
           ThunkInfo (ptrs, nptrs) srt ->
               mkInfoTableAndCode info_label std_info srt_label entry_label
                                  arguments blocks
@@ -122,7 +122,7 @@ mkInfoTable uniq (CmmProc (CmmInfo _ _ info) entry_label arguments blocks) =
                 (srt_label, srt_bitmap) = mkSRTLit info_label srt
                 layout = packHalfWordsCLit ptrs nptrs
 
-          -- | A selector thunk.
+          -- A selector thunk.
           ThunkSelectorInfo offset srt ->
               mkInfoTableAndCode info_label std_info [{- no SRT -}] entry_label
                                  arguments blocks
@@ -150,7 +150,7 @@ mkInfoTableAndCode :: CLabel
                    -> [CmmLit]
                    -> [CmmLit]
                    -> CLabel
-                   -> CmmFormalsWithoutKinds
+                   -> CmmFormals
                    -> ListGraph CmmStmt
                    -> [RawCmmTop]
 mkInfoTableAndCode info_lbl std_info extra_bits entry_lbl args blocks
@@ -200,30 +200,29 @@ mkSRTLit info_label (C_SRT lbl off bitmap) =
 -- TODO: combine with CgCallConv.mkLiveness (see comment there)
 mkLiveness :: Unique
            -> [Maybe LocalReg]
-           -> (CmmLit,           -- ^ The bitmap (literal value or label)
-               [RawCmmTop],      -- ^ Large bitmap CmmData if needed
-               ClosureTypeTag)   -- ^ rET_SMALL or rET_BIG
+           -> (CmmLit, [RawCmmTop], ClosureTypeTag)
+              -- ^ Returns:
+              --   1. The bitmap (literal value or label)
+              --   2. Large bitmap CmmData if needed
+              --   3. rET_SMALL or rET_BIG
 mkLiveness uniq live =
   if length bits > mAX_SMALL_BITMAP_SIZE
     -- does not fit in one word
     then (CmmLabel big_liveness, [data_lits], rET_BIG)
     -- fits in one word
-    else (mkWordCLit small_liveness, [], rET_SMALL)
+    else (mkWordCLit  small_liveness, [], rET_SMALL)
   where
     mkBits [] = []
     mkBits (reg:regs) = take sizeW bits ++ mkBits regs where
         sizeW = case reg of
                   Nothing -> 1
-                  Just r -> (machRepByteWidth (localRegRep r) + wORD_SIZE - 1)
+                  Just r -> (widthInBytes (typeWidth (localRegType r)) + wORD_SIZE - 1)
                             `quot` wORD_SIZE
                             -- number of words, rounded up
         bits = repeat $ is_non_ptr reg -- True <=> Non Ptr
 
-    is_non_ptr Nothing = True
-    is_non_ptr (Just reg) =
-        case localRegGCFollow reg of
-          GCKindNonPtr -> True
-          GCKindPtr -> False
+    is_non_ptr Nothing    = True
+    is_non_ptr (Just reg) = not $ isGcPtrType (localRegType reg)
 
     bits :: [Bool]
     bits = mkBits live
@@ -276,6 +275,3 @@ mkStdInfoTable type_descr closure_descr cl_type srt_len layout_lit
 
     type_lit = packHalfWordsCLit cl_type srt_len
 
-
-_unused :: FS.FastString -- stops a warning
-_unused = undefined