[project @ 2000-08-21 15:40:14 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 dfb2ba6..1223490 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(..),
 
        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,7 +37,6 @@ import Unique           ( Unique )
 import SMRep           ( fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize )
 import UniqSupply      ( UniqSupply, splitUniqSupply, uniqFromSupply,
                           UniqSM, thenUs, returnUs, getUniqueUs )
-import CmdLineOpts     ( opt_Static )
 import Outputable
 \end{code}
 
@@ -53,6 +52,7 @@ data StixTree
     -- We can tag the leaves with constants/immediates.
 
   | StInt      Integer     -- ** add Kind at some point
+  | StFloat    Rational
   | StDouble   Rational
   | StString   FAST_STRING
   | StCLbl     CLabel      -- labels that we might index into
@@ -82,10 +82,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
 
@@ -121,6 +126,16 @@ 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
+
+pprDests :: DestInfo -> SDoc
+pprDests NoDestInfo      = text "NoDestInfo"
+pprDests (DestInfo dsts) = brack (hsep (map pprCLabel dsts))
+
+
 pprStixTrees :: [StixTree] -> SDoc
 pprStixTrees ts 
   = vcat [
@@ -130,12 +145,14 @@ pprStixTrees ts
     ]
 
 paren t = char '(' <> t <> char ')'
+brack t = char '[' <> t <> char ']'
 
 pprStixTree :: StixTree -> SDoc
 pprStixTree t 
    = case t of
        StSegment cseg   -> paren (ppCodeSegment cseg)
        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)
        StComment str    -> paren (text "Comment" <+> ptext str)
@@ -149,7 +166,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)
@@ -260,7 +277,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)
@@ -268,6 +285,7 @@ stixCountTempUses u t
 
         StSegment _      -> 0
         StInt _          -> 0
+        StFloat _        -> 0
         StDouble _       -> 0
         StString _       -> 0
         StCLbl _         -> 0
@@ -303,7 +321,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)
@@ -311,6 +329,7 @@ stixMapUniques f t
 
         StSegment _      -> t
         StInt _          -> t
+        StFloat _        -> t
         StDouble _       -> t
         StString _       -> t
         StCLbl _         -> t