ghc/compiler/nativeGen/I386Desc.lhs

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