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
  47         table | infoTblNeedsSRT cl_info = srt_label : rest_of_table
  48               | otherwise               = rest_of_table
  49
  50         rest_of_table =
  51                 [
  52                 {- par, prof, debug -}
  53                   StInt (toInteger layout_info)
  54                 , StInt (toInteger type_info)
  55                 ]
  56
  57         -- sigh: building up the info table is endian-dependent.
  58         -- ToDo: do this using .byte and .word directives.
  59         type_info :: Word32
  60 #ifdef WORDS_BIGENDIAN
  61         type_info = (fromInt flags `shiftL` 24) .|.
  62                     (fromInt closure_type `shiftL` 16) .|.
  63                     (fromInt srt_len)
  64 #else
  65         type_info = (fromInt flags) .|.
  66                     (fromInt closure_type `shiftL` 8) .|.
  67                     (fromInt srt_len `shiftL` 16)
  68 #endif
  69         srt = getSRTInfo cl_info
  70
  71         (srt_label,srt_len) =
  72              case srt of
  73                 (lbl, NoSRT) -> (StInt 0, 0)
  74                 (lbl, SRT off len) ->
  75                         (StIndex DataPtrRep (StCLbl lbl)
  76                                 (StInt (toInteger off)), len)
  77
  78         layout_info :: Word32
  79 #ifdef WORDS_BIGENDIAN
  80         layout_info = (fromInt ptrs `shiftL` 16) .|. fromInt nptrs
  81 #else
  82         layout_info = (fromInt ptrs) .|. (fromInt nptrs `shiftL` 16)
  83 #endif
  84
  85         ptrs    = closurePtrsSize cl_info
  86         nptrs   = size - ptrs
  87
  88         size = closureNonHdrSize cl_info
  89
  90         closure_type = getSMRepClosureTypeInt (closureSMRep cl_info)
  91
  92         flags = 0 -- for now
  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 flags `shiftL` 24) .|.
 125                     (fromInt closure_type `shiftL` 16) .|.
 126                     (fromInt srt_len)
 127 #else
 128         type_info = (fromInt flags) .|.
 129                     (fromInt closure_type `shiftL` 8) .|.
 130                     (fromInt srt_len `shiftL` 16)
 131 #endif
 132
 133         (srt_label,srt_len) =
 134              case srt of
 135                 (lbl, NoSRT) -> (StInt 0, 0)
 136                 (lbl, SRT off len) ->
 137                         (StIndex DataPtrRep (StCLbl lbl)
 138                                 (StInt (toInteger off)), len)
 139
 140         flags = 0 -- for now
 141 \end{code}