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, arrWordsHS, arrPtrsHS
  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, pprCLabel_asm )
  24 import PrimRep          ( PrimRep, showPrimRep )
  25 import PrimOp           ( PrimOp, pprPrimOp )
  26 import Unique           ( Unique )
  27 import SMRep            ( fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize )
  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
  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        StCLbl lbl     -> pprCLabel lbl
 130        StReg reg      -> ppStixReg reg
 131        StIndex k b o  -> paren (ppStixTree b <+> char '+' <>
 132                                 pprPrimRep k <+> ppStixTree o)
 133        StInd k t      -> pprPrimRep k <> char '[' <> ppStixTree t <> char ']'
 134        StAssign k d s -> ppStixTree d <> text "  :=" <> pprPrimRep k
 135                                           <> text "  " <> ppStixTree s
 136        StLabel ll     -> pprCLabel ll <+> char ':'
 137        StFunBegin ll  -> char ' ' $$ paren (text "FunBegin" <+> pprCLabel ll)
 138        StFunEnd ll    -> paren (text "FunEnd" <+> pprCLabel ll)
 139        StJump t       -> paren (text "Jump" <+> ppStixTree t)
 140        StFallThrough ll -> paren (text "FallThru" <+> pprCLabel ll)
 141        StCondJump l t -> paren (text "JumpC" <+> pprCLabel l <+> ppStixTree t)
 142        StData k ds -> paren (text "Data" <+> pprPrimRep k <+>
 143                       hsep (map ppStixTree ds))
 144        StPrim op ts -> paren (text "Prim" <+> pprPrimOp op <+> hsep (map ppStixTree ts))
 145        StCall nm cc k args
 146           -> paren (text "Call" <+> ptext nm <+>
 147                pprCallConv cc <+> pprPrimRep k <+> hsep (map ppStixTree args))
 148      where
 149         pprPrimRep = text . showPrimRep
 150 \end{code}
 151
 152 Stix registers can have two forms.  They {\em may} or {\em may not}
 153 map to real, machine-level registers.
 154
 155 \begin{code}
 156 data StixReg
 157   = StixMagicId MagicId -- Regs which are part of the abstract machine model
 158
 159   | StixTemp Unique PrimRep -- "Regs" which model local variables (CTemps) in
 160                                         -- the abstract C.
 161
 162 ppStixReg (StixMagicId mid)
 163    = ppMId mid
 164 ppStixReg (StixTemp u pr)
 165    = hcat [text "Temp(", ppr u, ppr pr, char ')']
 166
 167
 168 ppMId BaseReg              = text "BaseReg"
 169 ppMId (VanillaReg kind n)  = hcat [text "IntReg(", int (I# n), char ')']
 170 ppMId (FloatReg n)         = hcat [text "FltReg(", int (I# n), char ')']
 171 ppMId (DoubleReg n)        = hcat [text "DblReg(", int (I# n), char ')']
 172 ppMId (LongReg kind n)     = hcat [text "LongReg(", int (I# n), char ')']
 173 ppMId Sp                   = text "Sp"
 174 ppMId Su                   = text "Su"
 175 ppMId SpLim                = text "SpLim"
 176 ppMId Hp                   = text "Hp"
 177 ppMId HpLim                = text "HpLim"
 178 ppMId CurCostCentre        = text "CCC"
 179 ppMId VoidReg              = text "VoidReg"
 180 \end{code}
 181
 182 We hope that every machine supports the idea of data segment and text
 183 segment (or that it has no segments at all, and we can lump these
 184 together).
 185
 186 \begin{code}
 187 data CodeSegment = DataSegment | TextSegment deriving (Eq, Show)
 188 ppCodeSegment = text . show
 189
 190 type StixTreeList = [StixTree] -> [StixTree]
 191 \end{code}
 192
 193 Stix Trees for STG registers:
 194 \begin{code}
 195 stgBaseReg, stgNode, stgSp, stgSu, stgSpLim, stgHp, stgHpLim
 196         :: StixTree
 197
 198 stgBaseReg          = StReg (StixMagicId BaseReg)
 199 stgNode             = StReg (StixMagicId node)
 200 stgTagReg           = StReg (StixMagicId tagreg)
 201 stgSp               = StReg (StixMagicId Sp)
 202 stgSu               = StReg (StixMagicId Su)
 203 stgSpLim            = StReg (StixMagicId SpLim)
 204 stgHp               = StReg (StixMagicId Hp)
 205 stgHpLim            = StReg (StixMagicId HpLim)
 206
 207 getUniqLabelNCG :: UniqSM CLabel
 208 getUniqLabelNCG
 209   = getUniqueUs       `thenUs` \ u ->
 210     returnUs (mkAsmTempLabel u)
 211
 212 fixedHS     = StInt (toInteger fixedHdrSize)
 213 arrWordsHS  = StInt (toInteger arrWordsHdrSize)
 214 arrPtrsHS   = StInt (toInteger arrPtrsHdrSize)
 215 \end{code}