X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FCmmInfo.hs;h=a606da2aec4fc5dd19d811d7581c808966de683b;hp=314a9ad77e29ec1517443d2e616f494838aeacad;hb=e2e0785eb7f4efd9f7791d913cdfdfd03148cd86;hpb=649d5ed52989f429d10283940793a06111aa8468 diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs index 314a9ad..a606da2 100644 --- a/compiler/cmm/CmmInfo.hs +++ b/compiler/cmm/CmmInfo.hs @@ -1,22 +1,15 @@ -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings --- for details - module CmmInfo ( + emptyContInfoTable, cmmToRawCmm, - mkInfoTable + mkInfoTable, ) where #include "HsVersions.h" -import Cmm +import OldCmm import CmmUtils import CLabel -import MachOp import Bitmap import ClosureInfo @@ -26,13 +19,19 @@ import CgUtils import SMRep import Constants +import Panic import StaticFlags import Unique import UniqSupply -import Panic import Data.Bits +-- When we split at proc points, we need an empty info table. +emptyContInfoTable :: CmmInfoTable +emptyContInfoTable = CmmInfoTable False (ProfilingInfo zero zero) rET_SMALL + (ContInfo [] NoC_SRT) + where zero = CmmInt 0 wordWidth + cmmToRawCmm :: [Cmm] -> IO [RawCmm] cmmToRawCmm cmm = do info_tbl_uniques <- mkSplitUniqSupply 'i' @@ -56,7 +55,7 @@ cmmToRawCmm cmm = do -- -- -- --- See includes/InfoTables.h +-- See includes/rts/storage/InfoTables.h -- -- For return-points these are as follows -- @@ -75,22 +74,23 @@ cmmToRawCmm cmm = do -- * The SRT slot is only there if there is SRT info to record mkInfoTable :: Unique -> CmmTop -> [RawCmmTop] -mkInfoTable uniq (CmmData sec dat) = [CmmData sec dat] -mkInfoTable uniq (CmmProc (CmmInfo _ _ info) entry_label arguments blocks) = +mkInfoTable _ (CmmData sec dat) = [CmmData sec dat] +mkInfoTable uniq (CmmProc (CmmInfo _ _ info) entry_label blocks) = case info of -- Code without an info table. Easy. - CmmNonInfoTable -> [CmmProc [] entry_label arguments blocks] + CmmNonInfoTable -> [CmmProc [] entry_label blocks] - CmmInfoTable (ProfilingInfo ty_prof cl_prof) type_tag type_info -> + 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 -> + FunInfo (ptrs, nptrs) srt fun_arity pap_bitmap slow_entry -> mkInfoTableAndCode info_label std_info fun_extra_bits entry_label - arguments blocks + blocks where + fun_type = argDescrType pap_bitmap fun_extra_bits = [packHalfWordsCLit fun_type fun_arity] ++ case pap_bitmap of @@ -107,25 +107,24 @@ mkInfoTable uniq (CmmProc (CmmInfo _ _ info) entry_label arguments blocks) = -- A constructor. ConstrInfo (ptrs, nptrs) con_tag descr -> mkInfoTableAndCode info_label std_info [con_name] entry_label - arguments blocks + 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 + 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 -> + ThunkSelectorInfo offset _srt -> mkInfoTableAndCode info_label std_info [{- no SRT -}] entry_label - arguments blocks + blocks where std_info = mkStdInfoTable ty_prof' cl_prof' type_tag 0 (mkWordCLit offset) @@ -133,7 +132,7 @@ mkInfoTable uniq (CmmProc (CmmInfo _ _ info) entry_label arguments blocks) = ContInfo stack_layout srt -> liveness_data ++ mkInfoTableAndCode info_label std_info srt_label entry_label - arguments blocks + blocks where std_info = mkStdInfoTable ty_prof' cl_prof' maybe_big_type_tag srt_bitmap (makeRelativeRefTo info_label liveness_lit) @@ -150,13 +149,12 @@ mkInfoTableAndCode :: CLabel -> [CmmLit] -> [CmmLit] -> CLabel - -> CmmFormalsWithoutKinds -> ListGraph CmmStmt -> [RawCmmTop] -mkInfoTableAndCode info_lbl std_info extra_bits entry_lbl args blocks +mkInfoTableAndCode info_lbl std_info extra_bits entry_lbl blocks | tablesNextToCode -- Reverse the extra_bits; and emit the top-level proc = [CmmProc (map CmmStaticLit (reverse extra_bits ++ std_info)) - entry_lbl args blocks] + entry_lbl blocks] | ListGraph [] <- blocks -- No code; only the info table is significant = -- Use a zero place-holder in place of the @@ -165,14 +163,14 @@ 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 - [CmmProc [] entry_lbl args blocks, + [CmmProc [] entry_lbl blocks, mkDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits)] mkSRTLit :: CLabel -> C_SRT -> ([CmmLit], -- srt_label StgHalfWord) -- srt_bitmap -mkSRTLit info_label NoC_SRT = ([], 0) +mkSRTLit _ NoC_SRT = ([], 0) mkSRTLit info_label (C_SRT lbl off bitmap) = ([makeRelativeRefTo info_label (cmmLabelOffW lbl off)], bitmap) @@ -210,22 +208,19 @@ mkLiveness uniq live = -- 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 @@ -235,7 +230,7 @@ mkLiveness uniq live = small_bitmap = case bitmap of [] -> 0 - [b] -> fromIntegral b + [b] -> b _ -> panic "mkLiveness" small_liveness = fromIntegral (length bits) .|. (small_bitmap `shiftL` bITMAP_BITS_SHIFT)