ghc/compiler/nativeGen/StixInfo.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1993-1998
   3 %
   4
   5 \begin{code}
   6 module StixInfo ( genCodeInfoTable, genBitmapInfoTable ) where
   7
   8 #include "HsVersions.h"
   9
  10 import AbsCSyn          ( AbstractC(..), Liveness(..) )
  11 import CLabel           ( CLabel )
  12 import StgSyn           ( SRT(..) )
  13 import ClosureInfo      ( closurePtrsSize,
  14                           closureNonHdrSize, closureSMRep,
  15                           infoTableLabelFromCI
  16                         )
  17 import PrimRep          ( PrimRep(..) )
  18 import SMRep            ( SMRep(..), getSMRepClosureTypeInt )
  19 import Stix             -- all of it
  20 import UniqSupply       ( returnUs, UniqSM )
  21 import Outputable       ( int )
  22 import BitSet           ( intBS )
  23
  24 import Bits
  25 import Word
  26 \end{code}
  27
  28 Generating code for info tables (arrays of data).
  29
  30 \begin{code}
  31 genCodeInfoTable
  32     :: AbstractC
  33     -> UniqSM StixTreeList
  34
  35 genCodeInfoTable (CClosureInfoAndCode cl_info _ _ srt cl_descr)
  36   = returnUs (\xs -> StData PtrRep table : StLabel info_lbl : xs)
  37
  38     where
  39         info_lbl = infoTableLabelFromCI cl_info
  40
  41         table = case srt_len of
  42                    0 -> rest_of_table
  43                    _ -> srt_label : rest_of_table
  44
  45         rest_of_table =
  46                 [
  47                 {- par, prof, debug -}
  48                   StInt (toInteger layout_info)
  49                 , StInt (toInteger type_info)
  50                 ]
  51
  52         type_info :: Word32
  53         type_info = (fromInt flags `shiftL` 24) .|.
  54                     (fromInt closure_type `shiftL` 16) .|.
  55                     (fromInt srt_len)
  56
  57         (srt_label,srt_len) =
  58              case srt of
  59                 (lbl, NoSRT) -> (StInt 0, 0)
  60                 (lbl, SRT off len) ->
  61                         (StIndex DataPtrRep (StCLbl lbl)
  62                                 (StInt (toInteger off)), len)
  63
  64         layout_info :: Word32
  65         layout_info = (fromInt ptrs `shiftL` 16) .|. fromInt nptrs
  66
  67         ptrs    = closurePtrsSize cl_info
  68         nptrs   = size - ptrs
  69
  70         size = closureNonHdrSize cl_info
  71
  72         closure_type = getSMRepClosureTypeInt (closureSMRep cl_info)
  73
  74         flags = 0 -- for now
  75
  76
  77 genBitmapInfoTable
  78         :: Liveness
  79         -> (CLabel, SRT)
  80         -> Int
  81         -> Bool                 -- must include SRT field (i.e. it's a vector)
  82         -> UniqSM StixTreeList
  83
  84 genBitmapInfoTable liveness srt closure_type include_srt
  85   = returnUs (\xs -> StData PtrRep table : xs)
  86
  87   where
  88         table = if srt_len == 0 && not include_srt then
  89                    rest_of_table
  90                 else
  91                    srt_label : rest_of_table
  92
  93         rest_of_table =
  94                 [
  95                 {- par, prof, debug -}
  96                   layout_info
  97                 , StInt (toInteger type_info)
  98                 ]
  99
 100         layout_info = case liveness of
 101                         LvSmall mask -> StInt (toInteger (intBS mask))
 102                         LvLarge lbl  -> StCLbl lbl
 103
 104         type_info :: Word32
 105         type_info = (fromInt flags `shiftL` 24) .|.
 106                     (fromInt closure_type `shiftL` 16) .|.
 107                     (fromInt srt_len)
 108
 109         (srt_label,srt_len) =
 110              case srt of
 111                 (lbl, NoSRT) -> (StInt 0, 0)
 112                 (lbl, SRT off len) ->
 113                         (StIndex DataPtrRep (StCLbl lbl)
 114                                 (StInt (toInteger off)), len)
 115
 116         flags = 0 -- for now
 117 \end{code}