import CmdLineOpts ( opt_EnsureSplittableC )
-- The rest
-import Data.List ( intersperse, group )
+import Data.List ( intersperse, groupBy )
import Data.Bits ( shiftR )
import Char ( ord, chr )
import IO ( Handle )
--
pprSwitch :: CmmExpr -> [ Maybe BlockId ] -> SDoc
pprSwitch e maybe_ids
- = let ids = [ i | Just i <- maybe_ids ]
- pairs = zip [ 0 .. ] (concatMap markfalls (group ids))
+ = let pairs = [ (ix, ident) | (ix,Just ident) <- zip [0..] maybe_ids ]
+ pairs2 = [ (map fst as, snd (head as)) | as <- groupBy sndEq pairs ]
in
(hang (ptext SLIT("switch") <+> parens ( pprExpr e ) <+> lbrace)
- 4 (vcat ( map caseify pairs )))
+ 4 (vcat ( map caseify pairs2 )))
$$ rbrace
where
- -- fall through case
- caseify (i,Left ident) =
- hsep [ ptext SLIT("case") , pprHexVal i <> colon ,
- ptext SLIT("/* fall through for"),
- pprBlockId ident,
- ptext SLIT("*/") ]
-
- caseify (i,Right ident) =
- hsep [ ptext SLIT("case") , pprHexVal i <> colon ,
- ptext SLIT("goto") , (pprBlockId ident) <> semi ]
+ sndEq (_,x) (_,y) = x == y
- -- mark the bottom of a fallthough sequence of cases as `Right'
- markfalls [a] = [Right a]
- markfalls as = map (\a -> Left a) (init as) ++ [Right (last as)]
+ -- fall through case
+ caseify (ix:ixs, ident) = vcat (map do_fallthrough ixs) $$ final_branch ix
+ where
+ do_fallthrough ix =
+ hsep [ ptext SLIT("case") , pprHexVal ix <> colon ,
+ ptext SLIT("/* fall through */") ]
+ final_branch ix =
+ hsep [ ptext SLIT("case") , pprHexVal ix <> colon ,
+ ptext SLIT("goto") , (pprBlockId ident) <> semi ]
-- ---------------------------------------------------------------------
-- Expressions.
pprMachOpApp op args
| isMulMayOfloOp op
- = ptext SLIT("mulIntMayOflo") <> parens (commafy (map pprExpr args)) <> semi
+ = ptext SLIT("mulIntMayOflo") <> parens (commafy (map pprExpr args))
where isMulMayOfloOp (MO_U_MulMayOflo _) = True
isMulMayOfloOp (MO_S_MulMayOflo _) = True
isMulMayOfloOp _ = False
(op,off') | off >= 0 = (char '+', off1)
| otherwise = (char '-', -off1)
--- dest is a reg, rhs is anything
+-- dest is a reg, rhs is anything.
+-- We can't cast the lvalue, so we have to cast the rhs if necessary. Casting
+-- the lvalue elicits a warning from new GCC versions (3.4+).
pprAssign r1 r2
- = pprCastReg r1 <+> equals <+> pprExpr r2 <> semi
+ | isPtrReg r1
+ = pprAsPtrReg r1 <> ptext SLIT(" = ") <> mkP_ <> pprExpr1 r2 <> semi
+ | Just ty <- strangeRegType r1
+ = pprReg r1 <> ptext SLIT(" = ") <> parens ty <> pprExpr1 r2 <> semi
+ | otherwise
+ = pprReg r1 <> ptext SLIT(" = ") <> pprExpr r2 <> semi
-- ---------------------------------------------------------------------
-- Registers
isStrangeTypeGlobal CurrentNursery = True
isStrangeTypeGlobal r = isPtrGlobalReg r
+strangeRegType :: CmmReg -> Maybe SDoc
+strangeRegType (CmmGlobal CurrentTSO) = Just (ptext SLIT("struct StgTSO_ *"))
+strangeRegType (CmmGlobal CurrentNursery) = Just (ptext SLIT("struct bdescr_ *"))
+strangeRegType _ = Nothing
-- pprReg just prints the register name.
--
restore vols
where
ppr_results [] = empty
- ppr_results [(one,hint)] = pprArg (CmmReg one,hint) <> ptext SLIT(" = ")
+ ppr_results [(one,hint)]
+ = pprExpr (CmmReg one) <> ptext SLIT(" = ")
+ <> pprUnHint hint (cmmRegRep one)
ppr_results _other = panic "pprCall: multiple results"
pprArg (expr, PtrHint)
pprArg (expr, _other)
= pprExpr expr
+ pprUnHint PtrHint rep = parens (machRepCType rep)
+ pprUnHint SignedHint rep = parens (machRepCType rep)
+ pprUnHint _ _ = empty
+
save = save_restore SLIT("CALLER_SAVE")
restore = save_restore SLIT("CALLER_RESTORE")