module StixInfo ( genCodeInfoTable, genBitmapInfoTable ) where
#include "HsVersions.h"
+#include "../includes/config.h"
import AbsCSyn ( AbstractC(..), Liveness(..) )
import CLabel ( CLabel )
import StgSyn ( SRT(..) )
import ClosureInfo ( closurePtrsSize,
closureNonHdrSize, closureSMRep,
- infoTableLabelFromCI
+ infoTableLabelFromCI,
+ infoTblNeedsSRT, getSRTInfo, closureSemiTag
)
import PrimRep ( PrimRep(..) )
import SMRep ( SMRep(..), getSMRepClosureTypeInt )
import Stix -- all of it
import UniqSupply ( returnUs, UniqSM )
-import Outputable ( int )
import BitSet ( intBS )
+import Maybes ( maybeToBool )
import Bits
import Word
+
+#if __GLASGOW_HASKELL__ >= 404
+import GlaExts ( fromInt )
+#endif
\end{code}
Generating code for info tables (arrays of data).
:: AbstractC
-> UniqSM StixTreeList
-genCodeInfoTable (CClosureInfoAndCode cl_info _ _ srt cl_descr)
+genCodeInfoTable (CClosureInfoAndCode cl_info _ _ cl_descr)
= returnUs (\xs -> StData PtrRep table : StLabel info_lbl : xs)
where
- info_lbl = infoTableLabelFromCI cl_info
+ info_lbl = infoTableLabelFromCI cl_info
+ needs_srt = infoTblNeedsSRT cl_info
- table = case srt_len of
- 0 -> rest_of_table
- _ -> srt_label : rest_of_table
+ table | needs_srt = srt_label : rest_of_table
+ | otherwise = rest_of_table
rest_of_table =
[
, StInt (toInteger type_info)
]
+ -- sigh: building up the info table is endian-dependent.
+ -- ToDo: do this using .byte and .word directives.
type_info :: Word32
- type_info = (fromInt flags `shiftL` 24) .|.
- (fromInt closure_type `shiftL` 16) .|.
+#ifdef WORDS_BIGENDIAN
+ type_info = (fromInt closure_type `shiftL` 16) .|.
(fromInt srt_len)
-
- (srt_label,srt_len) =
- case srt of
- (lbl, NoSRT) -> (StInt 0, 0)
+#else
+ type_info = (fromInt closure_type) .|.
+ (fromInt srt_len `shiftL` 16)
+#endif
+ srt = getSRTInfo cl_info
+
+ (srt_label,srt_len)
+ | is_constr
+ = (StInt 0, tag)
+ | needs_srt
+ = case srt of
(lbl, SRT off len) ->
(StIndex DataPtrRep (StCLbl lbl)
(StInt (toInteger off)), len)
+ | otherwise
+ = (StInt 0, 0)
+
+ maybe_tag = closureSemiTag cl_info
+ is_constr = maybeToBool maybe_tag
+ (Just tag) = maybe_tag
layout_info :: Word32
+#ifdef WORDS_BIGENDIAN
layout_info = (fromInt ptrs `shiftL` 16) .|. fromInt nptrs
+#else
+ layout_info = (fromInt ptrs) .|. (fromInt nptrs `shiftL` 16)
+#endif
ptrs = closurePtrsSize cl_info
nptrs = size - ptrs
closure_type = getSMRepClosureTypeInt (closureSMRep cl_info)
- flags = 0 -- for now
genBitmapInfoTable
LvLarge lbl -> StCLbl lbl
type_info :: Word32
- type_info = (fromInt flags `shiftL` 24) .|.
- (fromInt closure_type `shiftL` 16) .|.
+#ifdef WORDS_BIGENDIAN
+ type_info = (fromInt closure_type `shiftL` 16) .|.
(fromInt srt_len)
-
+#else
+ type_info = (fromInt closure_type) .|.
+ (fromInt srt_len `shiftL` 16)
+#endif
+
(srt_label,srt_len) =
case srt of
(lbl, NoSRT) -> (StInt 0, 0)
(lbl, SRT off len) ->
(StIndex DataPtrRep (StCLbl lbl)
(StInt (toInteger off)), len)
-
- flags = 0 -- for now
\end{code}