From 35ce906d57d3135a749069b8bfe3e98587258e46 Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Wed, 8 Jun 2011 17:56:47 +0100 Subject: [PATCH] Whitespace only in nativeGen/PPC/CodeGen.hs --- compiler/nativeGen/PPC/CodeGen.hs | 460 ++++++++++++++++++------------------- 1 file changed, 230 insertions(+), 230 deletions(-) diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs index 736d564..7e19f4f 100644 --- a/compiler/nativeGen/PPC/CodeGen.hs +++ b/compiler/nativeGen/PPC/CodeGen.hs @@ -13,11 +13,11 @@ -- (c) the #if blah_TARGET_ARCH} things, the -- structure should not be too overwhelming. -module PPC.CodeGen ( - cmmTopCodeGen, - generateJumpTableForInstr, - InstrBlock -) +module PPC.CodeGen ( + cmmTopCodeGen, + generateJumpTableForInstr, + InstrBlock +) where @@ -41,19 +41,19 @@ import Platform -- Our intermediate code: import BlockId -import PprCmm ( pprExpr ) +import PprCmm ( pprExpr ) import OldCmm import CLabel -- The rest: -import StaticFlags ( opt_PIC ) +import StaticFlags ( opt_PIC ) import OrdList import qualified Outputable as O import Outputable import Unique import DynFlags -import Control.Monad ( mapAndUnzipM ) +import Control.Monad ( mapAndUnzipM ) import Data.Bits import Data.Int import Data.Word @@ -71,10 +71,10 @@ import FastString -- left-to-right traversal (pre-order?) yields the insns in the correct -- order. -cmmTopCodeGen - :: DynFlags - -> RawCmmTop - -> NatM [NatCmmTop Instr] +cmmTopCodeGen + :: DynFlags + -> RawCmmTop + -> NatM [NatCmmTop Instr] cmmTopCodeGen dflags (CmmProc info lab (ListGraph blocks)) = do (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks @@ -85,14 +85,14 @@ cmmTopCodeGen dflags (CmmProc info lab (ListGraph blocks)) = do case picBaseMb of Just picBase -> initializePicBase_ppc ArchPPC os picBase tops Nothing -> return tops - + cmmTopCodeGen dflags (CmmData sec dat) = do return [CmmData sec dat] -- no translation, we just use CmmStatic -basicBlockCodeGen - :: CmmBasicBlock - -> NatM ( [NatBasicBlock Instr] - , [NatCmmTop Instr]) +basicBlockCodeGen + :: CmmBasicBlock + -> NatM ( [NatBasicBlock Instr] + , [NatCmmTop Instr]) basicBlockCodeGen (BasicBlock id stmts) = do instrs <- stmtsToInstrs stmts @@ -101,14 +101,14 @@ basicBlockCodeGen (BasicBlock id stmts) = do -- instruction stream into basic blocks again. Also, we extract -- LDATAs here too. let - (top,other_blocks,statics) = foldrOL mkBlocks ([],[],[]) instrs - - mkBlocks (NEWBLOCK id) (instrs,blocks,statics) - = ([], BasicBlock id instrs : blocks, statics) - mkBlocks (LDATA sec dat) (instrs,blocks,statics) - = (instrs, blocks, CmmData sec dat:statics) - mkBlocks instr (instrs,blocks,statics) - = (instr:instrs, blocks, statics) + (top,other_blocks,statics) = foldrOL mkBlocks ([],[],[]) instrs + + mkBlocks (NEWBLOCK id) (instrs,blocks,statics) + = ([], BasicBlock id instrs : blocks, statics) + mkBlocks (LDATA sec dat) (instrs,blocks,statics) + = (instrs, blocks, CmmData sec dat:statics) + mkBlocks instr (instrs,blocks,statics) + = (instr:instrs, blocks, statics) -- in return (BasicBlock id top : other_blocks, statics) @@ -119,7 +119,7 @@ stmtsToInstrs stmts stmtToInstrs :: CmmStmt -> NatM InstrBlock stmtToInstrs stmt = case stmt of - CmmNop -> return nilOL + CmmNop -> return nilOL CmmComment s -> return (unitOL (COMMENT s)) CmmAssign reg src @@ -127,47 +127,47 @@ stmtToInstrs stmt = case stmt of #if WORD_SIZE_IN_BITS==32 | isWord64 ty -> assignReg_I64Code reg src #endif - | otherwise -> assignReg_IntCode size reg src - where ty = cmmRegType reg - size = cmmTypeSize ty + | otherwise -> assignReg_IntCode size reg src + where ty = cmmRegType reg + size = cmmTypeSize ty CmmStore addr src | isFloatType ty -> assignMem_FltCode size addr src #if WORD_SIZE_IN_BITS==32 - | isWord64 ty -> assignMem_I64Code addr src + | isWord64 ty -> assignMem_I64Code addr src #endif - | otherwise -> assignMem_IntCode size addr src - where ty = cmmExprType src - size = cmmTypeSize ty + | otherwise -> assignMem_IntCode size addr src + where ty = cmmExprType src + size = cmmTypeSize ty CmmCall target result_regs args _ _ -> genCCall target result_regs args - CmmBranch id -> genBranch id + CmmBranch id -> genBranch id CmmCondBranch arg id -> genCondJump id arg CmmSwitch arg ids -> genSwitch arg ids - CmmJump arg params -> genJump arg - CmmReturn params -> + CmmJump arg params -> genJump arg + CmmReturn params -> panic "stmtToInstrs: return statement should have been cps'd away" -------------------------------------------------------------------------------- -- | 'InstrBlock's are the insn sequences generated by the insn selectors. --- They are really trees of insns to facilitate fast appending, where a --- left-to-right traversal yields the insns in the correct order. +-- They are really trees of insns to facilitate fast appending, where a +-- left-to-right traversal yields the insns in the correct order. -- -type InstrBlock - = OrdList Instr +type InstrBlock + = OrdList Instr -- | Register's passed up the tree. If the stix code forces the register --- to live in a pre-decided machine register, it comes out as @Fixed@; --- otherwise, it comes out as @Any@, and the parent can decide which --- register to put it in. +-- to live in a pre-decided machine register, it comes out as @Fixed@; +-- otherwise, it comes out as @Any@, and the parent can decide which +-- register to put it in. -- data Register - = Fixed Size Reg InstrBlock - | Any Size (Reg -> InstrBlock) + = Fixed Size Reg InstrBlock + | Any Size (Reg -> InstrBlock) swizzleRegisterRep :: Register -> Size -> Register @@ -210,10 +210,10 @@ temporary, then do the other computation, and then use the temporary: -- | Check whether an integer will fit in 32 bits. --- A CmmInt is intended to be truncated to the appropriate --- number of bits, so here we truncate it to Int64. This is --- important because e.g. -1 as a CmmInt might be either --- -1 or 18446744073709551615. +-- A CmmInt is intended to be truncated to the appropriate +-- number of bits, so here we truncate it to Int64. This is +-- important because e.g. -1 as a CmmInt might be either +-- -1 or 18446744073709551615. -- is32BitInteger :: Integer -> Bool is32BitInteger i = i64 <= 0x7fffffff && i64 >= -0x80000000 @@ -239,7 +239,7 @@ mangleIndexTree (CmmRegOff reg off) where width = typeWidth (cmmRegType reg) mangleIndexTree _ - = panic "PPC.CodeGen.mangleIndexTree: no match" + = panic "PPC.CodeGen.mangleIndexTree: no match" -- ----------------------------------------------------------------------------- -- Code gen for 64-bit arithmetic on 32-bit platforms @@ -257,27 +257,27 @@ of the VRegUniqueLo form, and the upper-half VReg can be determined by applying getHiVRegFromLo to it. -} -data ChildCode64 -- a.k.a "Register64" - = ChildCode64 - InstrBlock -- code - Reg -- the lower 32-bit temporary which contains the - -- result; use getHiVRegFromLo to find the other - -- VRegUnique. Rules of this simplified insn - -- selection game are therefore that the returned - -- Reg may be modified +data ChildCode64 -- a.k.a "Register64" + = ChildCode64 + InstrBlock -- code + Reg -- the lower 32-bit temporary which contains the + -- result; use getHiVRegFromLo to find the other + -- VRegUnique. Rules of this simplified insn + -- selection game are therefore that the returned + -- Reg may be modified -- | The dual to getAnyReg: compute an expression into a register, but --- we don't mind which one it is. +-- we don't mind which one it is. getSomeReg :: CmmExpr -> NatM (Reg, InstrBlock) getSomeReg expr = do r <- getRegister expr case r of Any rep code -> do - tmp <- getNewRegNat rep - return (tmp, code tmp) - Fixed _ reg code -> - return (reg, code) + tmp <- getNewRegNat rep + return (tmp, code tmp) + Fixed _ reg code -> + return (reg, code) getI64Amodes :: CmmExpr -> NatM (AddrMode, AddrMode, InstrBlock) getI64Amodes addrTree = do @@ -293,21 +293,21 @@ getI64Amodes addrTree = do assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM InstrBlock assignMem_I64Code addrTree valueTree = do (hi_addr, lo_addr, addr_code) <- getI64Amodes addrTree - ChildCode64 vcode rlo <- iselExpr64 valueTree - let - rhi = getHiVRegFromLo rlo + ChildCode64 vcode rlo <- iselExpr64 valueTree + let + rhi = getHiVRegFromLo rlo - -- Big-endian store - mov_hi = ST II32 rhi hi_addr - mov_lo = ST II32 rlo lo_addr - -- in - return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi) + -- Big-endian store + mov_hi = ST II32 rhi hi_addr + mov_lo = ST II32 rlo lo_addr + -- in + return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi) assignReg_I64Code :: CmmReg -> CmmExpr -> NatM InstrBlock assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do ChildCode64 vcode r_src_lo <- iselExpr64 valueTree - let + let r_dst_lo = RegVirtual $ mkVirtualReg u_dst II32 r_dst_hi = getHiVRegFromLo r_dst_lo r_src_hi = getHiVRegFromLo r_src_lo @@ -328,7 +328,7 @@ iselExpr64 (CmmLoad addrTree ty) | isWord64 ty = do (rlo, rhi) <- getNewRegPairNat II32 let mov_hi = LD II32 rhi hi_addr mov_lo = LD II32 rlo lo_addr - return $ ChildCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi) + return $ ChildCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi) rlo iselExpr64 (CmmReg (CmmLocal (LocalReg vu ty))) | isWord64 ty @@ -337,17 +337,17 @@ iselExpr64 (CmmReg (CmmLocal (LocalReg vu ty))) | isWord64 ty iselExpr64 (CmmLit (CmmInt i _)) = do (rlo,rhi) <- getNewRegPairNat II32 let - half0 = fromIntegral (fromIntegral i :: Word16) - half1 = fromIntegral ((fromIntegral i `shiftR` 16) :: Word16) - half2 = fromIntegral ((fromIntegral i `shiftR` 32) :: Word16) - half3 = fromIntegral ((fromIntegral i `shiftR` 48) :: Word16) - - code = toOL [ - LIS rlo (ImmInt half1), - OR rlo rlo (RIImm $ ImmInt half0), - LIS rhi (ImmInt half3), - OR rlo rlo (RIImm $ ImmInt half2) - ] + half0 = fromIntegral (fromIntegral i :: Word16) + half1 = fromIntegral ((fromIntegral i `shiftR` 16) :: Word16) + half2 = fromIntegral ((fromIntegral i `shiftR` 32) :: Word16) + half3 = fromIntegral ((fromIntegral i `shiftR` 48) :: Word16) + + code = toOL [ + LIS rlo (ImmInt half1), + OR rlo rlo (RIImm $ ImmInt half0), + LIS rhi (ImmInt half3), + OR rlo rlo (RIImm $ ImmInt half2) + ] -- in return (ChildCode64 code rlo) @@ -356,12 +356,12 @@ iselExpr64 (CmmMachOp (MO_Add _) [e1,e2]) = do ChildCode64 code2 r2lo <- iselExpr64 e2 (rlo,rhi) <- getNewRegPairNat II32 let - r1hi = getHiVRegFromLo r1lo - r2hi = getHiVRegFromLo r2lo - code = code1 `appOL` - code2 `appOL` - toOL [ ADDC rlo r1lo r2lo, - ADDE rhi r1hi r2hi ] + r1hi = getHiVRegFromLo r1lo + r2hi = getHiVRegFromLo r2lo + code = code1 `appOL` + code2 `appOL` + toOL [ ADDC rlo r1lo r2lo, + ADDE rhi r1hi r2hi ] -- in return (ChildCode64 code rlo) @@ -384,11 +384,11 @@ getRegister (CmmReg (CmmGlobal PicBaseReg)) reg <- getPicBaseNat archWordSize return (Fixed archWordSize reg nilOL) -getRegister (CmmReg reg) - = return (Fixed (cmmTypeSize (cmmRegType reg)) - (getRegisterReg reg) nilOL) +getRegister (CmmReg reg) + = return (Fixed (cmmTypeSize (cmmRegType reg)) + (getRegisterReg reg) nilOL) -getRegister tree@(CmmRegOff _ _) +getRegister tree@(CmmRegOff _ _) = getRegister (mangleIndexTree tree) @@ -412,7 +412,7 @@ getRegister (CmmMachOp (MO_UU_Conv W64 W32) [x]) = do getRegister (CmmMachOp (MO_SS_Conv W64 W32) [x]) = do ChildCode64 code rlo <- iselExpr64 x - return $ Fixed II32 rlo code + return $ Fixed II32 rlo code #endif @@ -469,12 +469,12 @@ getRegister (CmmMachOp mop [x]) -- unary MachOps MO_UU_Conv W32 to -> conversionNop (intSize to) x MO_UU_Conv W16 W8 -> conversionNop II8 x MO_UU_Conv W8 to -> trivialCode to False AND x (CmmLit (CmmInt 255 W32)) - MO_UU_Conv W16 to -> trivialCode to False AND x (CmmLit (CmmInt 65535 W32)) - _ -> panic "PPC.CodeGen.getRegister: no match" + MO_UU_Conv W16 to -> trivialCode to False AND x (CmmLit (CmmInt 65535 W32)) + _ -> panic "PPC.CodeGen.getRegister: no match" where - triv_ucode_int width instr = trivialUCode (intSize width) instr x - triv_ucode_float width instr = trivialUCode (floatSize width) instr x + triv_ucode_int width instr = trivialUCode (intSize width) instr x + triv_ucode_float width instr = trivialUCode (floatSize width) instr x conversionNop new_size expr = do e_code <- getRegister expr @@ -506,7 +506,7 @@ getRegister (CmmMachOp mop [x, y]) -- dyadic PrimOps MO_F_Sub w -> triv_float w FSUB MO_F_Mul w -> triv_float w FMUL MO_F_Quot w -> triv_float w FDIV - + -- optimize addition with 32-bit immediate -- (needed for PIC) MO_Add W32 -> @@ -534,16 +534,16 @@ getRegister (CmmMachOp mop [x, y]) -- dyadic PrimOps MO_Mul rep -> trivialCode rep True MULLW x y MO_S_MulMayOflo W32 -> trivialCodeNoImm' II32 MULLW_MayOflo x y - + MO_S_MulMayOflo rep -> panic "S_MulMayOflo (rep /= II32): not implemented" MO_U_MulMayOflo rep -> panic "U_MulMayOflo: not implemented" MO_S_Quot rep -> trivialCodeNoImm' (intSize rep) DIVW (extendSExpr rep x) (extendSExpr rep y) MO_U_Quot rep -> trivialCodeNoImm' (intSize rep) DIVWU (extendUExpr rep x) (extendUExpr rep y) - + MO_S_Rem rep -> remainderCode rep DIVW (extendSExpr rep x) (extendSExpr rep y) MO_U_Rem rep -> remainderCode rep DIVWU (extendUExpr rep x) (extendUExpr rep y) - + MO_And rep -> trivialCode rep False AND x y MO_Or rep -> trivialCode rep False OR x y MO_Xor rep -> trivialCode rep False XOR x y @@ -551,7 +551,7 @@ getRegister (CmmMachOp mop [x, y]) -- dyadic PrimOps MO_Shl rep -> trivialCode rep False SLW x y MO_S_Shr rep -> trivialCode rep False SRAW (extendSExpr rep x) y MO_U_Shr rep -> trivialCode rep False SRW (extendUExpr rep x) y - _ -> panic "PPC.CodeGen.getRegister: no match" + _ -> panic "PPC.CodeGen.getRegister: no match" where triv_float :: Width -> (Size -> Reg -> Reg -> Reg -> Instr) -> NatM Register @@ -560,9 +560,9 @@ getRegister (CmmMachOp mop [x, y]) -- dyadic PrimOps getRegister (CmmLit (CmmInt i rep)) | Just imm <- makeImmediate rep True i = let - code dst = unitOL (LI dst imm) + code dst = unitOL (LI dst imm) in - return (Any (intSize rep) code) + return (Any (intSize rep) code) getRegister (CmmLit (CmmFloat f frep)) = do lbl <- getNewLabelNat @@ -570,9 +570,9 @@ getRegister (CmmLit (CmmFloat f frep)) = do dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl Amode addr addr_code <- getAmode dynRef let size = floatSize frep - code dst = - LDATA ReadOnlyData [CmmDataLabel lbl, - CmmStaticLit (CmmFloat f frep)] + code dst = + LDATA ReadOnlyData [CmmDataLabel lbl, + CmmStaticLit (CmmFloat f frep)] `consOL` (addr_code `snocOL` LD size dst addr) return (Any size code) @@ -586,7 +586,7 @@ getRegister (CmmLit lit) in return (Any (cmmTypeSize rep) code) getRegister other = pprPanic "getRegister(ppc)" (pprExpr other) - + -- extend?Rep: wrap integer expression of type rep -- in a conversion to II32 extendSExpr W32 x = x @@ -597,8 +597,8 @@ extendUExpr rep x = CmmMachOp (MO_UU_Conv rep W32) [x] -- ----------------------------------------------------------------------------- -- The 'Amode' type: Memory addressing modes passed up the tree. -data Amode - = Amode AddrMode InstrBlock +data Amode + = Amode AddrMode InstrBlock {- Now, given a tree (the argument to an CmmLoad) that references memory, @@ -650,13 +650,13 @@ getAmode (CmmLit lit) let imm = litToImm lit code = unitOL (LIS tmp (HA imm)) return (Amode (AddrRegImm tmp (LO imm)) code) - + getAmode (CmmMachOp (MO_Add W32) [x, y]) = do (regX, codeX) <- getSomeReg x (regY, codeY) <- getSomeReg y return (Amode (AddrRegReg regX regY) (codeX `appOL` codeY)) - + getAmode other = do (reg, code) <- getSomeReg other @@ -667,8 +667,8 @@ getAmode other -- The 'CondCode' type: Condition codes passed up the tree. -data CondCode - = CondCode Bool Cond InstrBlock +data CondCode + = CondCode Bool Cond InstrBlock -- Set up a condition code for a conditional branch. @@ -723,7 +723,7 @@ condIntCode cond x (CmmLit (CmmInt y rep)) = do (src1, code) <- getSomeReg x let - code' = code `snocOL` + code' = code `snocOL` (if condUnsigned cond then CMPL else CMP) II32 src1 (RIImm src2) return (CondCode False cond code') @@ -731,19 +731,19 @@ condIntCode cond x y = do (src1, code1) <- getSomeReg x (src2, code2) <- getSomeReg y let - code' = code1 `appOL` code2 `snocOL` - (if condUnsigned cond then CMPL else CMP) II32 src1 (RIReg src2) + code' = code1 `appOL` code2 `snocOL` + (if condUnsigned cond then CMPL else CMP) II32 src1 (RIReg src2) return (CondCode False cond code') condFltCode cond x y = do (src1, code1) <- getSomeReg x (src2, code2) <- getSomeReg y let - code' = code1 `appOL` code2 `snocOL` FCMP src1 src2 - code'' = case cond of -- twiddle CR to handle unordered case + code' = code1 `appOL` code2 `snocOL` FCMP src1 src2 + code'' = case cond of -- twiddle CR to handle unordered case GE -> code' `snocOL` CRNOR ltbit eqbit gtbit - LE -> code' `snocOL` CRNOR gtbit eqbit ltbit - _ -> code' + LE -> code' `snocOL` CRNOR gtbit eqbit ltbit + _ -> code' where ltbit = 0 ; eqbit = 2 ; gtbit = 1 return (CondCode True cond code'') @@ -828,7 +828,7 @@ allocator. genCondJump - :: BlockId -- the branch target + :: BlockId -- the branch target -> CmmExpr -- the condition on which to branch -> NatM InstrBlock @@ -844,14 +844,14 @@ genCondJump id bool = do -- Now the biggest nightmare---calls. Most of the nastiness is buried in -- @get_arg@, which moves the arguments to the correct registers/stack -- locations. Apart from that, the code is easy. --- +-- -- (If applicable) Do not fill the delay slots here; you will confuse the -- register allocator. genCCall - :: CmmCallTarget -- function to call - -> HintedCmmFormals -- where to put the result - -> HintedCmmActuals -- arguments (of mixed type) + :: CmmCallTarget -- function to call + -> HintedCmmFormals -- where to put the result + -> HintedCmmActuals -- arguments (of mixed type) -> NatM InstrBlock @@ -860,15 +860,15 @@ genCCall The PowerPC calling convention for Darwin/Mac OS X is described in Apple's document "Inside Mac OS X - Mach-O Runtime Architecture". - + PowerPC Linux uses the System V Release 4 Calling Convention for PowerPC. It is described in the "System V Application Binary Interface PowerPC Processor Supplement". Both conventions are similar: Parameters may be passed in general-purpose registers starting at r3, in - floating point registers starting at f1, or on the stack. - + floating point registers starting at f1, or on the stack. + But there are substantial differences: * The number of registers used for parameter passing and the exact set of nonvolatile registers differs (see MachRegs.lhs). @@ -884,7 +884,7 @@ genCCall 4-byte aligned like everything else on Darwin. * The SysV spec claims that FF32 is represented as FF64 on the stack. GCC on PowerPC Linux does not agree, so neither do we. - + According to both conventions, The parameter area should be part of the caller's stack frame, allocated in the caller's prologue code (large enough to hold the parameter lists for all called routines). The NCG already @@ -894,7 +894,7 @@ genCCall -} -genCCall (CmmPrim MO_WriteBarrier) _ _ +genCCall (CmmPrim MO_WriteBarrier) _ _ = return $ unitOL LWSYNC genCCall target dest_regs argsAndHints @@ -906,33 +906,33 @@ genCCall target dest_regs argsAndHints allArgRegs allFPArgRegs initialStackOffset (toOL []) [] - + (labelOrExpr, reduceToFF32) <- case target of CmmCallee (CmmLit (CmmLabel lbl)) conv -> return (Left lbl, False) CmmCallee expr conv -> return (Right expr, False) CmmPrim mop -> outOfLineMachOp mop - + let codeBefore = move_sp_down finalStack `appOL` passArgumentsCode codeAfter = move_sp_up finalStack `appOL` moveResult reduceToFF32 case labelOrExpr of Left lbl -> do - return ( codeBefore + return ( codeBefore `snocOL` BL lbl usedRegs - `appOL` codeAfter) + `appOL` codeAfter) Right dyn -> do - (dynReg, dynCode) <- getSomeReg dyn - return ( dynCode - `snocOL` MTCTR dynReg - `appOL` codeBefore + (dynReg, dynCode) <- getSomeReg dyn + return ( dynCode + `snocOL` MTCTR dynReg + `appOL` codeBefore `snocOL` BCTRL usedRegs - `appOL` codeAfter) + `appOL` codeAfter) where #if darwin_TARGET_OS initialStackOffset = 24 - -- size of linkage area + size of arguments, in bytes - stackDelta _finalStack = roundTo 16 $ (24 +) $ max 32 $ sum $ - map (widthInBytes . typeWidth) argReps + -- size of linkage area + size of arguments, in bytes + stackDelta _finalStack = roundTo 16 $ (24 +) $ max 32 $ sum $ + map (widthInBytes . typeWidth) argReps #elif linux_TARGET_OS initialStackOffset = 8 stackDelta finalStack = roundTo 16 finalStack @@ -947,25 +947,25 @@ genCCall target dest_regs argsAndHints | otherwise = argsAndHints - args = map hintlessCmm argsAndHints' - argReps = map cmmExprType args + args = map hintlessCmm argsAndHints' + argReps = map cmmExprType args - roundTo a x | x `mod` a == 0 = x - | otherwise = x + a - (x `mod` a) + roundTo a x | x `mod` a == 0 = x + | otherwise = x + a - (x `mod` a) move_sp_down finalStack | delta > 64 = toOL [STU II32 sp (AddrRegImm sp (ImmInt (-delta))), - DELTA (-delta)] - | otherwise = nilOL - where delta = stackDelta finalStack - move_sp_up finalStack - | delta > 64 = + DELTA (-delta)] + | otherwise = nilOL + where delta = stackDelta finalStack + move_sp_up finalStack + | delta > 64 = toOL [ADD sp sp (RIImm (ImmInt delta)), DELTA 0] - | otherwise = nilOL - where delta = stackDelta finalStack - + | otherwise = nilOL + where delta = stackDelta finalStack + passArguments [] _ _ stackOffset accumCode accumUsed = return (stackOffset, accumCode, accumUsed) passArguments ((arg,arg_ty):args) gprs fprs stackOffset @@ -974,7 +974,7 @@ genCCall target dest_regs argsAndHints ChildCode64 code vr_lo <- iselExpr64 arg let vr_hi = getHiVRegFromLo vr_lo -#if darwin_TARGET_OS +#if darwin_TARGET_OS passArguments args (drop 2 gprs) fprs @@ -986,7 +986,7 @@ genCCall target dest_regs argsAndHints where storeWord vr (gpr:_) offset = MR gpr vr storeWord vr [] offset = ST II32 vr (AddrRegImm sp (ImmInt offset)) - + #elif linux_TARGET_OS let stackOffset' = roundTo 8 stackOffset stackCode = accumCode `appOL` code @@ -996,7 +996,7 @@ genCCall target dest_regs argsAndHints accumCode `appOL` code `snocOL` MR hireg vr_hi `snocOL` MR loreg vr_lo - + case gprs of hireg : loreg : regs | even (length gprs) -> passArguments args regs fprs stackOffset @@ -1008,7 +1008,7 @@ genCCall target dest_regs argsAndHints passArguments args [] fprs (stackOffset'+8) stackCode accumUsed #endif - + passArguments ((arg,rep):args) gprs fprs stackOffset accumCode accumUsed | reg : _ <- regs = do register <- getRegister arg @@ -1043,7 +1043,7 @@ genCCall target dest_regs argsAndHints #else -- ... the SysV ABI requires 8-byte alignment for doubles. stackOffset' | isFloatType rep && typeWidth rep == W64 = - roundTo 8 stackOffset + roundTo 8 stackOffset | otherwise = stackOffset #endif stackSlot = AddrRegImm sp (ImmInt stackOffset') @@ -1059,7 +1059,7 @@ genCCall target dest_regs argsAndHints FF32 -> (0, 1, 4, fprs) FF64 -> (0, 1, 8, fprs) #endif - + moveResult reduceToFF32 = case dest_regs of [] -> nilOL @@ -1071,7 +1071,7 @@ genCCall target dest_regs argsAndHints | otherwise -> unitOL (MR r_dest r3) where rep = cmmRegType (CmmLocal dest) r_dest = getRegisterReg (CmmLocal dest) - + outOfLineMachOp mop = do dflags <- getDynFlagsNat @@ -1086,32 +1086,32 @@ genCCall target dest_regs argsAndHints MO_F32_Exp -> (fsLit "exp", True) MO_F32_Log -> (fsLit "log", True) MO_F32_Sqrt -> (fsLit "sqrt", True) - + MO_F32_Sin -> (fsLit "sin", True) MO_F32_Cos -> (fsLit "cos", True) MO_F32_Tan -> (fsLit "tan", True) - + MO_F32_Asin -> (fsLit "asin", True) MO_F32_Acos -> (fsLit "acos", True) MO_F32_Atan -> (fsLit "atan", True) - + MO_F32_Sinh -> (fsLit "sinh", True) MO_F32_Cosh -> (fsLit "cosh", True) MO_F32_Tanh -> (fsLit "tanh", True) MO_F32_Pwr -> (fsLit "pow", True) - + MO_F64_Exp -> (fsLit "exp", False) MO_F64_Log -> (fsLit "log", False) MO_F64_Sqrt -> (fsLit "sqrt", False) - + MO_F64_Sin -> (fsLit "sin", False) MO_F64_Cos -> (fsLit "cos", False) MO_F64_Tan -> (fsLit "tan", False) - + MO_F64_Asin -> (fsLit "asin", False) MO_F64_Acos -> (fsLit "acos", False) MO_F64_Atan -> (fsLit "atan", False) - + MO_F64_Sinh -> (fsLit "sinh", False) MO_F64_Cosh -> (fsLit "cosh", False) MO_F64_Tanh -> (fsLit "tanh", False) @@ -1126,14 +1126,14 @@ genCCall target dest_regs argsAndHints #else /* darwin_TARGET_OS || linux_TARGET_OS */ genCCall = panic "PPC.CodeGen.genCCall: not defined for this os" -#endif +#endif -- ----------------------------------------------------------------------------- -- Generating a table-branch genSwitch :: CmmExpr -> [Maybe BlockId] -> NatM InstrBlock -genSwitch expr ids +genSwitch expr ids | opt_PIC = do (reg,e_code) <- getSomeReg expr @@ -1182,7 +1182,7 @@ generateJumpTableForInstr _ = Nothing -- Turn those condition codes into integers now (when they appear on -- the right hand side of an assignment). --- +-- -- (If applicable) Do not fill the delay slots here; you will confuse the -- register allocator. @@ -1207,27 +1207,27 @@ condReg getCond = do MFCR dst, RLWINM dst dst (bit + 1) 31 31 ] - + negate_code | do_negate = unitOL (CRNOR bit bit bit) | otherwise = nilOL - + (bit, do_negate) = case cond of LTT -> (0, False) LE -> (1, True) EQQ -> (2, False) GE -> (0, True) GTT -> (1, False) - + NE -> (2, True) - + LU -> (0, False) LEU -> (1, True) GEU -> (0, True) GU -> (1, False) - _ -> panic "PPC.CodeGen.codeReg: no match" - + _ -> panic "PPC.CodeGen.codeReg: no match" + return (Any II32 code) - + condIntReg cond x y = condReg (condIntCode cond x y) condFltReg cond x y = condReg (condFltCode cond x y) @@ -1257,38 +1257,38 @@ clobber any fixed registers. * The only expression for which getRegister returns Fixed is (CmmReg reg). * If getRegister returns Any, then the code it generates may modify only: - (a) fresh temporaries - (b) the destination register + (a) fresh temporaries + (b) the destination register It may *not* modify global registers, unless the global register happens to be the destination register. It may not clobber any other registers. In fact, only ccalls clobber any fixed registers. Also, it may not modify the counter register (used by genCCall). - + Corollary: If a getRegister for a subexpression returns Fixed, you need not move it to a fresh temporary before evaluating the next subexpression. The Fixed register won't be modified. Therefore, we don't need a counterpart for the x86's getStableReg on PPC. - + * SDM's First Rule is valid for PowerPC, too: subexpressions can depend on the value of the destination register. -} -trivialCode - :: Width - -> Bool - -> (Reg -> Reg -> RI -> Instr) - -> CmmExpr - -> CmmExpr - -> NatM Register +trivialCode + :: Width + -> Bool + -> (Reg -> Reg -> RI -> Instr) + -> CmmExpr + -> CmmExpr + -> NatM Register trivialCode rep signed instr x (CmmLit (CmmInt y _)) - | Just imm <- makeImmediate rep signed y + | Just imm <- makeImmediate rep signed y = do (src1, code1) <- getSomeReg x let code dst = code1 `snocOL` instr dst src1 (RIImm imm) return (Any (intSize rep) code) - + trivialCode rep _ instr x y = do (src1, code1) <- getSomeReg x (src2, code2) <- getSomeReg y @@ -1296,28 +1296,28 @@ trivialCode rep _ instr x y = do return (Any (intSize rep) code) trivialCodeNoImm' :: Size -> (Reg -> Reg -> Reg -> Instr) - -> CmmExpr -> CmmExpr -> NatM Register + -> CmmExpr -> CmmExpr -> NatM Register trivialCodeNoImm' size instr x y = do (src1, code1) <- getSomeReg x (src2, code2) <- getSomeReg y let code dst = code1 `appOL` code2 `snocOL` instr dst src1 src2 return (Any size code) - + trivialCodeNoImm :: Size -> (Size -> Reg -> Reg -> Reg -> Instr) - -> CmmExpr -> CmmExpr -> NatM Register + -> CmmExpr -> CmmExpr -> NatM Register trivialCodeNoImm size instr x y = trivialCodeNoImm' size (instr size) x y - - -trivialUCode - :: Size - -> (Reg -> Reg -> Instr) - -> CmmExpr - -> NatM Register + + +trivialUCode + :: Size + -> (Reg -> Reg -> Instr) + -> CmmExpr + -> NatM Register trivialUCode rep instr x = do (src, code) <- getSomeReg x let code' dst = code `snocOL` instr dst src return (Any rep code') - + -- There is no "remainder" instruction on the PPC, so we have to do -- it the hard way. -- The "div" parameter is the division instruction to use (DIVW or DIVWU) @@ -1345,32 +1345,32 @@ coerceInt2FP fromRep toRep x = do dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl Amode addr addr_code <- getAmode dynRef let - code' dst = code `appOL` maybe_exts `appOL` toOL [ - LDATA ReadOnlyData - [CmmDataLabel lbl, - CmmStaticLit (CmmInt 0x43300000 W32), - CmmStaticLit (CmmInt 0x80000000 W32)], - XORIS itmp src (ImmInt 0x8000), - ST II32 itmp (spRel 3), - LIS itmp (ImmInt 0x4330), - ST II32 itmp (spRel 2), - LD FF64 ftmp (spRel 2) + code' dst = code `appOL` maybe_exts `appOL` toOL [ + LDATA ReadOnlyData + [CmmDataLabel lbl, + CmmStaticLit (CmmInt 0x43300000 W32), + CmmStaticLit (CmmInt 0x80000000 W32)], + XORIS itmp src (ImmInt 0x8000), + ST II32 itmp (spRel 3), + LIS itmp (ImmInt 0x4330), + ST II32 itmp (spRel 2), + LD FF64 ftmp (spRel 2) ] `appOL` addr_code `appOL` toOL [ - LD FF64 dst addr, - FSUB FF64 dst ftmp dst - ] `appOL` maybe_frsp dst - + LD FF64 dst addr, + FSUB FF64 dst ftmp dst + ] `appOL` maybe_frsp dst + maybe_exts = case fromRep of W8 -> unitOL $ EXTS II8 src src W16 -> unitOL $ EXTS II16 src src W32 -> nilOL - _ -> panic "PPC.CodeGen.coerceInt2FP: no match" + _ -> panic "PPC.CodeGen.coerceInt2FP: no match" - maybe_frsp dst - = case toRep of + maybe_frsp dst + = case toRep of W32 -> unitOL $ FRSP dst dst W64 -> nilOL - _ -> panic "PPC.CodeGen.coerceInt2FP: no match" + _ -> panic "PPC.CodeGen.coerceInt2FP: no match" return (Any (floatSize toRep) code') @@ -1380,11 +1380,11 @@ coerceFP2Int _ toRep x = do (src, code) <- getSomeReg x tmp <- getNewRegNat FF64 let - code' dst = code `appOL` toOL [ - -- convert to int in FP reg - FCTIWZ tmp src, - -- store value (64bit) from FP to stack - ST FF64 tmp (spRel 2), - -- read low word of value (high word is undefined) - LD II32 dst (spRel 3)] + code' dst = code `appOL` toOL [ + -- convert to int in FP reg + FCTIWZ tmp src, + -- store value (64bit) from FP to stack + ST FF64 tmp (spRel 2), + -- read low word of value (high word is undefined) + LD II32 dst (spRel 3)] return (Any (intSize toRep) code') -- 1.7.10.4