ghc/compiler/nativeGen/AlphaDesc.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1995
   3 %
   4 \section[AlphaDesc]{The Alpha Machine Description}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module AlphaDesc (
  10         mkAlpha,
  11
  12         -- and assorted nonsense referenced by the class methods
  13
  14         PprStyle, SMRep, MagicId, RegLoc, StixTree, PrimKind, SwitchResult
  15
  16     ) where
  17
  18 import AbsCSyn
  19 import AbsPrel          ( PrimOp(..)
  20                           IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
  21                           IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
  22                         )
  23 import AsmRegAlloc      ( Reg, MachineCode(..), MachineRegisters(..),
  24                           RegUsage(..), RegLiveness(..), FutureLive(..)
  25                         )
  26 import CLabelInfo       ( CLabel )
  27 import CmdLineOpts      ( GlobalSwitch(..), stringSwitchSet,
  28                           switchIsOn, SwitchResult(..)
  29                         )
  30 import HeapOffs         ( hpRelToInt )
  31 import MachDesc
  32 import Maybes           ( Maybe(..) )
  33 import OrdList
  34 import Outputable
  35 import PrimKind         ( PrimKind(..) )
  36 import SMRep            ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
  37 import AlphaCode
  38 import AlphaGen         ( alphaCodeGen )
  39 import Stix
  40 import StixMacro
  41 import StixPrim
  42 import SplitUniq
  43 import Unique
  44 import Util
  45
  46 \end{code}
  47
  48 Header sizes depend only on command-line options, not on the target
  49 architecture.  (I think.)
  50
  51 \begin{code}
  52
  53 fhs :: (GlobalSwitch -> SwitchResult) -> Int
  54
  55 fhs switches = 1 + profFHS + ageFHS
  56   where
  57     profFHS = if switchIsOn switches SccProfilingOn then 1 else 0
  58     ageFHS  = if switchIsOn switches SccProfilingOn then 1 else 0
  59
  60 vhs :: (GlobalSwitch -> SwitchResult) -> SMRep -> Int
  61
  62 vhs switches sm = case sm of
  63     StaticRep _ _          -> 0
  64     SpecialisedRep _ _ _ _ -> 0
  65     GenericRep _ _ _       -> 0
  66     BigTupleRep _          -> 1
  67     MuTupleRep _           -> 2 {- (1 + GC_MUT_RESERVED_WORDS) -}
  68     DataRep _              -> 1
  69     DynamicRep             -> 2
  70     BlackHoleRep           -> 0
  71     PhantomRep             -> panic "vhs:phantom"
  72
  73 \end{code}
  74
  75 Here we map STG registers onto appropriate Stix Trees.  First, we
  76 handle the two constants, @STK_STUB_closure@ and @vtbl_StdUpdFrame@.
  77 The rest are either in real machine registers or stored as offsets
  78 from BaseReg.
  79
  80 \begin{code}
  81
  82 alphaReg :: (GlobalSwitch -> SwitchResult) -> MagicId -> RegLoc
  83
  84 alphaReg switches x =
  85     case stgRegMap x of
  86         Just reg -> Save nonReg
  87         Nothing -> Always nonReg
  88     where nonReg = case x of
  89             StkStubReg -> sStLitLbl SLIT("STK_STUB_closure")
  90             StdUpdRetVecReg -> sStLitLbl SLIT("vtbl_StdUpdFrame")
  91             BaseReg -> sStLitLbl SLIT("MainRegTable")
  92             Hp -> StInd PtrKind (sStLitLbl SLIT("StorageMgrInfo"))
  93             HpLim -> StInd PtrKind (sStLitLbl SLIT("StorageMgrInfo+8"))
  94             TagReg -> StInd IntKind (StPrim IntSubOp [infoptr, StInt (1*8)])
  95                       where
  96                           r2 = VanillaReg PtrKind ILIT(2)
  97                           infoptr = case alphaReg switches r2 of
  98                                         Always tree -> tree
  99                                         Save _ -> StReg (StixMagicId r2)
 100             _ -> StInd (kindFromMagicId x)
 101                        (StPrim IntAddOp [baseLoc, StInt (toInteger (offset*8))])
 102           baseLoc = case stgRegMap BaseReg of
 103             Just _ -> StReg (StixMagicId BaseReg)
 104             Nothing -> sStLitLbl SLIT("MainRegTable")
 105           offset = baseRegOffset x
 106
 107 \end{code}
 108
 109 Sizes in bytes.
 110
 111 \begin{code}
 112
 113 size pk = case kindToSize pk of
 114     {B -> 1; BU -> 1; W -> 2; WU -> 2; L -> 4; FF -> 4; SF -> 4; _ -> 8}
 115
 116 \end{code}
 117
 118 Now the volatile saves and restores.  We add the basic guys to the list of ``user''
 119 registers provided.  Note that there are more basic registers on the restore list,
 120 because some are reloaded from constants.
 121
 122 \begin{code}
 123
 124 vsaves switches vols =
 125     map save ((filter callerSaves) ([BaseReg,SpA,SuA,SpB,SuB,Hp,HpLim,RetReg,ActivityReg] ++ vols))
 126     where
 127         save x = StAssign (kindFromMagicId x) loc reg
 128                     where reg = StReg (StixMagicId x)
 129                           loc = case alphaReg switches x of
 130                                     Save loc -> loc
 131                                     Always loc -> panic "vsaves"
 132
 133 vrests switches vols =
 134     map restore ((filter callerSaves)
 135         ([BaseReg,SpA,SuA,SpB,SuB,Hp,HpLim,RetReg,ActivityReg,StkStubReg,StdUpdRetVecReg] ++ vols))
 136     where
 137         restore x = StAssign (kindFromMagicId x) reg loc
 138                     where reg = StReg (StixMagicId x)
 139                           loc = case alphaReg switches x of
 140                                     Save loc -> loc
 141                                     Always loc -> panic "vrests"
 142
 143 \end{code}
 144
 145 Static closure sizes.
 146
 147 \begin{code}
 148
 149 charLikeSize, intLikeSize :: Target -> Int
 150
 151 charLikeSize target =
 152     size PtrKind * (fixedHeaderSize target + varHeaderSize target charLikeRep + 1)
 153     where charLikeRep = SpecialisedRep CharLikeRep 0 1 SMNormalForm
 154
 155 intLikeSize target =
 156     size PtrKind * (fixedHeaderSize target + varHeaderSize target intLikeRep + 1)
 157     where intLikeRep = SpecialisedRep IntLikeRep 0 1 SMNormalForm
 158
 159 mhs, dhs :: (GlobalSwitch -> SwitchResult) -> StixTree
 160
 161 mhs switches = StInt (toInteger words)
 162   where
 163     words = fhs switches + vhs switches (MuTupleRep 0)
 164
 165 dhs switches = StInt (toInteger words)
 166   where
 167     words = fhs switches + vhs switches (DataRep 0)
 168
 169 \end{code}
 170
 171 Setting up a alpha target.
 172
 173 \begin{code}
 174
 175 mkAlpha :: (GlobalSwitch -> SwitchResult) -> Target
 176
 177 mkAlpha switches =
 178     let fhs' = fhs switches
 179         vhs' = vhs switches
 180         alphaReg' = alphaReg switches
 181         vsaves' = vsaves switches
 182         vrests' = vrests switches
 183         hprel = hpRelToInt target
 184         as = amodeCode target
 185         as' = amodeCode' target
 186         csz = charLikeSize target
 187         isz = intLikeSize target
 188         mhs' = mhs switches
 189         dhs' = dhs switches
 190         ps = genPrimCode target
 191         mc = genMacroCode target
 192         hc = doHeapCheck target
 193         target = mkTarget switches fhs' vhs' alphaReg' id size vsaves' vrests'
 194                           hprel as as' csz isz mhs' dhs' ps mc hc
 195                           alphaCodeGen False mungeLabel
 196     in target
 197
 198 \end{code}
 199
 200 The alpha assembler likes temporary labels to look like \tr{$L123}
 201 instead of \tr{L123}.  (Don't toss the \tr{L}, because then \tr{Lf28}
 202 turns into \tr{$f28}.)
 203 \begin{code}
 204 mungeLabel :: String -> String
 205 mungeLabel xs = '$' : xs
 206 \end{code}