diff options
Diffstat (limited to 'compiler/nativeGen/PPC/CodeGen.hs')
| -rw-r--r-- | compiler/nativeGen/PPC/CodeGen.hs | 40 |
1 files changed, 23 insertions, 17 deletions
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs index 516a49aee3..c640ba115f 100644 --- a/compiler/nativeGen/PPC/CodeGen.hs +++ b/compiler/nativeGen/PPC/CodeGen.hs @@ -180,10 +180,16 @@ stmtToInstrs stmt = do return (b1 `appOL` b2) CmmSwitch arg ids -> do dflags <- getDynFlags genSwitch dflags arg ids - CmmCall { cml_target = arg } -> genJump arg + CmmCall { cml_target = arg + , cml_args_regs = gregs } -> do + dflags <- getDynFlags + genJump arg (jumpRegs dflags gregs) _ -> panic "stmtToInstrs: statement should have been cps'd away" +jumpRegs :: DynFlags -> [GlobalReg] -> [Reg] +jumpRegs dflags gregs = [ RegReal r | Just r <- map (globalRegMaybe platform) gregs ] + where platform = targetPlatform dflags -------------------------------------------------------------------------------- -- | 'InstrBlock's are the insn sequences generated by the insn selectors. @@ -1042,19 +1048,19 @@ assignReg_FltCode = assignReg_IntCode -genJump :: CmmExpr{-the branch target-} -> NatM InstrBlock +genJump :: CmmExpr{-the branch target-} -> [Reg] -> NatM InstrBlock -genJump (CmmLit (CmmLabel lbl)) - = return (unitOL $ JMP lbl) +genJump (CmmLit (CmmLabel lbl)) regs + = return (unitOL $ JMP lbl regs) -genJump tree +genJump tree gregs = do dflags <- getDynFlags - genJump' tree (platformToGCP (targetPlatform dflags)) + genJump' tree (platformToGCP (targetPlatform dflags)) gregs -genJump' :: CmmExpr -> GenCCallPlatform -> NatM InstrBlock +genJump' :: CmmExpr -> GenCCallPlatform -> [Reg] -> NatM InstrBlock -genJump' tree (GCP64ELF 1) +genJump' tree (GCP64ELF 1) regs = do (target,code) <- getSomeReg tree return (code @@ -1062,20 +1068,20 @@ genJump' tree (GCP64ELF 1) `snocOL` LD II64 toc (AddrRegImm target (ImmInt 8)) `snocOL` MTCTR r11 `snocOL` LD II64 r11 (AddrRegImm target (ImmInt 16)) - `snocOL` BCTR [] Nothing) + `snocOL` BCTR [] Nothing regs) -genJump' tree (GCP64ELF 2) +genJump' tree (GCP64ELF 2) regs = do (target,code) <- getSomeReg tree return (code `snocOL` MR r12 target `snocOL` MTCTR r12 - `snocOL` BCTR [] Nothing) + `snocOL` BCTR [] Nothing regs) -genJump' tree _ +genJump' tree _ regs = do (target,code) <- getSomeReg tree - return (code `snocOL` MTCTR target `snocOL` BCTR [] Nothing) + return (code `snocOL` MTCTR target `snocOL` BCTR [] Nothing regs) -- ----------------------------------------------------------------------------- -- Unconditional branches @@ -2044,7 +2050,7 @@ genSwitch dflags expr targets SL fmt tmp reg (RIImm (ImmInt sha)), LD fmt tmp (AddrRegReg tableReg tmp), MTCTR tmp, - BCTR ids (Just lbl) + BCTR ids (Just lbl) [] ] return code @@ -2062,7 +2068,7 @@ genSwitch dflags expr targets LD fmt tmp (AddrRegReg tableReg tmp), ADD tmp tmp (RIReg tableReg), MTCTR tmp, - BCTR ids (Just lbl) + BCTR ids (Just lbl) [] ] return code | otherwise @@ -2077,14 +2083,14 @@ genSwitch dflags expr targets ADDIS tmp tmp (HA (ImmCLbl lbl)), LD fmt tmp (AddrRegImm tmp (LO (ImmCLbl lbl))), MTCTR tmp, - BCTR ids (Just lbl) + BCTR ids (Just lbl) [] ] return code where (offset, ids) = switchTargetsToTable targets generateJumpTableForInstr :: DynFlags -> Instr -> Maybe (NatCmmDecl CmmStatics Instr) -generateJumpTableForInstr dflags (BCTR ids (Just lbl)) = +generateJumpTableForInstr dflags (BCTR ids (Just lbl) _) = let jumpTable | (positionIndependent dflags) || (not $ target32Bit $ targetPlatform dflags) |