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, ppStixReg,
   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     -- A volatile memory scratch array, which is allocated
 104     -- relative to the stack pointer.  It is an array of
 105     -- ptr/word/int sized things.  Do not expect to be preserved
 106     -- beyond basic blocks or over a ccall.  Current max size
 107     -- is 6, used in StixInteger.
 108
 109   | StScratchWord Int
 110
 111     -- Assembly-language comments
 112
 113   | StComment FAST_STRING
 114
 115 sStLitLbl :: FAST_STRING -> StixTree
 116 sStLitLbl s = StLitLbl (ptext s)
 117
 118
 119 pprStixTrees :: [StixTree] -> SDoc
 120 pprStixTrees ts
 121   = vcat [
 122        vcat (map ppStixTree ts),
 123        char ' ',
 124        char ' '
 125     ]
 126
 127 paren t = char '(' <> t <> char ')'
 128
 129 ppStixTree :: StixTree -> SDoc
 130 ppStixTree t
 131    = case t of
 132        StSegment cseg -> paren (ppCodeSegment cseg)
 133        StInt i        -> paren (integer i)
 134        StDouble rat   -> paren (text "Double" <+> rational rat)
 135        StString str   -> paren (text "Str" <+> ptext str)
 136        StComment str  -> paren (text "Comment" <+> ptext str)
 137        StLitLbl sd    -> sd
 138        StCLbl lbl     -> pprCLabel lbl
 139        StReg reg      -> ppStixReg reg
 140        StIndex k b o  -> paren (ppStixTree b <+> char '+' <>
 141                                 pprPrimRep k <+> ppStixTree o)
 142        StInd k t      -> pprPrimRep k <> char '[' <> ppStixTree t <> char ']'
 143        StAssign k d s -> ppStixTree d <> text "  :=" <> pprPrimRep k
 144                                           <> text "  " <> ppStixTree s
 145        StLabel ll     -> pprCLabel ll <+> char ':'
 146        StFunBegin ll  -> char ' ' $$ paren (text "FunBegin" <+> pprCLabel ll)
 147        StFunEnd ll    -> paren (text "FunEnd" <+> pprCLabel ll)
 148        StJump t       -> paren (text "Jump" <+> ppStixTree t)
 149        StFallThrough ll -> paren (text "FallThru" <+> pprCLabel ll)
 150        StCondJump l t -> paren (text "JumpC" <+> pprCLabel l <+> ppStixTree t)
 151        StData k ds -> paren (text "Data" <+> pprPrimRep k <+>
 152                       hsep (map ppStixTree ds))
 153        StPrim op ts -> paren (text "Prim" <+> pprPrimOp op <+> hsep (map ppStixTree ts))
 154        StCall nm cc k args
 155           -> paren (text "Call" <+> ptext nm <+>
 156                pprCallConv cc <+> pprPrimRep k <+> hsep (map ppStixTree args))
 157        StScratchWord i -> text "ScratchWord" <> paren (int i)
 158
 159 pprPrimRep = text . showPrimRep
 160 \end{code}
 161
 162 Stix registers can have two forms.  They {\em may} or {\em may not}
 163 map to real, machine-level registers.
 164
 165 \begin{code}
 166 data StixReg
 167   = StixMagicId MagicId -- Regs which are part of the abstract machine model
 168
 169   | StixTemp Unique PrimRep -- "Regs" which model local variables (CTemps) in
 170                                         -- the abstract C.
 171
 172 ppStixReg (StixMagicId mid)
 173    = ppMId mid
 174 ppStixReg (StixTemp u pr)
 175    = hcat [text "Temp(", ppr u, ppr pr, char ')']
 176
 177
 178 ppMId BaseReg              = text "BaseReg"
 179 ppMId (VanillaReg kind n)  = hcat [pprPrimRep kind, text "IntReg(", int (I# n), char ')']
 180 ppMId (FloatReg n)         = hcat [text "FltReg(", int (I# n), char ')']
 181 ppMId (DoubleReg n)        = hcat [text "DblReg(", int (I# n), char ')']
 182 ppMId (LongReg kind n)     = hcat [pprPrimRep kind, text "LongReg(", int (I# n), char ')']
 183 ppMId Sp                   = text "Sp"
 184 ppMId Su                   = text "Su"
 185 ppMId SpLim                = text "SpLim"
 186 ppMId Hp                   = text "Hp"
 187 ppMId HpLim                = text "HpLim"
 188 ppMId CurCostCentre        = text "CCC"
 189 ppMId VoidReg              = text "VoidReg"
 190 \end{code}
 191
 192 We hope that every machine supports the idea of data segment and text
 193 segment (or that it has no segments at all, and we can lump these
 194 together).
 195
 196 \begin{code}
 197 data CodeSegment = DataSegment | TextSegment deriving (Eq, Show)
 198 ppCodeSegment = text . show
 199
 200 type StixTreeList = [StixTree] -> [StixTree]
 201 \end{code}
 202
 203 Stix Trees for STG registers:
 204 \begin{code}
 205 stgBaseReg, stgNode, stgSp, stgSu, stgSpLim, stgHp, stgHpLim
 206         :: StixTree
 207
 208 stgBaseReg          = StReg (StixMagicId BaseReg)
 209 stgNode             = StReg (StixMagicId node)
 210 stgTagReg           = StReg (StixMagicId tagreg)
 211 stgSp               = StReg (StixMagicId Sp)
 212 stgSu               = StReg (StixMagicId Su)
 213 stgSpLim            = StReg (StixMagicId SpLim)
 214 stgHp               = StReg (StixMagicId Hp)
 215 stgHpLim            = StReg (StixMagicId HpLim)
 216 stgR9               = StReg (StixMagicId (VanillaReg WordRep ILIT(9)))
 217 stgR10              = StReg (StixMagicId (VanillaReg WordRep ILIT(10)))
 218
 219 getUniqLabelNCG :: UniqSM CLabel
 220 getUniqLabelNCG
 221   = getUniqueUs       `thenUs` \ u ->
 222     returnUs (mkAsmTempLabel u)
 223
 224 fixedHS     = StInt (toInteger fixedHdrSize)
 225 arrWordsHS  = StInt (toInteger arrWordsHdrSize)
 226 arrPtrsHS   = StInt (toInteger arrPtrsHdrSize)
 227 \end{code}