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 #include "../includes/config.h"
  10
  11 import AbsCSyn          ( AbstractC(..), Liveness(..) )
  12 import CLabel           ( CLabel )
  13 import StgSyn           ( SRT(..) )
  14 import ClosureInfo      ( closurePtrsSize,
  15                           closureNonHdrSize, closureSMRep,
  16                           infoTableLabelFromCI,
  17                           infoTblNeedsSRT, getSRTInfo
  18                         )
  19 import PrimRep          ( PrimRep(..) )
  20 import SMRep            ( SMRep(..), getSMRepClosureTypeInt )
  21 import Stix             -- all of it
  22 import UniqSupply       ( returnUs, UniqSM )
  23 import Outputable       ( int )
  24 import BitSet           ( intBS )
  25
  26 import Bits
  27 import Word
  28
  29 #if __GLASGOW_HASKELL__ >= 404
  30 import GlaExts          ( fromInt )
  31 #endif
  32 \end{code}
  33
  34 Generating code for info tables (arrays of data).
  35
  36 \begin{code}
  37 genCodeInfoTable
  38     :: AbstractC
  39     -> UniqSM StixTreeList
  40
  41 genCodeInfoTable (CClosureInfoAndCode cl_info _ _ cl_descr)
  42   = returnUs (\xs -> StData PtrRep table : StLabel info_lbl : xs)
  43
  44     where
  45         info_lbl  = infoTableLabelFromCI cl_info
  46         needs_srt = infoTblNeedsSRT cl_info
  47
  48         table | needs_srt = srt_label : rest_of_table
  49               | otherwise = rest_of_table
  50
  51         rest_of_table =
  52                 [
  53                 {- par, prof, debug -}
  54                   StInt (toInteger layout_info)
  55                 , StInt (toInteger type_info)
  56                 ]
  57
  58         -- sigh: building up the info table is endian-dependent.
  59         -- ToDo: do this using .byte and .word directives.
  60         type_info :: Word32
  61 #ifdef WORDS_BIGENDIAN
  62         type_info = (fromInt flags `shiftL` 24) .|.
  63                     (fromInt closure_type `shiftL` 16) .|.
  64                     (fromInt srt_len)
  65 #else
  66         type_info = (fromInt flags) .|.
  67                     (fromInt closure_type `shiftL` 8) .|.
  68                     (fromInt srt_len `shiftL` 16)
  69 #endif
  70         srt = getSRTInfo cl_info
  71
  72         (srt_label,srt_len)
  73            | needs_srt
  74            = case srt of
  75                 (lbl, SRT off len) ->
  76                         (StIndex DataPtrRep (StCLbl lbl)
  77                                 (StInt (toInteger off)), len)
  78            | otherwise
  79            = (StInt 0, 0)
  80
  81         layout_info :: Word32
  82 #ifdef WORDS_BIGENDIAN
  83         layout_info = (fromInt ptrs `shiftL` 16) .|. fromInt nptrs
  84 #else
  85         layout_info = (fromInt ptrs) .|. (fromInt nptrs `shiftL` 16)
  86 #endif
  87
  88         ptrs    = closurePtrsSize cl_info
  89         nptrs   = size - ptrs
  90
  91         size = closureNonHdrSize cl_info
  92
  93         closure_type = getSMRepClosureTypeInt (closureSMRep cl_info)
  94
  95         flags = 0 -- for now
  96
  97
  98 genBitmapInfoTable
  99         :: Liveness
 100         -> (CLabel, SRT)
 101         -> Int
 102         -> Bool                 -- must include SRT field (i.e. it's a vector)
 103         -> UniqSM StixTreeList
 104
 105 genBitmapInfoTable liveness srt closure_type include_srt
 106   = returnUs (\xs -> StData PtrRep table : xs)
 107
 108   where
 109         table = if srt_len == 0 && not include_srt then
 110                    rest_of_table
 111                 else
 112                    srt_label : rest_of_table
 113
 114         rest_of_table =
 115                 [
 116                 {- par, prof, debug -}
 117                   layout_info
 118                 , StInt (toInteger type_info)
 119                 ]
 120
 121         layout_info = case liveness of
 122                         LvSmall mask -> StInt (toInteger (intBS mask))
 123                         LvLarge lbl  -> StCLbl lbl
 124
 125         type_info :: Word32
 126 #ifdef WORDS_BIGENDIAN
 127         type_info = (fromInt flags `shiftL` 24) .|.
 128                     (fromInt closure_type `shiftL` 16) .|.
 129                     (fromInt srt_len)
 130 #else
 131         type_info = (fromInt flags) .|.
 132                     (fromInt closure_type `shiftL` 8) .|.
 133                     (fromInt srt_len `shiftL` 16)
 134 #endif
 135
 136         (srt_label,srt_len) =
 137              case srt of
 138                 (lbl, NoSRT) -> (StInt 0, 0)
 139                 (lbl, SRT off len) ->
 140                         (StIndex DataPtrRep (StCLbl lbl)
 141                                 (StInt (toInteger off)), len)
 142
 143         flags = 0 -- for now
 144 \end{code}