Commit 54843b5b authored by batterseapower's avatar batterseapower

Refactoring: use a structured CmmStatics type rather than [CmmStatic]

I observed that the [CmmStatics] within CmmData uses the list in a very stylised way.
The first item in the list is almost invariably a CmmDataLabel. Many parts of the
compiler pattern match on this list and fail if this is not true.

This patch makes the invariant explicit by introducing a structured type CmmStatics
that holds the label and the list of remaining [CmmStatic].

There is one wrinkle: the x86 backend sometimes wants to output an alignment directive just
before the label. However, this can be easily fixed up by parameterising the native codegen
over the type of CmmStatics (though the GenCmmTop parameterisation) and using a pair
(Alignment, CmmStatics) there instead.

As a result, I think we will be able to remove CmmAlign and CmmDataLabel from the CmmStatic
data type, thus nuking a lot of code and failing pattern matches. This change will come as part
of my next patch.
parent e01fffc6
......@@ -19,7 +19,9 @@ types that
module BasicTypes(
Version, bumpVersion, initialVersion,
Arity,
Arity,
Alignment,
FunctionOrData(..),
......@@ -94,6 +96,16 @@ import Data.Function (on)
type Arity = Int
\end{code}
%************************************************************************
%* *
\subsection[Alignment]{Alignment}
%* *
%************************************************************************
\begin{code}
type Alignment = Int -- align to next N-byte boundary (N must be a power of 2).
\end{code}
%************************************************************************
%* *
\subsection[FunctionOrData]{FunctionOrData}
......
......@@ -53,8 +53,8 @@ type CmmBwdRewrite f = BwdRewrite FuelUniqSM CmmNode f
data CmmStackInfo = StackInfo {arg_space :: ByteOff, updfr_space :: Maybe ByteOff}
data CmmTopInfo = TopInfo {info_tbl :: CmmInfoTable, stack_info :: CmmStackInfo}
type Cmm = GenCmm CmmStatic CmmTopInfo CmmGraph
type CmmTop = GenCmmTop CmmStatic CmmTopInfo CmmGraph
type Cmm = GenCmm CmmStatics CmmTopInfo CmmGraph
type CmmTop = GenCmmTop CmmStatics CmmTopInfo CmmGraph
-------------------------------------------------
-- Manipulating CmmGraphs
......
......@@ -238,7 +238,7 @@ addCAF caf srt =
where last = next_elt srt
srtToData :: TopSRT -> Cmm
srtToData srt = Cmm [CmmData RelocatableReadOnlyData (CmmDataLabel (lbl srt) : tbl)]
srtToData srt = Cmm [CmmData RelocatableReadOnlyData (Statics (lbl srt) tbl)]
where tbl = map (CmmStaticLit . CmmLabel) (reverse (rev_elts srt))
-- Once we have found the CAFs, we need to do two things:
......@@ -317,7 +317,7 @@ to_SRT top_srt off len bmp
= do id <- getUniqueM
let srt_desc_lbl = mkLargeSRTLabel id
tbl = CmmData RelocatableReadOnlyData $
CmmDataLabel srt_desc_lbl : map CmmStaticLit
Statics srt_desc_lbl $ map CmmStaticLit
( cmmLabelOffW top_srt off
: mkWordCLit (fromIntegral len)
: map mkWordCLit bmp)
......
......@@ -11,11 +11,12 @@ module CmmDecl (
CmmInfoTable(..), HasStaticClosure, ClosureTypeInfo(..), ConstrDescription,
ProfilingInfo(..), ClosureTypeTag,
CmmActual, CmmFormal, ForeignHint(..),
CmmStatic(..), Section(..),
CmmStatics(..), CmmStatic(..), Section(..),
) where
#include "HsVersions.h"
import BasicTypes (Alignment)
import CmmExpr
import CLabel
import SMRep
......@@ -60,7 +61,7 @@ data GenCmmTop d h g
| CmmData -- Static data
Section
[d]
d
-----------------------------------------------------------------------------
......@@ -132,10 +133,11 @@ data CmmStatic
-- a literal value, size given by cmmLitRep of the literal.
| CmmUninitialised Int
-- uninitialised data, N bytes long
| CmmAlign Int
| CmmAlign Alignment
-- align to next N-byte boundary (N must be a power of 2).
| CmmDataLabel CLabel
-- label the current position in this section.
| CmmString [Word8]
-- string of 8-bit values only, not zero terminated.
data CmmStatics = Statics CLabel {- Label of statics -} [CmmStatic] {- The static data itself -}
......@@ -188,21 +188,24 @@ cmmtop :: { ExtCode }
-- * we can derive closure and info table labels from a single NAME
cmmdata :: { ExtCode }
: 'section' STRING '{' statics '}'
{ do ss <- sequence $4;
code (emitData (section $2) (concat ss)) }
: 'section' STRING '{' static_label statics '}'
{ do lbl <- $4;
ss <- sequence $5;
code (emitData (section $2) (Statics lbl $ concat ss)) }
statics :: { [ExtFCode [CmmStatic]] }
: {- empty -} { [] }
| static statics { $1 : $2 }
static_label :: { ExtFCode CLabel }
: NAME ':'
{% withThisPackage $ \pkg ->
return (mkCmmDataLabel pkg $1) }
-- Strings aren't used much in the RTS HC code, so it doesn't seem
-- worth allowing inline strings. C-- doesn't allow them anyway.
static :: { ExtFCode [CmmStatic] }
: NAME ':'
{% withThisPackage $ \pkg ->
return [CmmDataLabel (mkCmmDataLabel pkg $1)] }
: static_label { liftM (\x -> [CmmDataLabel x]) $1 }
| type expr ';' { do e <- $2;
return [CmmStaticLit (getLit e)] }
| type ';' { return [CmmUninitialised
......
......@@ -73,12 +73,12 @@ newtype ListGraph i = ListGraph [GenBasicBlock i]
-- across a whole compilation unit.
-- | Cmm with the info table as a data type
type Cmm = GenCmm CmmStatic CmmInfo (ListGraph CmmStmt)
type CmmTop = GenCmmTop CmmStatic CmmInfo (ListGraph CmmStmt)
type Cmm = GenCmm CmmStatics CmmInfo (ListGraph CmmStmt)
type CmmTop = GenCmmTop CmmStatics CmmInfo (ListGraph CmmStmt)
-- | Cmm with the info tables converted to a list of 'CmmStatic'
type RawCmm = GenCmm CmmStatic [CmmStatic] (ListGraph CmmStmt)
type RawCmmTop = GenCmmTop CmmStatic [CmmStatic] (ListGraph CmmStmt)
type RawCmm = GenCmm CmmStatics [CmmStatic] (ListGraph CmmStmt)
type RawCmmTop = GenCmmTop CmmStatics [CmmStatic] (ListGraph CmmStmt)
-- A basic block containing a single label, at the beginning.
......
......@@ -112,31 +112,21 @@ pprTop (CmmProc info clbl (ListGraph blocks)) =
-- We only handle (a) arrays of word-sized things and (b) strings.
pprTop (CmmData _section _ds@[CmmDataLabel lbl, CmmString str]) =
pprTop (CmmData _section (Statics lbl [CmmString str])) =
hcat [
pprLocalness lbl, ptext (sLit "char "), pprCLabel lbl,
ptext (sLit "[] = "), pprStringInCStyle str, semi
]
pprTop (CmmData _section _ds@[CmmDataLabel lbl, CmmUninitialised size]) =
pprTop (CmmData _section (Statics lbl [CmmUninitialised size])) =
hcat [
pprLocalness lbl, ptext (sLit "char "), pprCLabel lbl,
brackets (int size), semi
]
pprTop (CmmData _section (CmmDataLabel lbl : lits)) =
pprTop (CmmData _section (Statics lbl lits)) =
pprDataExterns lits $$
pprWordArray lbl lits
-- Floating info table for safe a foreign call.
pprTop (CmmData _section d@(_ : _))
| CmmDataLabel lbl : lits <- reverse d =
let lits' = reverse lits
in pprDataExterns lits' $$
pprWordArray lbl lits'
-- these shouldn't appear?
pprTop (CmmData _ _) = panic "PprC.pprTop: can't handle this data"
pprWordArray lbl lits
-- --------------------------------------------------------------------------
-- BasicBlocks are self-contained entities: they always end in a jump.
......
......@@ -54,12 +54,12 @@ import ClosureInfo
#include "../includes/rts/storage/FunTypes.h"
pprCmms :: (Outputable info, Outputable g) => [GenCmm CmmStatic info g] -> SDoc
pprCmms :: (Outputable info, Outputable g) => [GenCmm CmmStatics info g] -> SDoc
pprCmms cmms = pprCode CStyle (vcat (intersperse separator $ map ppr cmms))
where
separator = space $$ ptext (sLit "-------------------") $$ space
writeCmms :: (Outputable info, Outputable g) => Handle -> [GenCmm CmmStatic info g] -> IO ()
writeCmms :: (Outputable info, Outputable g) => Handle -> [GenCmm CmmStatics info g] -> IO ()
writeCmms handle cmms = printForC handle (pprCmms cmms)
-----------------------------------------------------------------------------
......@@ -72,6 +72,9 @@ instance (Outputable d, Outputable info, Outputable i)
=> Outputable (GenCmmTop d info i) where
ppr t = pprTop t
instance Outputable CmmStatics where
ppr e = pprStatics e
instance Outputable CmmStatic where
ppr e = pprStatic e
......@@ -103,7 +106,7 @@ pprTop (CmmProc info lbl graph)
-- section "data" { ... }
--
pprTop (CmmData section ds) =
(hang (pprSection section <+> lbrace) 4 (vcat (map ppr ds)))
(hang (pprSection section <+> lbrace) 4 (ppr ds))
$$ rbrace
-- --------------------------------------------------------------------------
......@@ -171,6 +174,9 @@ instance Outputable ForeignHint where
-- Strings are printed as C strings, and we print them as I8[],
-- following C--
--
pprStatics :: CmmStatics -> SDoc
pprStatics (Statics lbl ds) = vcat (map ppr (CmmDataLabel lbl:ds))
pprStatic :: CmmStatic -> SDoc
pprStatic s = case s of
CmmStaticLit lit -> nest 4 $ ptext (sLit "const") <+> pprLit lit <> semi
......
......@@ -12,6 +12,7 @@ import OldCmm
import CLabel
import Module
import OldCmmUtils
import CgUtils
import CgMonad
import HscTypes
......@@ -30,9 +31,8 @@ cgTickBox mod n = do
hpcTable :: Module -> HpcInfo -> Code
hpcTable this_mod (HpcInfo hpc_tickCount _) = do
emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod)
] ++
[ CmmStaticLit (CmmInt 0 W64)
emitDataLits (mkHpcTicksLabel this_mod) $
[ CmmInt 0 W64
| _ <- take hpc_tickCount [0::Int ..]
]
......
......@@ -736,7 +736,7 @@ emitCgStmt stmt
; setState $ state { cgs_stmts = cgs_stmts state `snocOL` stmt }
}
emitData :: Section -> [CmmStatic] -> Code
emitData :: Section -> CmmStatics -> Code
emitData sect lits
= do { state <- getState
; setState $ state { cgs_tops = cgs_tops state `snocOL` data_block } }
......
......@@ -545,26 +545,26 @@ baseRegOffset _ = panic "baseRegOffset:other"
emitDataLits :: CLabel -> [CmmLit] -> Code
-- Emit a data-segment data block
emitDataLits lbl lits
= emitData Data (CmmDataLabel lbl : map CmmStaticLit lits)
= emitData Data (Statics lbl $ map CmmStaticLit lits)
mkDataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatic info graph
mkDataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatics info graph
-- Emit a data-segment data block
mkDataLits lbl lits
= CmmData Data (CmmDataLabel lbl : map CmmStaticLit lits)
= CmmData Data (Statics lbl $ map CmmStaticLit lits)
emitRODataLits :: String -> CLabel -> [CmmLit] -> Code
-- Emit a read-only data block
emitRODataLits caller lbl lits
= emitData section (CmmDataLabel lbl : map CmmStaticLit lits)
= emitData section (Statics lbl $ map CmmStaticLit lits)
where section | any needsRelocation lits = RelocatableReadOnlyData
| otherwise = ReadOnlyData
needsRelocation (CmmLabel _) = True
needsRelocation (CmmLabelOff _ _) = True
needsRelocation _ = False
mkRODataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatic info graph
mkRODataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatics info graph
mkRODataLits lbl lits
= CmmData section (CmmDataLabel lbl : map CmmStaticLit lits)
= CmmData section (Statics lbl $ map CmmStaticLit lits)
where section | any needsRelocation lits = RelocatableReadOnlyData
| otherwise = ReadOnlyData
needsRelocation (CmmLabel _) = True
......@@ -580,7 +580,7 @@ mkByteStringCLit :: [Word8] -> FCode CmmLit
mkByteStringCLit bytes
= do { uniq <- newUnique
; let lbl = mkStringLitLabel uniq
; emitData ReadOnlyData [CmmDataLabel lbl, CmmString bytes]
; emitData ReadOnlyData $ Statics lbl [CmmString bytes]
; return (CmmLabel lbl) }
-------------------------------------------------------------------------
......
......@@ -105,7 +105,7 @@ mkModuleInit dflags cost_centre_info this_mod hpc_info
-- For backwards compatibility: user code may refer to this
-- label for calling hs_add_root().
; emitData Data $ [ CmmDataLabel (mkPlainModuleInitLabel this_mod) ]
; emitData Data $ Statics (mkPlainModuleInitLabel this_mod) []
; whenC (this_mod == mainModIs dflags) $
emitSimpleProc (mkPlainModuleInitLabel rOOT_MAIN) $ return ()
......
......@@ -182,7 +182,7 @@ mkModuleInit cost_centre_info this_mod hpc_info
; initCostCentres cost_centre_info
-- For backwards compatibility: user code may refer to this
-- label for calling hs_add_root().
; emitData Data $ [ CmmDataLabel (mkPlainModuleInitLabel this_mod) ]
; emitData Data $ Statics (mkPlainModuleInitLabel this_mod) []
}
---------------------------------------------------------------
......
......@@ -11,11 +11,11 @@ module StgCmmHpc ( initHpc, mkTickBox ) where
import StgCmmMonad
import MkGraph
import CmmDecl
import CmmExpr
import CLabel
import Module
import CmmUtils
import StgCmmUtils
import HscTypes
import StaticFlags
......@@ -36,9 +36,8 @@ initHpc _ (NoHpcInfo {})
= return ()
initHpc this_mod (HpcInfo tickCount _hashNo)
= whenC opt_Hpc $
do { emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod)
] ++
[ CmmStaticLit (CmmInt 0 W64)
| _ <- take tickCount [0::Int ..]
]
do { emitDataLits (mkHpcTicksLabel this_mod)
[ (CmmInt 0 W64)
| _ <- take tickCount [0::Int ..]
]
}
......@@ -593,7 +593,7 @@ emit ag
= do { state <- getState
; setState $ state { cgs_stmts = cgs_stmts state <*> ag } }
emitData :: Section -> [CmmStatic] -> FCode ()
emitData :: Section -> CmmStatics -> FCode ()
emitData sect lits
= do { state <- getState
; setState $ state { cgs_tops = cgs_tops state `snocOL` data_block } }
......
......@@ -508,26 +508,26 @@ baseRegOffset reg = pprPanic "baseRegOffset:" (ppr reg)
emitDataLits :: CLabel -> [CmmLit] -> FCode ()
-- Emit a data-segment data block
emitDataLits lbl lits
= emitData Data (CmmDataLabel lbl : map CmmStaticLit lits)
= emitData Data (Statics lbl $ map CmmStaticLit lits)
mkDataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatic info stmt
mkDataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatics info stmt
-- Emit a data-segment data block
mkDataLits lbl lits
= CmmData Data (CmmDataLabel lbl : map CmmStaticLit lits)
= CmmData Data (Statics lbl $ map CmmStaticLit lits)
emitRODataLits :: CLabel -> [CmmLit] -> FCode ()
-- Emit a read-only data block
emitRODataLits lbl lits
= emitData section (CmmDataLabel lbl : map CmmStaticLit lits)
= emitData section (Statics lbl $ map CmmStaticLit lits)
where section | any needsRelocation lits = RelocatableReadOnlyData
| otherwise = ReadOnlyData
needsRelocation (CmmLabel _) = True
needsRelocation (CmmLabelOff _ _) = True
needsRelocation _ = False
mkRODataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatic info stmt
mkRODataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatics info stmt
mkRODataLits lbl lits
= CmmData section (CmmDataLabel lbl : map CmmStaticLit lits)
= CmmData section (Statics lbl $ map CmmStaticLit lits)
where section | any needsRelocation lits = RelocatableReadOnlyData
| otherwise = ReadOnlyData
needsRelocation (CmmLabel _) = True
......@@ -543,7 +543,7 @@ mkByteStringCLit :: [Word8] -> FCode CmmLit
mkByteStringCLit bytes
= do { uniq <- newUnique
; let lbl = mkStringLitLabel uniq
; emitData ReadOnlyData [CmmDataLabel lbl, CmmString bytes]
; emitData ReadOnlyData $ Statics lbl [CmmString bytes]
; return (CmmLabel lbl) }
-------------------------------------------------------------------------
......
......@@ -62,7 +62,7 @@ llvmCodeGen dflags h us cmms
-- -----------------------------------------------------------------------------
-- | Do LLVM code generation on all these Cmms data sections.
--
cmmDataLlvmGens :: DynFlags -> BufHandle -> LlvmEnv -> [(Section,[CmmStatic])]
cmmDataLlvmGens :: DynFlags -> BufHandle -> LlvmEnv -> [(Section,CmmStatics)]
-> [LlvmUnresData] -> IO ( LlvmEnv )
cmmDataLlvmGens dflags h env [] lmdata
......
......@@ -41,7 +41,7 @@ import Unique
-- * Some Data Types
--
type LlvmCmmTop = GenCmmTop LlvmData [CmmStatic] (ListGraph LlvmStatement)
type LlvmCmmTop = GenCmmTop [LlvmData] [CmmStatic] (ListGraph LlvmStatement)
type LlvmBasicBlock = GenBasicBlock LlvmStatement
-- | Unresolved code.
......
......@@ -37,8 +37,8 @@ structStr = fsLit "_struct"
-- complete this completely though as we need to pass all CmmStatic
-- sections before all references can be resolved. This last step is
-- done by 'resolveLlvmData'.
genLlvmData :: (Section, [CmmStatic]) -> LlvmUnresData
genLlvmData (sec, CmmDataLabel lbl:xs) =
genLlvmData :: (Section, CmmStatics) -> LlvmUnresData
genLlvmData (sec, Statics lbl xs) =
let static = map genData xs
label = strCLabel_llvm lbl
......@@ -50,8 +50,6 @@ genLlvmData (sec, CmmDataLabel lbl:xs) =
alias = LMAlias ((label `appendFS` structStr), strucTy)
in (lbl, sec, alias, static)
genLlvmData _ = panic "genLlvmData: CmmData section doesn't start with label!"
resolveLlvmDatas :: LlvmEnv -> [LlvmUnresData] -> [LlvmData]
-> (LlvmEnv, [LlvmData])
......
......@@ -83,7 +83,7 @@ pprLlvmCmmTop _ _ (CmmData _ lmdata)
= (vcat $ map pprLlvmData lmdata, [])
pprLlvmCmmTop env count (CmmProc info lbl (ListGraph blks))
= let static = CmmDataLabel lbl : info
= let static = Statics lbl info
(idoc, ivar) = if not (null info)
then pprInfoTable env count lbl static
else (empty, [])
......@@ -103,7 +103,7 @@ pprLlvmCmmTop env count (CmmProc info lbl (ListGraph blks))
-- | Pretty print CmmStatic
pprInfoTable :: LlvmEnv -> Int -> CLabel -> [CmmStatic] -> (Doc, [LlvmVar])
pprInfoTable :: LlvmEnv -> Int -> CLabel -> CmmStatics -> (Doc, [LlvmVar])
pprInfoTable env count lbl stat
= let unres = genLlvmData (Text, stat)
(_, (ldata, ltypes)) = resolveLlvmData env unres
......
This diff is collapsed.
......@@ -37,13 +37,13 @@ noUsage = RU [] []
-- Type synonyms for Cmm populated with native code
type NatCmm instr
= GenCmm
CmmStatic
CmmStatics
[CmmStatic]
(ListGraph instr)
type NatCmmTop instr
type NatCmmTop statics instr
= GenCmmTop
CmmStatic
statics
[CmmStatic]
(ListGraph instr)
......
......@@ -709,8 +709,8 @@ pprImportedSymbol _ _ _
initializePicBase_ppc
:: Arch -> OS -> Reg
-> [NatCmmTop PPC.Instr]
-> NatM [NatCmmTop PPC.Instr]
-> [NatCmmTop CmmStatics PPC.Instr]
-> NatM [NatCmmTop CmmStatics PPC.Instr]
initializePicBase_ppc ArchPPC os picReg
(CmmProc info lab (ListGraph blocks) : statics)
......@@ -719,8 +719,7 @@ initializePicBase_ppc ArchPPC os picReg
gotOffLabel <- getNewLabelNat
tmp <- getNewRegNat $ intSize wordWidth
let
gotOffset = CmmData Text [
CmmDataLabel gotOffLabel,
gotOffset = CmmData Text $ Statics gotOffLabel [
CmmStaticLit (CmmLabelDiffOff gotLabel
mkPicBaseLabel
0)
......@@ -762,8 +761,8 @@ initializePicBase_ppc _ _ _ _
initializePicBase_x86
:: Arch -> OS -> Reg
-> [NatCmmTop X86.Instr]
-> NatM [NatCmmTop X86.Instr]
-> [NatCmmTop (Alignment, CmmStatics) X86.Instr]
-> NatM [NatCmmTop (Alignment, CmmStatics) X86.Instr]
initializePicBase_x86 ArchX86 os picReg
(CmmProc info lab (ListGraph blocks) : statics)
......
......@@ -67,7 +67,7 @@ import FastString
cmmTopCodeGen
:: RawCmmTop
-> NatM [NatCmmTop Instr]
-> NatM [NatCmmTop CmmStatics Instr]
cmmTopCodeGen (CmmProc info lab (ListGraph blocks)) = do
(nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
......@@ -86,7 +86,7 @@ cmmTopCodeGen (CmmData sec dat) = do
basicBlockCodeGen
:: CmmBasicBlock
-> NatM ( [NatBasicBlock Instr]
, [NatCmmTop Instr])
, [NatCmmTop CmmStatics Instr])
basicBlockCodeGen (BasicBlock id stmts) = do
instrs <- stmtsToInstrs stmts
......@@ -557,8 +557,8 @@ getRegister' _ (CmmLit (CmmFloat f frep)) = do
Amode addr addr_code <- getAmode dynRef
let size = floatSize frep
code dst =
LDATA ReadOnlyData [CmmDataLabel lbl,
CmmStaticLit (CmmFloat f frep)]
LDATA ReadOnlyData (Statics lbl
[CmmStaticLit (CmmFloat f frep)])
`consOL` (addr_code `snocOL` LD size dst addr)
return (Any size code)
......@@ -1180,7 +1180,7 @@ genSwitch expr ids
]
return code
generateJumpTableForInstr :: Instr -> Maybe (NatCmmTop Instr)
generateJumpTableForInstr :: Instr -> Maybe (NatCmmTop CmmStatics Instr)
generateJumpTableForInstr (BCTR ids (Just lbl)) =
let jumpTable
| opt_PIC = map jumpTableEntryRel ids
......@@ -1190,7 +1190,7 @@ generateJumpTableForInstr (BCTR ids (Just lbl)) =
jumpTableEntryRel (Just blockid)
= CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0)
where blockLabel = mkAsmTempLabel (getUnique blockid)
in Just (CmmData ReadOnlyData (CmmDataLabel lbl : jumpTable))
in Just (CmmData ReadOnlyData (Statics lbl jumpTable))
generateJumpTableForInstr _ = Nothing
-- -----------------------------------------------------------------------------
......@@ -1362,10 +1362,9 @@ coerceInt2FP fromRep toRep x = do
Amode addr addr_code <- getAmode dynRef
let
code' dst = code `appOL` maybe_exts `appOL` toOL [
LDATA ReadOnlyData
[CmmDataLabel lbl,
CmmStaticLit (CmmInt 0x43300000 W32),
CmmStaticLit (CmmInt 0x80000000 W32)],
LDATA ReadOnlyData $ Statics lbl
[CmmStaticLit (CmmInt 0x43300000 W32),
CmmStaticLit (CmmInt 0x80000000 W32)],
XORIS itmp src (ImmInt 0x8000),
ST II32 itmp (spRel 3),
LIS itmp (ImmInt 0x4330),
......
......@@ -75,7 +75,7 @@ data Instr
-- some static data spat out during code
-- generation. Will be extracted before
-- pretty-printing.
| LDATA Section [CmmStatic]
| LDATA Section CmmStatics
-- start a new basic block. Useful during
-- codegen, removed later. Preceding
......
......@@ -49,9 +49,9 @@ import Data.Bits
-- -----------------------------------------------------------------------------
-- Printing this stuff out
pprNatCmmTop :: NatCmmTop Instr -> Doc
pprNatCmmTop :: NatCmmTop CmmStatics Instr -> Doc
pprNatCmmTop (CmmData section dats) =
pprSectionHeader section $$ vcat (map pprData dats)
pprSectionHeader section $$ pprDatas dats
-- special case for split markers:
pprNatCmmTop (CmmProc [] lbl (ListGraph [])) = pprLabel lbl
......@@ -93,6 +93,10 @@ pprBasicBlock (BasicBlock blockid instrs) =
vcat (map pprInstr instrs)
pprDatas :: CmmStatics -> Doc
pprDatas (Statics lbl dats) = vcat (map pprData (CmmDataLabel lbl:dats))
pprData :: CmmStatic -> Doc
pprData (CmmAlign bytes) = pprAlign bytes
pprData (CmmDataLabel lbl) = pprLabel lbl
......
......@@ -11,7 +11,7 @@ module PPC.RegInfo (
canShortcut,
shortcutJump,
shortcutStatic
shortcutStatics
)
where
......@@ -43,18 +43,24 @@ shortcutJump _ other = other
-- Here because it knows about JumpDest
shortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic
shortcutStatics :: (BlockId -> Maybe JumpDest) -> CmmStatics -> CmmStatics
shortcutStatics fn (Statics lbl statics)
= Statics lbl $ map (shortcutStatic fn) statics
-- we need to get the jump tables, so apply the mapping to the entries
-- of a CmmData too.
shortcutStatic fn (CmmStaticLit (CmmLabel lab))
| Just uq <- maybeAsmTemp lab
= CmmStaticLit (CmmLabel (shortBlockId fn (mkBlockId uq)))
shortcutLabel :: (BlockId -> Maybe JumpDest) -> CLabel -> CLabel
shortcutLabel fn lab
| Just uq <- maybeAsmTemp lab = shortBlockId fn (mkBlockId uq)
| otherwise = lab
shortcutStatic :: (BlockId -> Maybe JumpDest) -> CmmStatic -> CmmStatic
shortcutStatic fn (CmmStaticLit (CmmLabel lab))
= CmmStaticLit (CmmLabel (shortcutLabel fn lab))
shortcutStatic fn (CmmStaticLit (CmmLabelDiffOff lbl1 lbl2 off))
| Just uq <- maybeAsmTemp lbl1
= CmmStaticLit (CmmLabelDiffOff (shortBlockId fn (mkBlockId uq)) lbl2 off)
= CmmStaticLit (CmmLabelDiffOff (shortcutLabel fn lbl1) lbl2 off)
-- slightly dodgy, we're ignoring the second label, but this
-- works with the way we use CmmLabelDiffOff for jump tables now.
shortcutStatic _ other_static
= other_static
......
......@@ -27,8 +27,8 @@ import Data.List
-- the same and the move instruction safely erased.
regCoalesce
:: Instruction instr
=> [LiveCmmTop instr]
-> UniqSM [LiveCmmTop instr]
=> [LiveCmmTop statics instr]
-> UniqSM [LiveCmmTop statics instr]
regCoalesce code
= do
......@@ -61,7 +61,7 @@ sinkReg fm r
-- then we can rename the two regs to the same thing and eliminate the move.
slurpJoinMovs
:: Instruction instr
=> LiveCmmTop instr
=> LiveCmmTop statics instr
-> Bag (Reg, Reg)
slurpJoinMovs live
......
......@@ -44,12 +44,12 @@ maxSpinCount = 10
-- | The top level of the graph coloring register allocator.
regAlloc
:: (Outputable instr, Instruction instr)
:: (Outputable statics, Outputable instr, Instruction instr)
=> DynFlags
-> UniqFM (UniqSet RealReg) -- ^ the registers we can use for allocation
-> UniqSet Int -- ^ the set of available spill slots.
-> [LiveCmmTop instr] -- ^ code annotated with liveness information.
-> UniqSM ( [NatCmmTop instr], [RegAllocStats instr] )
-> [LiveCmmTop statics instr] -- ^ code annotated with liveness information.
-> UniqSM ( [NatCmmTop statics instr], [RegAllocStats statics instr] )
-- ^ code with registers allocated and stats for each stage of
-- allocation
......@@ -239,7 +239,7 @@ regAlloc_spin
-- | Build a graph from the liveness and coalesce information in this code.
buildGraph
:: Instruction instr
=> [LiveCmmTop instr]
=> [LiveCmmTop statics instr]
-> UniqSM (Color.Graph VirtualReg RegClass RealReg)
buildGraph code
......@@ -320,9 +320,9 @@ graphAddCoalesce _ _
-- | Patch registers in code using the reg -> reg mapping in this graph.
patchRegsFromGraph
:: (Outputable instr, Instruction instr)
:: (Outputable statics, Outputable instr, Instruction instr)
=> Color.Graph VirtualReg RegClass RealReg
-> LiveCmmTop instr -> LiveCmmTop instr
-> LiveCmmTop statics instr -> LiveCmmTop statics instr