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, closureSemiTag
  18                         )
  19 import PrimRep          ( PrimRep(..) )
  20 import SMRep            ( getSMRepClosureTypeInt )
  21 import Stix             -- all of it
  22 import UniqSupply       ( returnUs, UniqSM )
  23 import BitSet           ( intBS )
  24 import Maybes           ( maybeToBool )
  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            | is_constr
  72            = (StInt 0, tag)
  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         maybe_tag = closureSemiTag cl_info
  82         is_constr = maybeToBool maybe_tag
  83         (Just tag) = maybe_tag
  84
  85         layout_info :: Word32
  86 #ifdef WORDS_BIGENDIAN
  87         layout_info = (fromInt ptrs `shiftL` 16) .|. fromInt nptrs
  88 #else
  89         layout_info = (fromInt ptrs) .|. (fromInt nptrs `shiftL` 16)
  90 #endif
  91
  92         ptrs    = closurePtrsSize cl_info
  93         nptrs   = size - ptrs
  94
  95         size = closureNonHdrSize cl_info
  96
  97         closure_type = getSMRepClosureTypeInt (closureSMRep cl_info)
  98
  99
 100
 101 genBitmapInfoTable
 102         :: Liveness
 103         -> (CLabel, SRT)
 104         -> Int
 105         -> Bool                 -- must include SRT field (i.e. it's a vector)
 106         -> UniqSM StixTreeList
 107
 108 genBitmapInfoTable liveness srt closure_type include_srt
 109   = returnUs (\xs -> StData PtrRep table : xs)
 110
 111   where
 112         table = if srt_len == 0 && not include_srt then
 113                    rest_of_table
 114                 else
 115                    srt_label : rest_of_table
 116
 117         rest_of_table =
 118                 [
 119                 {- par, prof, debug -}
 120                   layout_info
 121                 , StInt (toInteger type_info)
 122                 ]
 123
 124         layout_info = case liveness of
 125                         LvSmall mask -> StInt (toInteger (intBS mask))
 126                         LvLarge lbl  -> StCLbl lbl
 127
 128         type_info :: Word32
 129 #ifdef WORDS_BIGENDIAN
 130         type_info = (fromInt closure_type `shiftL` 16) .|.
 131                     (fromInt srt_len)
 132 #else
 133         type_info = (fromInt closure_type) .|.
 134                     (fromInt srt_len `shiftL` 16)
 135 #endif
 136
 137         (srt_label,srt_len) =
 138              case srt of
 139                 (lbl, NoSRT) -> (StInt 0, 0)
 140                 (lbl, SRT off len) ->
 141                         (StIndex DataPtrRep (StCLbl lbl)
 142                                 (StInt (toInteger off)), len)
 143 \end{code}