[project @ 2000-10-24 10:12:16 by sewardj]

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

diff --git a/ghc/compiler/nativeGen/Stix.lhs b/ghc/compiler/nativeGen/Stix.lhs
index e90a6d6..1e04305 100644 (file)
--- a/ghc/compiler/nativeGen/Stix.lhs
+++ b/ghc/compiler/nativeGen/Stix.lhs
@@ -7,6 +7,7 @@ module Stix (
        CodeSegment(..), StixReg(..), StixTree(..), StixTreeList,
        pprStixTrees, pprStixTree, ppStixReg,
         stixCountTempUses, stixSubst,
+       DestInfo(..), hasDestInfo,
 
        stgBaseReg, stgNode, stgSp, stgSu, stgSpLim, 
         stgHp, stgHpLim, stgTagReg, stgR9, stgR10, 
@@ -28,7 +29,6 @@ module Stix (
 import Ratio           ( Rational )
 
 import AbsCSyn         ( node, tagreg, MagicId(..) )
-import AbsCUtils       ( magicIdPrimRep )
 import CallConv                ( CallConv, pprCallConv )
 import CLabel          ( mkAsmTempLabel, CLabel, pprCLabel, pprCLabel_asm )
 import PrimRep          ( PrimRep(..), showPrimRep )
@@ -37,8 +37,8 @@ import Unique           ( Unique )
 import SMRep           ( fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize )
 import UniqSupply      ( UniqSupply, splitUniqSupply, uniqFromSupply,
                           UniqSM, thenUs, returnUs, getUniqueUs )
-import CmdLineOpts     ( opt_Static )
 import Outputable
+import FastTypes
 \end{code}
 
 Here is the tag at the nodes of our @StixTree@.         Notice its
@@ -83,10 +83,15 @@ data StixTree
   | StFunBegin CLabel
   | StFunEnd CLabel
 
-    -- An unconditional jump. This instruction is terminal.
-    -- Dynamic targets are allowed
+    -- An unconditional jump. This instruction may or may not jump
+    -- out of the register allocation domain (basic block, more or
+    -- less).  For correct register allocation when this insn is used
+    -- to jump through a jump table, we optionally allow a list of
+    -- the exact targets to be attached, so that the allocator can
+    -- easily construct the exact flow edges leaving this insn.
+    -- Dynamic targets are allowed.
 
-  | StJump StixTree
+  | StJump DestInfo StixTree
 
     -- A fall-through, from slow to fast
 
@@ -122,6 +127,19 @@ data StixTree
   | StComment FAST_STRING
 
 
+-- used by insnFuture in RegAllocInfo.lhs
+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))
+
+
 pprStixTrees :: [StixTree] -> SDoc
 pprStixTrees ts 
   = vcat [
@@ -131,6 +149,7 @@ pprStixTrees ts
     ]
 
 paren t = char '(' <> t <> char ')'
+brack t = char '[' <> t <> char ']'
 
 pprStixTree :: StixTree -> SDoc
 pprStixTree t 
@@ -151,7 +170,7 @@ pprStixTree t
        StLabel ll       -> pprCLabel ll <+> char ':'
        StFunBegin ll    -> char ' ' $$ paren (text "FunBegin" <+> pprCLabel ll)
        StFunEnd ll      -> paren (text "FunEnd" <+> pprCLabel ll)
-       StJump t         -> paren (text "Jump" <+> pprStixTree t)
+       StJump dsts t    -> paren (text "Jump" <+> pprDests dsts <+> pprStixTree t)
        StFallThrough ll -> paren (text "FallThru" <+> pprCLabel ll)
        StCondJump l t   -> paren (text "JumpC" <+> pprCLabel l 
                                                <+> pprStixTree t)
@@ -186,11 +205,11 @@ 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 ')']
+                                   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 [pprPrimRep kind, text "LongReg(", 
-                                   int (I# n), char ')']
+                                   int (iBox n), char ')']
 ppMId Sp                   = text "Sp"
 ppMId Su                   = text "Su"
 ppMId SpLim                = text "SpLim"
@@ -226,8 +245,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
@@ -262,7 +281,7 @@ stixCountTempUses u t
         StIndex    pk t1 t2       -> qq t1 + qq t2
         StInd      pk t1          -> qq t1
         StAssign   pk t1 t2       -> qq t1 + qq t2
-        StJump     t1             -> qq t1
+        StJump     dsts t1        -> qq t1
         StCondJump lbl t1         -> qq t1
         StData     pk ts          -> sum (map qq ts)
         StPrim     op ts          -> sum (map qq ts)
@@ -306,7 +325,7 @@ stixMapUniques f t
         StIndex    pk t1 t2       -> StIndex    pk (qq t1) (qq t2)
         StInd      pk t1          -> StInd      pk (qq t1)
         StAssign   pk t1 t2       -> StAssign   pk (qq t1) (qq t2)
-        StJump     t1             -> StJump     (qq t1)
+        StJump     dsts t1        -> StJump     dsts (qq t1)
         StCondJump lbl t1         -> StCondJump lbl (qq t1)
         StData     pk ts          -> StData     pk (map qq ts)
         StPrim     op ts          -> StPrim     op (map qq ts)