[project @ 2005-05-21 15:39:00 by panne]

[ghc-hetmet.git] / ghc / compiler / cmm / PprC.hs

diff --git a/ghc/compiler/cmm/PprC.hs b/ghc/compiler/cmm/PprC.hs
index adfafaf..72a3cb1 100644 (file)
--- a/ghc/compiler/cmm/PprC.hs
+++ b/ghc/compiler/cmm/PprC.hs
@@ -184,6 +184,10 @@ pprStmt stmt = case stmt of
        -> ptext SLIT("ASSIGN_Word64") <> 
                parens (mkP_ <> pprExpr1 dest <> comma <> pprExpr src) <> semi
 
+       | rep == F64 && wordRep /= I64
+       -> ptext SLIT("ASSIGN_DBL") <> 
+               parens (mkP_ <> pprExpr1 dest <> comma <> pprExpr src) <> semi
+
        | otherwise
        -> hsep [ pprExpr (CmmLoad dest rep), equals, pprExpr src <> semi ]
        where
@@ -300,6 +304,9 @@ pprExpr e = case e of
     CmmLoad e I64 | wordRep /= I64
        -> ptext SLIT("PK_Word64") <> parens (mkP_ <> pprExpr1 e)
 
+    CmmLoad e F64 | wordRep /= I64
+       -> ptext SLIT("PK_DBL") <> parens (mkP_ <> pprExpr1 e)
+
     CmmLoad (CmmReg r) rep 
        | isPtrReg r && rep == wordRep
        -> char '*' <> pprAsPtrReg r
@@ -366,8 +373,8 @@ pprLit :: CmmLit -> SDoc
 pprLit lit = case lit of
     CmmInt i rep      -> pprHexVal i rep
     CmmFloat f rep     -> parens (machRepCType rep) <> (rational f)
-    CmmLabel clbl      -> mkW_ <> pprCLabel clbl
-    CmmLabelOff clbl i -> mkW_ <> pprCLabel clbl <> char '+' <> int i
+    CmmLabel clbl      -> mkW_ <> pprCLabelAddr clbl
+    CmmLabelOff clbl i -> mkW_ <> pprCLabelAddr clbl <> char '+' <> int i
     CmmLabelDiffOff clbl1 clbl2 i
         -- WARNING:
         --  * the lit must occur in the info table clbl2
@@ -375,7 +382,9 @@ pprLit lit = case lit of
         -- The Mangler is expected to convert any reference to an SRT,
         -- a slow entry point or a large bitmap
         -- from an info table to an offset.
-        -> mkW_ <> pprCLabel clbl1 <> char '+' <> int i
+        -> mkW_ <> pprCLabelAddr clbl1 <> char '+' <> int i
+
+pprCLabelAddr lbl = char '&' <> pprCLabel lbl
 
 pprLit1 :: CmmLit -> SDoc
 pprLit1 lit@(CmmLabelOff _ _) = parens (pprLit lit)
@@ -640,6 +649,7 @@ isStrangeTypeReg (CmmGlobal g)      = isStrangeTypeGlobal g
 isStrangeTypeGlobal :: GlobalReg -> Bool
 isStrangeTypeGlobal CurrentTSO         = True
 isStrangeTypeGlobal CurrentNursery     = True
+isStrangeTypeGlobal BaseReg            = True
 isStrangeTypeGlobal r                  = isPtrGlobalReg r
 
 strangeRegType :: CmmReg -> Maybe SDoc
@@ -698,7 +708,7 @@ pprCall ppr_fn cconv results args vols
   where 
      ppr_results []     = empty
      ppr_results [(one,hint)] 
-        = pprExpr (CmmReg one) <> ptext SLIT(" = ")
+        = pprReg one <> ptext SLIT(" = ")
                 <> pprUnHint hint (cmmRegRep one)
      ppr_results _other = panic "pprCall: multiple results"
 
@@ -728,9 +738,10 @@ pprGlobalRegName gr = case gr of
     VanillaReg n   -> char 'R' <> int n  -- without the .w suffix
     _              -> pprGlobalReg gr
 
+-- Currently we only have these two calling conventions, but this might
+-- change in the future...
 is_cish CCallConv   = True
 is_cish StdCallConv = True
-is_cish _          = False
 
 -- ---------------------------------------------------------------------
 -- Find and print local and external declarations for a list of
@@ -812,11 +823,10 @@ te_Stmt _                 = return ()
 
 te_Expr :: CmmExpr -> TE ()
 te_Expr (CmmLit lit)           = te_Lit lit
-te_Expr (CmmReg r)             = te_Reg r
 te_Expr (CmmLoad e _)          = te_Expr e
+te_Expr (CmmReg r)             = te_Reg r
 te_Expr (CmmMachOp _ es)       = mapM_ te_Expr es
 te_Expr (CmmRegOff r _)        = te_Reg r
-te_Expr _                      = return ()
 
 te_Reg :: CmmReg -> TE ()
 te_Reg (CmmLocal l) = te_temp l