X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmInfo.hs;h=d77488c1ab242768eee0a11a7efc402c09550c96;hb=67760c45fc0b18bdd21d31b0462f4ad7ee4d2c4c;hp=3ee0da8205695ac3bb97bb6c4f7c8a419451d8f0;hpb=48fb2b521898998a17873ad6cf30610aa5ab6db3;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index 3ee0da8..d77488c 100644
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -76,73 +76,68 @@ mkInfoTable uniq (CmmProc (CmmInfo _ _ info) entry_label arguments blocks) =
       -- | Code without an info table.  Easy.
       CmmNonInfoTable -> [CmmProc [] entry_label arguments blocks]
 
-      -- | A function entry point.
-      CmmInfoTable (ProfilingInfo ty_prof cl_prof) type_tag
-                   (FunInfo (ptrs, nptrs) srt fun_type fun_arity
-                            pap_bitmap slow_entry) ->
-          mkInfoTableAndCode info_label std_info fun_extra_bits entry_label
-                             arguments blocks
-          where
-            fun_extra_bits =
-               [packHalfWordsCLit fun_type fun_arity] ++
-               case pap_bitmap of
+      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
+          in case type_info of
+          -- | A function entry point.
+          FunInfo (ptrs, nptrs) srt fun_type fun_arity pap_bitmap slow_entry ->
+              mkInfoTableAndCode info_label std_info fun_extra_bits entry_label
+                                 arguments blocks
+            where
+              fun_extra_bits =
+                 [packHalfWordsCLit fun_type fun_arity] ++
+                 case pap_bitmap of
                  ArgGen liveness ->
                      (if null srt_label then [mkIntCLit 0] else srt_label) ++
                      [makeRelativeRefTo info_label $ mkLivenessCLit liveness,
                       makeRelativeRefTo info_label slow_entry]
                  _ -> srt_label
-            std_info = mkStdInfoTable ty_prof cl_prof type_tag srt_bitmap layout
-            info_label = entryLblToInfoLbl entry_label
-            (srt_label, srt_bitmap) = mkSRTLit info_label srt
-            layout = packHalfWordsCLit ptrs nptrs
-
-      -- | A constructor.
-      CmmInfoTable (ProfilingInfo ty_prof cl_prof) type_tag
-                   (ConstrInfo (ptrs, nptrs) con_tag descr) ->
-          mkInfoTableAndCode info_label std_info [con_name] entry_label
-                             arguments blocks
-          where
-            std_info = mkStdInfoTable ty_prof cl_prof type_tag con_tag layout
-            info_label = entryLblToInfoLbl entry_label
-            con_name = makeRelativeRefTo info_label descr
-            layout = packHalfWordsCLit ptrs nptrs
-
-      -- | A thunk.
-      CmmInfoTable (ProfilingInfo ty_prof cl_prof) type_tag
-                   (ThunkInfo (ptrs, nptrs) srt) ->
-          mkInfoTableAndCode info_label std_info srt_label entry_label
-                             arguments blocks
-          where
-            std_info = mkStdInfoTable ty_prof cl_prof type_tag srt_bitmap layout
-            info_label = entryLblToInfoLbl entry_label
-            (srt_label, srt_bitmap) = mkSRTLit info_label srt
-            layout = packHalfWordsCLit ptrs nptrs
-
-      -- | A selector thunk.
-      CmmInfoTable (ProfilingInfo ty_prof cl_prof) type_tag
-                   (ThunkSelectorInfo offset srt) ->
-          mkInfoTableAndCode info_label std_info [{- no SRT -}] entry_label
-                             arguments blocks
-          where
-            std_info = mkStdInfoTable ty_prof cl_prof type_tag 0 (mkWordCLit offset)
-            info_label = entryLblToInfoLbl entry_label
-
-      -- A continuation/return-point.
-      CmmInfoTable (ProfilingInfo ty_prof cl_prof) type_tag
-                   (ContInfo stack_layout srt) ->
-          liveness_data ++
-          mkInfoTableAndCode info_label std_info srt_label entry_label
-                             arguments blocks
-          where
-            std_info = mkStdInfoTable ty_prof cl_prof maybe_big_type_tag srt_bitmap
-                                      (makeRelativeRefTo info_label liveness_lit)
-            info_label = entryLblToInfoLbl entry_label
-            (liveness_lit, liveness_data, liveness_tag) =
-                mkLiveness uniq stack_layout
-            maybe_big_type_tag = if type_tag == rET_SMALL
-                                 then liveness_tag
-                                 else type_tag
-            (srt_label, srt_bitmap) = mkSRTLit info_label srt
+              std_info = mkStdInfoTable ty_prof' cl_prof' type_tag srt_bitmap
+                                        layout
+              (srt_label, srt_bitmap) = mkSRTLit info_label srt
+              layout = packHalfWordsCLit ptrs nptrs
+
+          -- | A constructor.
+          ConstrInfo (ptrs, nptrs) con_tag descr ->
+              mkInfoTableAndCode info_label std_info [con_name] entry_label
+                                 arguments blocks
+              where
+                std_info = mkStdInfoTable ty_prof' cl_prof' type_tag con_tag layout
+                con_name = makeRelativeRefTo info_label descr
+                layout = packHalfWordsCLit ptrs nptrs
+
+          -- | A thunk.
+          ThunkInfo (ptrs, nptrs) srt ->
+              mkInfoTableAndCode info_label std_info srt_label entry_label
+                                 arguments blocks
+              where
+                std_info = mkStdInfoTable ty_prof' cl_prof' type_tag srt_bitmap layout
+                (srt_label, srt_bitmap) = mkSRTLit info_label srt
+                layout = packHalfWordsCLit ptrs nptrs
+
+          -- | A selector thunk.
+          ThunkSelectorInfo offset srt ->
+              mkInfoTableAndCode info_label std_info [{- no SRT -}] entry_label
+                                 arguments blocks
+              where
+                std_info = mkStdInfoTable ty_prof' cl_prof' type_tag 0 (mkWordCLit offset)
+
+          -- A continuation/return-point.
+          ContInfo stack_layout srt ->
+              liveness_data ++
+              mkInfoTableAndCode info_label std_info srt_label entry_label
+                                 arguments blocks
+              where
+                std_info = mkStdInfoTable ty_prof' cl_prof' maybe_big_type_tag srt_bitmap
+                                          (makeRelativeRefTo info_label liveness_lit)
+                (liveness_lit, liveness_data, liveness_tag) =
+                    mkLiveness uniq stack_layout
+                maybe_big_type_tag = if type_tag == rET_SMALL
+                                     then liveness_tag
+                                     else type_tag
+                (srt_label, srt_bitmap) = mkSRTLit info_label srt
 
 -- Handle the differences between tables-next-to-code
 -- and not tables-next-to-code
@@ -214,7 +209,9 @@ mkLiveness uniq live =
     mkBits (reg:regs) = take sizeW bits ++ mkBits regs where
         sizeW = case reg of
                   Nothing -> 1
-                  Just r -> machRepByteWidth (localRegRep r) `quot` wORD_SIZE
+                  Just r -> (machRepByteWidth (localRegRep 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