diff options
| author | Michael D. Adams <t-madams@microsoft.com> | 2007-06-27 15:15:03 +0000 |
|---|---|---|
| committer | Michael D. Adams <t-madams@microsoft.com> | 2007-06-27 15:15:03 +0000 |
| commit | 1f46671fe24c7155ee64091b71b77dd66909e7a0 (patch) | |
| tree | da9d2099466475b4f291b0e488bcbe2fa4e072d9 /compiler/cmm/CmmInfo.hs | |
| parent | f96e9aa0444de0e673b3c4055c6e43299639bc5b (diff) | |
| download | haskell-1f46671fe24c7155ee64091b71b77dd66909e7a0.tar.gz | |
Added stack checks to the CPS algorithm
This eliminates one of the panics introduced by
the previous patch:
'First pass at implementing info tables for CPS'
The other panic introduced by that patch still remains.
It was due to the need to convert from a
ContinuationInfo to a CmmInfo.
(codeGen/CgInfoTbls.hs:emitClosureCodeAndInfoTable)
(codeGen/CgInfoTbls.hs:emitReturnTarget)
Diffstat (limited to 'compiler/cmm/CmmInfo.hs')
| -rw-r--r-- | compiler/cmm/CmmInfo.hs | 17 |
1 files changed, 15 insertions, 2 deletions
diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs index 80c892f96a..ab46f1e58d 100644 --- a/compiler/cmm/CmmInfo.hs +++ b/compiler/cmm/CmmInfo.hs @@ -26,7 +26,7 @@ mkInfoTable :: Unique -> CmmTop -> [RawCmmTop] mkInfoTable uniq (CmmData sec dat) = [CmmData sec dat] mkInfoTable uniq (CmmProc info entry_label arguments blocks) = case info of - CmmNonInfo -> [CmmProc [] entry_label arguments blocks] + CmmNonInfo _ -> [CmmProc [] entry_label arguments blocks] CmmInfo (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 @@ -55,7 +55,7 @@ mkInfoTable uniq (CmmProc info 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 (CmmLabel descr) + con_name = makeRelativeRefTo info_label descr layout = packHalfWordsCLit ptrs nptrs CmmInfo (ProfilingInfo ty_prof cl_prof) _ type_tag @@ -72,6 +72,19 @@ mkInfoTable uniq (CmmProc info entry_label arguments blocks) = bitmap) layout = packHalfWordsCLit ptrs nptrs + CmmInfo (ProfilingInfo ty_prof cl_prof) _ type_tag + (ThunkSelectorInfo offset srt) -> + mkInfoTableAndCode info_label std_info srt_label entry_label arguments blocks + where + std_info = mkStdInfoTable ty_prof cl_prof type_tag srt_bitmap (mkWordCLit offset) + info_label = entryLblToInfoLbl entry_label + (srt_label, srt_bitmap) = + case srt of + NoC_SRT -> ([], 0) + (C_SRT lbl off bitmap) -> + ([makeRelativeRefTo info_label (cmmLabelOffW lbl off)], + bitmap) + CmmInfo (ProfilingInfo ty_prof cl_prof) _ type_tag (ContInfo stack_layout srt) -> liveness_data ++ mkInfoTableAndCode info_label std_info srt_label entry_label arguments blocks |