X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FCmmInfo.hs;h=78ff5af0cafd365400f21213daede81c68e04fd2;hb=1f8efd5d6214c490ef4942134abf5de9f468d29c;hp=5937dd4fb9debf2acb72124bc6bc8e61829693ff;hpb=d31dfb32ea936c22628b508c28a36c12e631430a;p=ghc-hetmet.git

diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index 5937dd4..78ff5af 100644
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -71,34 +71,34 @@ 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
             fun_extra_bits =
                [packHalfWordsCLit fun_type fun_arity] ++
-               srt_label ++
                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.
-      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,17 +119,17 @@ 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) ->
-          mkInfoTableAndCode info_label std_info srt_label entry_label
+      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 srt_bitmap (mkWordCLit offset)
+            std_info = mkStdInfoTable ty_prof cl_prof type_tag 0 (mkWordCLit offset)
             info_label = entryLblToInfoLbl entry_label
-            (srt_label, srt_bitmap) = mkSRTLit info_label srt
 
       -- 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