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 closure_type `shiftL` 16) .|.
  63                     (fromInt srt_len)
  64 #else
  65         type_info = (fromInt closure_type) .|.
  66                     (fromInt srt_len `shiftL` 16)
  67 #endif
  68         srt = getSRTInfo cl_info
  69
  70         (srt_label,srt_len)
  71            | needs_srt
  72            = case srt of
  73                 (lbl, SRT off len) ->
  74                         (StIndex DataPtrRep (StCLbl lbl)
  75                                 (StInt (toInteger off)), len)
  76            | otherwise
  77            = (StInt 0, 0)
  78
  79         layout_info :: Word32
  80 #ifdef WORDS_BIGENDIAN
  81         layout_info = (fromInt ptrs `shiftL` 16) .|. fromInt nptrs
  82 #else
  83         layout_info = (fromInt ptrs) .|. (fromInt nptrs `shiftL` 16)
  84 #endif
  85
  86         ptrs    = closurePtrsSize cl_info
  87         nptrs   = size - ptrs
  88
  89         size = closureNonHdrSize cl_info
  90
  91         closure_type = getSMRepClosureTypeInt (closureSMRep cl_info)
  92
  93
  94
  95 genBitmapInfoTable
  96         :: Liveness
  97         -> (CLabel, SRT)
  98         -> Int
  99         -> Bool                 -- must include SRT field (i.e. it's a vector)
 100         -> UniqSM StixTreeList
 101
 102 genBitmapInfoTable liveness srt closure_type include_srt
 103   = returnUs (\xs -> StData PtrRep table : xs)
 104
 105   where
 106         table = if srt_len == 0 && not include_srt then
 107                    rest_of_table
 108                 else
 109                    srt_label : rest_of_table
 110
 111         rest_of_table =
 112                 [
 113                 {- par, prof, debug -}
 114                   layout_info
 115                 , StInt (toInteger type_info)
 116                 ]
 117
 118         layout_info = case liveness of
 119                         LvSmall mask -> StInt (toInteger (intBS mask))
 120                         LvLarge lbl  -> StCLbl lbl
 121
 122         type_info :: Word32
 123 #ifdef WORDS_BIGENDIAN
 124         type_info = (fromInt closure_type `shiftL` 16) .|.
 125                     (fromInt srt_len)
 126 #else
 127         type_info = (fromInt closure_type) .|.
 128                     (fromInt srt_len `shiftL` 16)
 129 #endif
 130
 131         (srt_label,srt_len) =
 132              case srt of
 133                 (lbl, NoSRT) -> (StInt 0, 0)
 134                 (lbl, SRT off len) ->
 135                         (StIndex DataPtrRep (StCLbl lbl)
 136                                 (StInt (toInteger off)), len)
 137 \end{code}