[project @ 2001-03-28 16:51:02 by simonmar]

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

diff --git a/ghc/compiler/nativeGen/Stix.lhs b/ghc/compiler/nativeGen/Stix.lhs
index 1223490..d3eb3dd 100644 (file)
--- a/ghc/compiler/nativeGen/Stix.lhs
+++ b/ghc/compiler/nativeGen/Stix.lhs
@@ -7,7 +7,7 @@ module Stix (
        CodeSegment(..), StixReg(..), StixTree(..), StixTreeList,
        pprStixTrees, pprStixTree, ppStixReg,
         stixCountTempUses, stixSubst,
-       DestInfo(..),
+       DestInfo(..), hasDestInfo,
 
        stgBaseReg, stgNode, stgSp, stgSu, stgSpLim, 
         stgHp, stgHpLim, stgTagReg, stgR9, stgR10, 
@@ -30,14 +30,15 @@ import Ratio                ( Rational )
 
 import AbsCSyn         ( node, tagreg, MagicId(..) )
 import CallConv                ( CallConv, pprCallConv )
-import CLabel          ( mkAsmTempLabel, CLabel, pprCLabel, pprCLabel_asm )
-import PrimRep          ( PrimRep(..), showPrimRep )
-import PrimOp           ( PrimOp, pprPrimOp )
+import CLabel          ( mkAsmTempLabel, CLabel, pprCLabel )
+import PrimRep          ( PrimRep(..) )
+import PrimOp           ( PrimOp )
 import Unique           ( Unique )
 import SMRep           ( fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize )
 import UniqSupply      ( UniqSupply, splitUniqSupply, uniqFromSupply,
                           UniqSM, thenUs, returnUs, getUniqueUs )
 import Outputable
+import FastTypes
 \end{code}
 
 Here is the tag at the nodes of our @StixTree@.         Notice its
@@ -131,6 +132,9 @@ data DestInfo
    = NoDestInfo             -- no supplied dests; infer from context
    | DestInfo [CLabel]      -- precisely these dests and no others
 
+hasDestInfo NoDestInfo   = False
+hasDestInfo (DestInfo _) = True
+
 pprDests :: DestInfo -> SDoc
 pprDests NoDestInfo      = text "NoDestInfo"
 pprDests (DestInfo dsts) = brack (hsep (map pprCLabel dsts))
@@ -154,14 +158,14 @@ pprStixTree t
        StInt i          -> paren (integer i)
        StFloat rat      -> paren (text "Float" <+> rational rat)
        StDouble        rat     -> paren (text "Double" <+> rational rat)
-       StString str     -> paren (text "Str" <+> ptext str)
+       StString str     -> paren (text "Str `" <> ptext str <> char '\'')
        StComment str    -> paren (text "Comment" <+> ptext str)
        StCLbl lbl       -> pprCLabel lbl
        StReg reg        -> ppStixReg reg
        StIndex k b o    -> paren (pprStixTree b <+> char '+' <> 
-                                  pprPrimRep k <+> pprStixTree o)
-       StInd k t        -> pprPrimRep k <> char '[' <> pprStixTree t <> char ']'
-       StAssign k d s   -> pprStixTree d <> text "  :=" <> pprPrimRep k 
+                                  ppr k <+> pprStixTree o)
+       StInd k t        -> ppr k <> char '[' <> pprStixTree t <> char ']'
+       StAssign k d s   -> pprStixTree d <> text "  :=" <> ppr k 
                                          <> text "  " <> pprStixTree s
        StLabel ll       -> pprCLabel ll <+> char ':'
        StFunBegin ll    -> char ' ' $$ paren (text "FunBegin" <+> pprCLabel ll)
@@ -170,17 +174,15 @@ pprStixTree t
        StFallThrough ll -> paren (text "FallThru" <+> pprCLabel ll)
        StCondJump l t   -> paren (text "JumpC" <+> pprCLabel l 
                                                <+> pprStixTree t)
-       StData k ds      -> paren (text "Data" <+> pprPrimRep k <+>
+       StData k ds      -> paren (text "Data" <+> ppr k <+>
                                   hsep (map pprStixTree ds))
-       StPrim op ts     -> paren (text "Prim" <+> pprPrimOp op <+> 
+       StPrim op ts     -> paren (text "Prim" <+> ppr op <+> 
                                   hsep (map pprStixTree ts))
        StCall nm cc k args
                         -> paren (text "Call" <+> ptext nm <+>
-                                  pprCallConv cc <+> pprPrimRep k <+> 
+                                  pprCallConv cc <+> ppr k <+> 
                                   hsep (map pprStixTree args))
        StScratchWord i  -> text "ScratchWord" <> paren (int i)
-
-pprPrimRep = text . showPrimRep
 \end{code}
 
 Stix registers can have two forms.  They {\em may} or {\em may not}
@@ -200,12 +202,12 @@ ppStixReg (StixTemp u pr)
 
 
 ppMId BaseReg              = text "BaseReg"
-ppMId (VanillaReg kind n)  = hcat [pprPrimRep kind, text "IntReg(", 
-                                   int (I# n), char ')']
-ppMId (FloatReg n)         = hcat [text "FltReg(", int (I# n), char ')']
-ppMId (DoubleReg n)        = hcat [text "DblReg(", int (I# n), char ')']
-ppMId (LongReg kind n)     = hcat [pprPrimRep kind, text "LongReg(", 
-                                   int (I# n), char ')']
+ppMId (VanillaReg kind n)  = hcat [ppr kind, text "IntReg(", 
+                                   int (iBox n), char ')']
+ppMId (FloatReg n)         = hcat [text "FltReg(", int (iBox n), char ')']
+ppMId (DoubleReg n)        = hcat [text "DblReg(", int (iBox n), char ')']
+ppMId (LongReg kind n)     = hcat [ppr kind, text "LongReg(", 
+                                   int (iBox n), char ')']
 ppMId Sp                   = text "Sp"
 ppMId Su                   = text "Su"
 ppMId SpLim                = text "SpLim"
@@ -220,7 +222,7 @@ segment (or that it has no segments at all, and we can lump these
 together).
 
 \begin{code}
-data CodeSegment = DataSegment | TextSegment deriving (Eq, Show)
+data CodeSegment = DataSegment | TextSegment | RoDataSegment deriving (Eq, Show)
 ppCodeSegment = text . show
 
 type StixTreeList = [StixTree] -> [StixTree]
@@ -241,8 +243,8 @@ stgHp                   = StReg (StixMagicId Hp)
 stgHpLim           = StReg (StixMagicId HpLim)
 stgCurrentTSO      = StReg (StixMagicId CurrentTSO)
 stgCurrentNursery   = StReg (StixMagicId CurrentNursery)
-stgR9               = StReg (StixMagicId (VanillaReg WordRep ILIT(9)))
-stgR10              = StReg (StixMagicId (VanillaReg WordRep ILIT(10)))
+stgR9               = StReg (StixMagicId (VanillaReg WordRep (_ILIT 9)))
+stgR10              = StReg (StixMagicId (VanillaReg WordRep (_ILIT 10)))
 
 getNatLabelNCG :: NatM CLabel
 getNatLabelNCG