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,
  11         stgHp, stgHpLim, stgTagReg, stgR9, stgR10,
  12         getUniqLabelNCG,
  13
  14         fixedHS, arrWordsHS, arrPtrsHS
  15     ) where
  16
  17 #include "HsVersions.h"
  18
  19 import Ratio            ( Rational )
  20
  21 import AbsCSyn          ( node, tagreg, MagicId(..) )
  22 import AbsCUtils        ( magicIdPrimRep )
  23 import CallConv         ( CallConv, pprCallConv )
  24 import CLabel           ( mkAsmTempLabel, CLabel, pprCLabel, pprCLabel_asm )
  25 import PrimRep          ( PrimRep(..), showPrimRep )
  26 import PrimOp           ( PrimOp, pprPrimOp )
  27 import Unique           ( Unique )
  28 import SMRep            ( fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize )
  29 import UniqSupply       ( returnUs, thenUs, getUniqueUs, UniqSM )
  30 import Outputable
  31 \end{code}
  32
  33 Here is the tag at the nodes of our @StixTree@.  Notice its
  34 relationship with @PrimOp@ in prelude/PrimOp.
  35
  36 \begin{code}
  37 data StixTree
  38   = -- Segment (text or data)
  39
  40     StSegment CodeSegment
  41
  42     -- We can tag the leaves with constants/immediates.
  43
  44   | StInt       Integer     -- ** add Kind at some point
  45   | StDouble    Rational
  46   | StString    FAST_STRING
  47   | StLitLbl    SDoc    -- literal labels
  48                             -- (will be _-prefixed on some machines)
  49
  50   | StCLbl      CLabel      -- labels that we might index into
  51
  52     -- Abstract registers of various kinds
  53
  54   | StReg StixReg
  55
  56     -- A typed offset from a base location
  57
  58   | StIndex PrimRep StixTree StixTree -- kind, base, offset
  59
  60     -- An indirection from an address to its contents.
  61
  62   | StInd PrimRep StixTree
  63
  64     -- Assignment is typed to determine size and register placement
  65
  66   | StAssign PrimRep StixTree StixTree -- dst, src
  67
  68     -- A simple assembly label that we might jump to.
  69
  70   | StLabel CLabel
  71
  72     -- A function header and footer
  73
  74   | StFunBegin CLabel
  75   | StFunEnd CLabel
  76
  77     -- An unconditional jump. This instruction is terminal.
  78     -- Dynamic targets are allowed
  79
  80   | StJump StixTree
  81
  82     -- A fall-through, from slow to fast
  83
  84   | StFallThrough CLabel
  85
  86     -- A conditional jump. This instruction can be non-terminal :-)
  87     -- Only static, local, forward labels are allowed
  88
  89   | StCondJump CLabel StixTree
  90
  91     -- Raw data (as in an info table).
  92
  93   | StData PrimRep [StixTree]
  94
  95     -- Primitive Operations
  96
  97   | StPrim PrimOp [StixTree]
  98
  99     -- Calls to C functions
 100
 101   | StCall FAST_STRING CallConv PrimRep [StixTree]
 102
 103     -- Assembly-language comments
 104
 105   | StComment FAST_STRING
 106
 107 sStLitLbl :: FAST_STRING -> StixTree
 108 sStLitLbl s = StLitLbl (ptext s)
 109
 110
 111 pprStixTrees :: [StixTree] -> SDoc
 112 pprStixTrees ts
 113   = vcat [
 114        vcat (map ppStixTree ts),
 115        char ' ',
 116        char ' '
 117     ]
 118
 119 paren t = char '(' <> t <> char ')'
 120
 121 ppStixTree :: StixTree -> SDoc
 122 ppStixTree t
 123    = case t of
 124        StSegment cseg -> paren (ppCodeSegment cseg)
 125        StInt i        -> paren (integer i)
 126        StDouble rat   -> paren (text "Double" <+> rational rat)
 127        StString str   -> paren (text "Str" <+> ptext str)
 128        StComment str  -> paren (text "Comment" <+> ptext str)
 129        StLitLbl sd    -> sd
 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 stgR9               = StReg (StixMagicId (VanillaReg WordRep ILIT(9)))
 208 stgR10              = StReg (StixMagicId (VanillaReg WordRep ILIT(10)))
 209
 210 getUniqLabelNCG :: UniqSM CLabel
 211 getUniqLabelNCG
 212   = getUniqueUs       `thenUs` \ u ->
 213     returnUs (mkAsmTempLabel u)
 214
 215 fixedHS     = StInt (toInteger fixedHdrSize)
 216 arrWordsHS  = StInt (toInteger arrWordsHdrSize)
 217 arrPtrsHS   = StInt (toInteger arrPtrsHdrSize)
 218 \end{code}