ghc/compiler/nativeGen/StixInfo.lhs

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