ghc/compiler/nativeGen/Stix.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1993-1998
   3 %
   4
   5 \begin{code}
   6 module Stix (
   7         CodeSegment(..), StixReg(..), StixTree(..), StixTreeList,
   8         sStLitLbl, pprStixTrees,
   9
  10         stgBaseReg, stgNode, stgSp, stgSu, stgSpLim, stgHp, stgHpLim, stgTagReg,
  11         getUniqLabelNCG,
  12
  13         fixedHS, arrHS
  14     ) where
  15
  16 #include "HsVersions.h"
  17
  18 import Ratio            ( Rational )
  19
  20 import AbsCSyn          ( node, tagreg, MagicId(..) )
  21 import AbsCUtils        ( magicIdPrimRep )
  22 import CallConv         ( CallConv, pprCallConv )
  23 import CLabel           ( mkAsmTempLabel, CLabel, pprCLabel )
  24 import PrimRep          ( PrimRep, showPrimRep )
  25 import PrimOp           ( PrimOp, pprPrimOp )
  26 import Unique           ( Unique )
  27 import SMRep            ( fixedHdrSize, arrHdrSize )
  28 import UniqSupply       ( returnUs, thenUs, getUniqueUs, UniqSM )
  29 import Outputable
  30 \end{code}
  31
  32 Here is the tag at the nodes of our @StixTree@.  Notice its
  33 relationship with @PrimOp@ in prelude/PrimOp.
  34
  35 \begin{code}
  36 data StixTree
  37   = -- Segment (text or data)
  38
  39     StSegment CodeSegment
  40
  41     -- We can tag the leaves with constants/immediates.
  42
  43   | StInt       Integer     -- ** add Kind at some point
  44   | StDouble    Rational
  45   | StString    FAST_STRING
  46   | StLitLbl    SDoc    -- literal labels
  47                             -- (will be _-prefixed on some machines)
  48   | StLitLit    FAST_STRING -- innards from CLitLit
  49   | StCLbl      CLabel      -- labels that we might index into
  50
  51     -- Abstract registers of various kinds
  52
  53   | StReg StixReg
  54
  55     -- A typed offset from a base location
  56
  57   | StIndex PrimRep StixTree StixTree -- kind, base, offset
  58
  59     -- An indirection from an address to its contents.
  60
  61   | StInd PrimRep StixTree
  62
  63     -- Assignment is typed to determine size and register placement
  64
  65   | StAssign PrimRep StixTree StixTree -- dst, src
  66
  67     -- A simple assembly label that we might jump to.
  68
  69   | StLabel CLabel
  70
  71     -- A function header and footer
  72
  73   | StFunBegin CLabel
  74   | StFunEnd CLabel
  75
  76     -- An unconditional jump. This instruction is terminal.
  77     -- Dynamic targets are allowed
  78
  79   | StJump StixTree
  80
  81     -- A fall-through, from slow to fast
  82
  83   | StFallThrough CLabel
  84
  85     -- A conditional jump. This instruction can be non-terminal :-)
  86     -- Only static, local, forward labels are allowed
  87
  88   | StCondJump CLabel StixTree
  89
  90     -- Raw data (as in an info table).
  91
  92   | StData PrimRep [StixTree]
  93
  94     -- Primitive Operations
  95
  96   | StPrim PrimOp [StixTree]
  97
  98     -- Calls to C functions
  99
 100   | StCall FAST_STRING CallConv PrimRep [StixTree]
 101
 102     -- Assembly-language comments
 103
 104   | StComment FAST_STRING
 105
 106 sStLitLbl :: FAST_STRING -> StixTree
 107 sStLitLbl s = StLitLbl (ptext s)
 108
 109
 110 pprStixTrees :: [StixTree] -> SDoc
 111 pprStixTrees ts
 112   = vcat [
 113        vcat (map ppStixTree ts),
 114        char ' ',
 115        char ' '
 116     ]
 117
 118 paren t = char '(' <> t <> char ')'
 119
 120 ppStixTree :: StixTree -> SDoc
 121 ppStixTree t
 122    = case t of
 123        StSegment cseg -> paren (ppCodeSegment cseg)
 124        StInt i        -> paren (integer i)
 125        StDouble rat   -> paren (text "Double" <+> rational rat)
 126        StString str   -> paren (text "Str" <+> ptext str)
 127        StComment str  -> paren (text "Comment" <+> ptext str)
 128        StLitLbl sd    -> sd
 129        StLitLit ll    -> paren (text "LitLit" <+> ptext ll)
 130        StCLbl lbl     -> pprCLabel lbl
 131        StReg reg      -> ppStixReg reg
 132        StIndex k b o  -> paren (ppStixTree b <+> char '+' <>
 133                                 pprPrimRep k <+> ppStixTree o)
 134        StInd k t      -> pprPrimRep k <> char '[' <> ppStixTree t <> char ']'
 135        StAssign k d s -> ppStixTree d <> text "  :=" <> pprPrimRep k
 136                                           <> text "  " <> ppStixTree s
 137        StLabel ll     -> pprCLabel ll <+> char ':'
 138        StFunBegin ll  -> char ' ' $$ paren (text "FunBegin" <+> pprCLabel ll)
 139        StFunEnd ll    -> paren (text "FunEnd" <+> pprCLabel ll)
 140        StJump t       -> paren (text "Jump" <+> ppStixTree t)
 141        StFallThrough ll -> paren (text "FallThru" <+> pprCLabel ll)
 142        StCondJump l t -> paren (text "JumpC" <+> pprCLabel l <+> ppStixTree t)
 143        StData k ds -> paren (text "Data" <+> pprPrimRep k <+>
 144                       hsep (map ppStixTree ds))
 145        StPrim op ts -> paren (text "Prim" <+> pprPrimOp op <+> hsep (map ppStixTree ts))
 146        StCall nm cc k args
 147           -> paren (text "Call" <+> ptext nm <+>
 148                pprCallConv cc <+> pprPrimRep k <+> hsep (map ppStixTree args))
 149      where
 150         pprPrimRep = text . showPrimRep
 151 \end{code}
 152
 153 Stix registers can have two forms.  They {\em may} or {\em may not}
 154 map to real, machine-level registers.
 155
 156 \begin{code}
 157 data StixReg
 158   = StixMagicId MagicId -- Regs which are part of the abstract machine model
 159
 160   | StixTemp Unique PrimRep -- "Regs" which model local variables (CTemps) in
 161                                         -- the abstract C.
 162
 163 ppStixReg (StixMagicId mid)
 164    = ppMId mid
 165 ppStixReg (StixTemp u pr)
 166    = hcat [text "Temp(", ppr u, ppr pr, char ')']
 167
 168
 169 ppMId BaseReg              = text "BaseReg"
 170 ppMId (VanillaReg kind n)  = hcat [text "IntReg(", int (I# n), char ')']
 171 ppMId (FloatReg n)         = hcat [text "FltReg(", int (I# n), char ')']
 172 ppMId (DoubleReg n)        = hcat [text "DblReg(", int (I# n), char ')']
 173 ppMId (LongReg kind n)     = hcat [text "LongReg(", int (I# n), char ')']
 174 ppMId Sp                   = text "Sp"
 175 ppMId Su                   = text "Su"
 176 ppMId SpLim                = text "SpLim"
 177 ppMId Hp                   = text "Hp"
 178 ppMId HpLim                = text "HpLim"
 179 ppMId CurCostCentre        = text "CCC"
 180 ppMId VoidReg              = text "VoidReg"
 181 \end{code}
 182
 183 We hope that every machine supports the idea of data segment and text
 184 segment (or that it has no segments at all, and we can lump these
 185 together).
 186
 187 \begin{code}
 188 data CodeSegment = DataSegment | TextSegment deriving (Eq, Show)
 189 ppCodeSegment = text . show
 190
 191 type StixTreeList = [StixTree] -> [StixTree]
 192 \end{code}
 193
 194 Stix Trees for STG registers:
 195 \begin{code}
 196 stgBaseReg, stgNode, stgSp, stgSu, stgSpLim, stgHp, stgHpLim
 197         :: StixTree
 198
 199 stgBaseReg          = StReg (StixMagicId BaseReg)
 200 stgNode             = StReg (StixMagicId node)
 201 stgTagReg           = StReg (StixMagicId tagreg)
 202 stgSp               = StReg (StixMagicId Sp)
 203 stgSu               = StReg (StixMagicId Su)
 204 stgSpLim            = StReg (StixMagicId SpLim)
 205 stgHp               = StReg (StixMagicId Hp)
 206 stgHpLim            = StReg (StixMagicId HpLim)
 207
 208 getUniqLabelNCG :: UniqSM CLabel
 209 getUniqLabelNCG
 210   = getUniqueUs       `thenUs` \ u ->
 211     returnUs (mkAsmTempLabel u)
 212
 213 fixedHS = StInt (toInteger fixedHdrSize)
 214 arrHS   = StInt (toInteger arrHdrSize)
 215 \end{code}