ghc/compiler/nativeGen/StixInfo.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1993-1995
   3 %
   4
   5 \begin{code}
   6 #include "HsVersions.h"
   7
   8 module StixInfo (
   9         genCodeInfoTable
  10     ) where
  11
  12 import AbsCSyn
  13 import ClosureInfo
  14 import MachDesc
  15 import Maybes           ( maybeToBool, Maybe(..) )
  16 import SMRep            ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
  17 import Stix
  18 import SplitUniq
  19 import Unique
  20 import Unpretty
  21 import Util
  22
  23 \end{code}
  24
  25 Generating code for info tables (arrays of data).
  26
  27 \begin{code}
  28 static___rtbl   = sStLitLbl SLIT("Static___rtbl") -- out here to avoid CAF (sigh)
  29 const___rtbl    = sStLitLbl SLIT("Const___rtbl")
  30 charlike___rtbl = sStLitLbl SLIT("CharLike___rtbl")
  31 intlike___rtbl  = sStLitLbl SLIT("IntLike___rtbl")
  32 gen_N___rtbl    = sStLitLbl SLIT("Gen_N___rtbl")
  33 gen_S___rtbl    = sStLitLbl SLIT("Gen_S___rtbl")
  34 gen_U___rtbl    = sStLitLbl SLIT("Gen_U___rtbl")
  35 tuple___rtbl    = sStLitLbl SLIT("Tuple___rtbl")
  36 data___rtbl     = sStLitLbl SLIT("Data___rtbl")
  37 dyn___rtbl      = sStLitLbl SLIT("Dyn___rtbl")
  38
  39 genCodeInfoTable
  40     :: {-Target-}
  41        (HeapOffset -> Int)      -- needed bit of Target
  42     -> (CAddrMode -> StixTree)  -- ditto
  43     -> AbstractC
  44     -> SUniqSM StixTreeList
  45
  46 genCodeInfoTable hp_rel amode2stix (CClosureInfoAndCode cl_info _ _ upd cl_descr _) =
  47     returnSUs (\xs -> info : lbl : xs)
  48
  49     where
  50         info = StData PtrKind table
  51         lbl = StLabel info_lbl
  52
  53         table = case sm_rep of
  54             StaticRep _ _ -> [
  55                 StInt (toInteger ptrs),
  56                 StInt (toInteger size),
  57                 upd_code,
  58                 static___rtbl,
  59                 tag]
  60
  61             SpecialisedRep ConstantRep _ _ _ -> [
  62                 StCLbl closure_lbl,
  63                 upd_code,
  64                 const___rtbl,
  65                 tag]
  66
  67             SpecialisedRep CharLikeRep _ _ _ -> [
  68                 upd_code,
  69                 charlike___rtbl,
  70                 tag]
  71
  72             SpecialisedRep IntLikeRep _ _ _ -> [
  73                 upd_code,
  74                 intlike___rtbl,
  75                 tag]
  76
  77             SpecialisedRep _ _ _ updatable ->
  78                 let rtbl = uppBesides (
  79                        if is_selector then
  80                           [uppPStr SLIT("Select__"),
  81                            uppInt select_word,
  82                            uppPStr SLIT("_rtbl")]
  83                        else
  84                           [uppPStr (case updatable of
  85                                     SMNormalForm -> SLIT("Spec_N_")
  86                                     SMSingleEntry -> SLIT("Spec_S_")
  87                                     SMUpdatable -> SLIT("Spec_U_")
  88                                    ),
  89                            uppInt size,
  90                            uppChar '_',
  91                            uppInt ptrs,
  92                            uppPStr SLIT("_rtbl")])
  93                 in
  94                     case updatable of
  95                         SMNormalForm -> [upd_code, StLitLbl rtbl, tag]
  96                         _            -> [StLitLbl rtbl, tag]
  97
  98             GenericRep _ _ updatable ->
  99                 let rtbl = case updatable of
 100                             SMNormalForm  -> gen_N___rtbl
 101                             SMSingleEntry -> gen_S___rtbl
 102                             SMUpdatable   -> gen_U___rtbl
 103                 in [
 104                     StInt (toInteger ptrs),
 105                     StInt (toInteger size),
 106                     upd_code,
 107                     rtbl,
 108                     tag]
 109
 110             BigTupleRep _ -> [
 111                 tuple___rtbl,
 112                 tag]
 113             DataRep _     -> [
 114                 data___rtbl,
 115                 tag]
 116             DynamicRep    -> [
 117                 dyn___rtbl,
 118                 tag]
 119
 120             PhantomRep -> [
 121                 upd_code,
 122                 info_unused,    -- no rep table
 123                 tag]
 124
 125         info_lbl        = infoTableLabelFromCI cl_info
 126         closure_lbl     = closureLabelFromCI   cl_info
 127
 128         sm_rep  = closureSMRep cl_info
 129         maybe_selector = maybeSelectorInfo cl_info
 130         is_selector = maybeToBool maybe_selector
 131         (Just (_, select_word)) = maybe_selector
 132
 133         tag = StInt (toInteger (closureSemiTag cl_info))
 134
 135         size    = if isSpecRep sm_rep
 136                   then closureNonHdrSize cl_info
 137                   else hp_rel (closureSizeWithoutFixedHdr cl_info)
 138         ptrs    = closurePtrsSize cl_info
 139
 140         upd_code = amode2stix upd
 141
 142         info_unused = StInt (-1)
 143
 144 \end{code}