X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FStix.lhs;h=d3eb3ddcd43608115bc427d3b068d308b9288f64;hb=da25d580440a2b6a30eabedff19e7a6970f35991;hp=c521ad9e3505bcfdabb5ddd10e046ea9a89a82c5;hpb=8c670eaabfcd0d8db42d0db31342b9293919aaa2;p=ghc-hetmet.git diff --git a/ghc/compiler/nativeGen/Stix.lhs b/ghc/compiler/nativeGen/Stix.lhs index c521ad9..d3eb3dd 100644 --- a/ghc/compiler/nativeGen/Stix.lhs +++ b/ghc/compiler/nativeGen/Stix.lhs @@ -5,11 +5,13 @@ \begin{code} module Stix ( CodeSegment(..), StixReg(..), StixTree(..), StixTreeList, - sStLitLbl, pprStixTrees, ppStixTree, ppStixReg, + pprStixTrees, pprStixTree, ppStixReg, stixCountTempUses, stixSubst, + DestInfo(..), hasDestInfo, stgBaseReg, stgNode, stgSp, stgSu, stgSpLim, - stgHp, stgHpLim, stgTagReg, stgR9, stgR10, + stgHp, stgHpLim, stgTagReg, stgR9, stgR10, + stgCurrentTSO, stgCurrentNursery, fixedHS, arrWordsHS, arrPtrsHS, @@ -27,16 +29,16 @@ module Stix ( import Ratio ( Rational ) import AbsCSyn ( node, tagreg, MagicId(..) ) -import AbsCUtils ( magicIdPrimRep ) import CallConv ( CallConv, pprCallConv ) -import CLabel ( mkAsmTempLabel, CLabel, pprCLabel, pprCLabel_asm ) -import PrimRep ( PrimRep(..), showPrimRep ) -import PrimOp ( PrimOp, pprPrimOp ) +import CLabel ( mkAsmTempLabel, CLabel, pprCLabel ) +import PrimRep ( PrimRep(..) ) +import PrimOp ( PrimOp ) import Unique ( Unique ) import SMRep ( fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize ) import UniqSupply ( UniqSupply, splitUniqSupply, uniqFromSupply, UniqSM, thenUs, returnUs, getUniqueUs ) import Outputable +import FastTypes \end{code} Here is the tag at the nodes of our @StixTree@. Notice its @@ -51,11 +53,9 @@ data StixTree -- We can tag the leaves with constants/immediates. | StInt Integer -- ** add Kind at some point + | StFloat Rational | StDouble Rational | StString FAST_STRING - | StLitLbl SDoc -- literal labels - -- (will be _-prefixed on some machines) - | StCLbl CLabel -- labels that we might index into -- Abstract registers of various kinds @@ -83,10 +83,15 @@ data StixTree | StFunBegin CLabel | StFunEnd CLabel - -- An unconditional jump. This instruction is terminal. - -- Dynamic targets are allowed + -- An unconditional jump. This instruction may or may not jump + -- out of the register allocation domain (basic block, more or + -- less). For correct register allocation when this insn is used + -- to jump through a jump table, we optionally allow a list of + -- the exact targets to be attached, so that the allocator can + -- easily construct the exact flow edges leaving this insn. + -- Dynamic targets are allowed. - | StJump StixTree + | StJump DestInfo StixTree -- A fall-through, from slow to fast @@ -121,54 +126,63 @@ data StixTree | StComment FAST_STRING -sStLitLbl :: FAST_STRING -> StixTree -sStLitLbl s = StLitLbl (ptext s) + +-- used by insnFuture in RegAllocInfo.lhs +data DestInfo + = NoDestInfo -- no supplied dests; infer from context + | DestInfo [CLabel] -- precisely these dests and no others + +hasDestInfo NoDestInfo = False +hasDestInfo (DestInfo _) = True + +pprDests :: DestInfo -> SDoc +pprDests NoDestInfo = text "NoDestInfo" +pprDests (DestInfo dsts) = brack (hsep (map pprCLabel dsts)) pprStixTrees :: [StixTree] -> SDoc pprStixTrees ts = vcat [ - vcat (map ppStixTree ts), + vcat (map pprStixTree ts), char ' ', char ' ' ] paren t = char '(' <> t <> char ')' +brack t = char '[' <> t <> char ']' -ppStixTree :: StixTree -> SDoc -ppStixTree t +pprStixTree :: StixTree -> SDoc +pprStixTree t = case t of StSegment cseg -> paren (ppCodeSegment cseg) StInt i -> paren (integer i) + StFloat rat -> paren (text "Float" <+> rational rat) StDouble rat -> paren (text "Double" <+> rational rat) - StString str -> paren (text "Str" <+> ptext str) + StString str -> paren (text "Str `" <> ptext str <> char '\'') StComment str -> paren (text "Comment" <+> ptext str) - StLitLbl sd -> sd StCLbl lbl -> pprCLabel lbl StReg reg -> ppStixReg reg - StIndex k b o -> paren (ppStixTree b <+> char '+' <> - pprPrimRep k <+> ppStixTree o) - StInd k t -> pprPrimRep k <> char '[' <> ppStixTree t <> char ']' - StAssign k d s -> ppStixTree d <> text " :=" <> pprPrimRep k - <> text " " <> ppStixTree s + StIndex k b o -> paren (pprStixTree b <+> char '+' <> + ppr k <+> pprStixTree o) + StInd k t -> ppr k <> char '[' <> pprStixTree t <> char ']' + StAssign k d s -> pprStixTree d <> text " :=" <> ppr k + <> text " " <> pprStixTree s StLabel ll -> pprCLabel ll <+> char ':' StFunBegin ll -> char ' ' $$ paren (text "FunBegin" <+> pprCLabel ll) StFunEnd ll -> paren (text "FunEnd" <+> pprCLabel ll) - StJump t -> paren (text "Jump" <+> ppStixTree t) + StJump dsts t -> paren (text "Jump" <+> pprDests dsts <+> pprStixTree t) StFallThrough ll -> paren (text "FallThru" <+> pprCLabel ll) StCondJump l t -> paren (text "JumpC" <+> pprCLabel l - <+> ppStixTree t) - StData k ds -> paren (text "Data" <+> pprPrimRep k <+> - hsep (map ppStixTree ds)) - StPrim op ts -> paren (text "Prim" <+> pprPrimOp op <+> - hsep (map ppStixTree ts)) + <+> pprStixTree t) + StData k ds -> paren (text "Data" <+> ppr k <+> + hsep (map pprStixTree ds)) + StPrim op ts -> paren (text "Prim" <+> ppr op <+> + hsep (map pprStixTree ts)) StCall nm cc k args -> paren (text "Call" <+> ptext nm <+> - pprCallConv cc <+> pprPrimRep k <+> - hsep (map ppStixTree args)) + pprCallConv cc <+> ppr k <+> + hsep (map pprStixTree args)) StScratchWord i -> text "ScratchWord" <> paren (int i) - -pprPrimRep = text . showPrimRep \end{code} Stix registers can have two forms. They {\em may} or {\em may not} @@ -188,12 +202,12 @@ ppStixReg (StixTemp u pr) ppMId BaseReg = text "BaseReg" -ppMId (VanillaReg kind n) = hcat [pprPrimRep kind, text "IntReg(", - int (I# n), char ')'] -ppMId (FloatReg n) = hcat [text "FltReg(", int (I# n), char ')'] -ppMId (DoubleReg n) = hcat [text "DblReg(", int (I# n), char ')'] -ppMId (LongReg kind n) = hcat [pprPrimRep kind, text "LongReg(", - int (I# n), char ')'] +ppMId (VanillaReg kind n) = hcat [ppr kind, text "IntReg(", + int (iBox n), char ')'] +ppMId (FloatReg n) = hcat [text "FltReg(", int (iBox n), char ')'] +ppMId (DoubleReg n) = hcat [text "DblReg(", int (iBox n), char ')'] +ppMId (LongReg kind n) = hcat [ppr kind, text "LongReg(", + int (iBox n), char ')'] ppMId Sp = text "Sp" ppMId Su = text "Su" ppMId SpLim = text "SpLim" @@ -208,7 +222,7 @@ segment (or that it has no segments at all, and we can lump these together). \begin{code} -data CodeSegment = DataSegment | TextSegment deriving (Eq, Show) +data CodeSegment = DataSegment | TextSegment | RoDataSegment deriving (Eq, Show) ppCodeSegment = text . show type StixTreeList = [StixTree] -> [StixTree] @@ -227,8 +241,10 @@ stgSu = StReg (StixMagicId Su) stgSpLim = StReg (StixMagicId SpLim) stgHp = StReg (StixMagicId Hp) stgHpLim = StReg (StixMagicId HpLim) -stgR9 = StReg (StixMagicId (VanillaReg WordRep ILIT(9))) -stgR10 = StReg (StixMagicId (VanillaReg WordRep ILIT(10))) +stgCurrentTSO = StReg (StixMagicId CurrentTSO) +stgCurrentNursery = StReg (StixMagicId CurrentNursery) +stgR9 = StReg (StixMagicId (VanillaReg WordRep (_ILIT 9))) +stgR10 = StReg (StixMagicId (VanillaReg WordRep (_ILIT 10))) getNatLabelNCG :: NatM CLabel getNatLabelNCG @@ -263,7 +279,7 @@ stixCountTempUses u t StIndex pk t1 t2 -> qq t1 + qq t2 StInd pk t1 -> qq t1 StAssign pk t1 t2 -> qq t1 + qq t2 - StJump t1 -> qq t1 + StJump dsts t1 -> qq t1 StCondJump lbl t1 -> qq t1 StData pk ts -> sum (map qq ts) StPrim op ts -> sum (map qq ts) @@ -271,9 +287,9 @@ stixCountTempUses u t StSegment _ -> 0 StInt _ -> 0 + StFloat _ -> 0 StDouble _ -> 0 StString _ -> 0 - StLitLbl _ -> 0 StCLbl _ -> 0 StLabel _ -> 0 StFunBegin _ -> 0 @@ -307,7 +323,7 @@ stixMapUniques f t StIndex pk t1 t2 -> StIndex pk (qq t1) (qq t2) StInd pk t1 -> StInd pk (qq t1) StAssign pk t1 t2 -> StAssign pk (qq t1) (qq t2) - StJump t1 -> StJump (qq t1) + StJump dsts t1 -> StJump dsts (qq t1) StCondJump lbl t1 -> StCondJump lbl (qq t1) StData pk ts -> StData pk (map qq ts) StPrim op ts -> StPrim op (map qq ts) @@ -315,9 +331,9 @@ stixMapUniques f t StSegment _ -> t StInt _ -> t + StFloat _ -> t StDouble _ -> t StString _ -> t - StLitLbl _ -> t StCLbl _ -> t StLabel _ -> t StFunBegin _ -> t