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