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     -> AbstractC
  42     -> SUniqSM StixTreeList
  43
  44 genCodeInfoTable target (CClosureInfoAndCode cl_info _ _ upd cl_descr) =
  45     returnSUs (\xs -> info : lbl : xs)
  46
  47     where
  48         info = StData PtrKind table
  49         lbl = StLabel info_lbl
  50
  51         table = case sm_rep of
  52             StaticRep _ _ -> [
  53                 StInt (toInteger ptrs),
  54                 StInt (toInteger size),
  55                 upd_code,
  56                 static___rtbl,
  57                 tag]
  58
  59             SpecialisedRep ConstantRep _ _ _ -> [
  60                 StCLbl closure_lbl,
  61                 upd_code,
  62                 const___rtbl,
  63                 tag]
  64
  65             SpecialisedRep CharLikeRep _ _ _ -> [
  66                 upd_code,
  67                 charlike___rtbl,
  68                 tag]
  69
  70             SpecialisedRep IntLikeRep _ _ _ -> [
  71                 upd_code,
  72                 intlike___rtbl,
  73                 tag]
  74
  75             SpecialisedRep _ _ _ updatable ->
  76                 let rtbl = uppBesides (
  77                        if is_selector then
  78                           [uppPStr SLIT("Select__"),
  79                            uppInt select_word,
  80                            uppPStr SLIT("_rtbl")]
  81                        else
  82                           [uppPStr (case updatable of
  83                                     SMNormalForm -> SLIT("Spec_N_")
  84                                     SMSingleEntry -> SLIT("Spec_S_")
  85                                     SMUpdatable -> SLIT("Spec_U_")
  86                                    ),
  87                            uppInt size,
  88                            uppChar '_',
  89                            uppInt ptrs,
  90                            uppPStr SLIT("_rtbl")])
  91                 in
  92                     case updatable of
  93                         SMNormalForm -> [upd_code, StLitLbl rtbl, tag]
  94                         _            -> [StLitLbl rtbl, tag]
  95
  96             GenericRep _ _ updatable ->
  97                 let rtbl = case updatable of
  98                             SMNormalForm  -> gen_N___rtbl
  99                             SMSingleEntry -> gen_S___rtbl
 100                             SMUpdatable   -> gen_U___rtbl
 101                 in [
 102                     StInt (toInteger ptrs),
 103                     StInt (toInteger size),
 104                     upd_code,
 105                     rtbl,
 106                     tag]
 107
 108             BigTupleRep _ -> [
 109                 tuple___rtbl,
 110                 tag]
 111             DataRep _     -> [
 112                 data___rtbl,
 113                 tag]
 114             DynamicRep    -> [
 115                 dyn___rtbl,
 116                 tag]
 117
 118             PhantomRep -> [
 119                 upd_code,
 120                 info_unused,    -- no rep table
 121                 tag]
 122
 123         info_lbl        = infoTableLabelFromCI cl_info
 124         closure_lbl     = closureLabelFromCI   cl_info
 125
 126         sm_rep  = closureSMRep cl_info
 127         maybe_selector = maybeSelectorInfo cl_info
 128         is_selector = maybeToBool maybe_selector
 129         (Just (_, select_word)) = maybe_selector
 130
 131         tag = StInt (toInteger (closureSemiTag cl_info))
 132
 133         size    = if isSpecRep sm_rep
 134                   then closureNonHdrSize cl_info
 135                   else hpRel target (closureSizeWithoutFixedHdr cl_info)
 136         ptrs    = closurePtrsSize cl_info
 137
 138         upd_code = amodeToStix target upd
 139
 140         info_unused = StInt (-1)
 141
 142 \end{code}