Improve error message (part of Trac #1606)

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

diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index 3f458b5..017efe4 100644 (file)
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -71,15 +71,15 @@ cmmToRawCmm cmm = do
 
 mkInfoTable :: Unique -> CmmTop -> [RawCmmTop]
 mkInfoTable uniq (CmmData sec dat) = [CmmData sec dat]
-mkInfoTable uniq (CmmProc info entry_label arguments blocks) =
+mkInfoTable uniq (CmmProc (CmmInfo _ _ info) entry_label arguments blocks) =
     case info of
       -- | Code without an info table.  Easy.
-      CmmNonInfo _ -> [CmmProc [] entry_label arguments blocks]
+      CmmNonInfoTable -> [CmmProc [] entry_label arguments blocks]
 
       -- | A function entry point.
-      CmmInfo (ProfilingInfo ty_prof cl_prof) _ type_tag
-              (FunInfo (ptrs, nptrs) srt fun_type fun_arity
-                       pap_bitmap slow_entry) ->
+      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
@@ -97,8 +97,8 @@ mkInfoTable uniq (CmmProc info entry_label arguments blocks) =
             layout = packHalfWordsCLit ptrs nptrs
 
       -- | A constructor.
-      CmmInfo (ProfilingInfo ty_prof cl_prof) _ type_tag
-              (ConstrInfo (ptrs, nptrs) con_tag descr) ->
+      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
@@ -108,8 +108,8 @@ mkInfoTable uniq (CmmProc info entry_label arguments blocks) =
             layout = packHalfWordsCLit ptrs nptrs
 
       -- | A thunk.
-      CmmInfo (ProfilingInfo ty_prof cl_prof) _ type_tag
-              (ThunkInfo (ptrs, nptrs) srt) ->
+      CmmInfoTable (ProfilingInfo ty_prof cl_prof) type_tag
+                   (ThunkInfo (ptrs, nptrs) srt) ->
           mkInfoTableAndCode info_label std_info srt_label entry_label
                              arguments blocks
           where
@@ -119,8 +119,8 @@ mkInfoTable uniq (CmmProc info entry_label arguments blocks) =
             layout = packHalfWordsCLit ptrs nptrs
 
       -- | A selector thunk.
-      CmmInfo (ProfilingInfo ty_prof cl_prof) _ type_tag
-              (ThunkSelectorInfo offset srt) ->
+      CmmInfoTable (ProfilingInfo ty_prof cl_prof) type_tag
+                   (ThunkSelectorInfo offset srt) ->
           mkInfoTableAndCode info_label std_info [{- no SRT -}] entry_label
                              arguments blocks
           where
@@ -128,7 +128,8 @@ mkInfoTable uniq (CmmProc info entry_label arguments blocks) =
             info_label = entryLblToInfoLbl entry_label
 
       -- A continuation/return-point.
-      CmmInfo (ProfilingInfo ty_prof cl_prof) _ type_tag (ContInfo stack_layout srt) ->
+      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
@@ -164,8 +165,8 @@ mkInfoTableAndCode info_lbl std_info extra_bits entry_lbl args blocks
 
   | otherwise  -- Separately emit info table (with the function entry 
   =            -- point as first entry) and the entry code 
-    [mkDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits),
-     CmmProc [] entry_lbl args blocks]
+    [CmmProc [] entry_lbl args blocks,
+     mkDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits)]
 
 mkSRTLit :: CLabel
          -> C_SRT
@@ -213,7 +214,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