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