[project @ 2000-12-19 17:32:44 by simonpj]

[ghc-hetmet.git] / ghc / compiler / nativeGen / StixInfo.lhs

diff --git a/ghc/compiler/nativeGen/StixInfo.lhs b/ghc/compiler/nativeGen/StixInfo.lhs
index b59aa89..bb26435 100644 (file)
--- a/ghc/compiler/nativeGen/StixInfo.lhs
+++ b/ghc/compiler/nativeGen/StixInfo.lhs
@@ -6,23 +6,29 @@
 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 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).
@@ -32,15 +38,15 @@ genCodeInfoTable
     :: 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 = 
                [
@@ -49,20 +55,39 @@ genCodeInfoTable (CClosureInfoAndCode cl_info _ _ srt cl_descr)
                , 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
@@ -71,7 +96,6 @@ genCodeInfoTable (CClosureInfoAndCode cl_info _ _ srt cl_descr)
 
        closure_type = getSMRepClosureTypeInt (closureSMRep cl_info)
 
-       flags = 0 -- for now
 
 
 genBitmapInfoTable
@@ -102,16 +126,18 @@ genBitmapInfoTable liveness srt closure_type include_srt
                        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}