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