From: simonmar Date: Wed, 27 Apr 2005 09:57:14 +0000 (+0000) Subject: [project @ 2005-04-27 09:57:14 by simonmar] X-Git-Tag: Initial_conversion_from_CVS_complete~661 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=eec59c80b2733b11be71c109e7fd908cc4e49fbd;p=ghc-hetmet.git [project @ 2005-04-27 09:57:14 by simonmar] x86_64: hang register parameters off the call instruction, like powerpc does. This gives the register allocator better information. --- diff --git a/ghc/compiler/nativeGen/MachCodeGen.hs b/ghc/compiler/nativeGen/MachCodeGen.hs index dc4c91f..20693ce 100644 --- a/ghc/compiler/nativeGen/MachCodeGen.hs +++ b/ghc/compiler/nativeGen/MachCodeGen.hs @@ -3108,12 +3108,12 @@ genCCall target dest_regs args vols = do -- CmmPrim -> ... CmmForeignCall (CmmLit (CmmLabel lbl)) conv -> -- ToDo: stdcall arg sizes - return (unitOL (CALL (Left fn_imm)), conv) + return (unitOL (CALL (Left fn_imm) []), conv) where fn_imm = ImmCLbl lbl CmmForeignCall expr conv -> do (dyn_c, dyn_r, dyn_rep) <- get_op expr ASSERT(dyn_rep == I32) - return (dyn_c `snocOL` CALL (Right dyn_r), conv) + return (dyn_c `snocOL` CALL (Right dyn_r) [], conv) let push_code = concatOL push_codes call = callinsns `appOL` @@ -3270,10 +3270,17 @@ genCCall (CmmPrim op) [(r,_)] args vols = genCCall target dest_regs args vols = do -- load up the register arguments - (stack_args, sse_regs, load_args_code) - <- load_args args allArgRegs allFPArgRegs 0 nilOL + (stack_args, aregs, fregs, load_args_code) + <- load_args args allArgRegs allFPArgRegs nilOL let + fp_regs_used = reverse (drop (length fregs) (reverse allFPArgRegs)) + int_regs_used = reverse (drop (length aregs) (reverse allArgRegs)) + arg_regs = int_regs_used ++ fp_regs_used + -- for annotating the call instruction with + + sse_regs = length fp_regs_used + tot_arg_size = arg_size * length stack_args -- On entry to the called function, %rsp should be aligned @@ -3305,11 +3312,11 @@ genCCall target dest_regs args vols = do -- CmmPrim -> ... CmmForeignCall (CmmLit (CmmLabel lbl)) conv -> -- ToDo: stdcall arg sizes - return (unitOL (CALL (Left fn_imm)), conv) + return (unitOL (CALL (Left fn_imm) arg_regs), conv) where fn_imm = ImmCLbl lbl CmmForeignCall expr conv -> do (dyn_r, dyn_c) <- getSomeReg expr - return (dyn_c `snocOL` CALL (Right dyn_r), conv) + return (dyn_c `snocOL` CALL (Right dyn_r) arg_regs, conv) let -- The x86_64 ABI requires us to set %al to the number of SSE @@ -3360,31 +3367,31 @@ genCCall target dest_regs args vols = do load_args :: [(CmmExpr,MachHint)] -> [Reg] -- int regs avail for args -> [Reg] -- FP regs avail for args - -> Int -> InstrBlock - -> NatM ([(CmmExpr,MachHint)],Int,InstrBlock) - load_args args [] [] sse_regs code = return (args, sse_regs, code) + -> InstrBlock + -> NatM ([(CmmExpr,MachHint)],[Reg],[Reg],InstrBlock) + load_args args [] [] code = return (args, [], [], code) -- no more regs to use - load_args [] aregs fregs sse_regs code = return ([],sse_regs,code) + load_args [] aregs fregs code = return ([], aregs, fregs, code) -- no more args to push - load_args ((arg,hint) : rest) aregs fregs sse_regs code + load_args ((arg,hint) : rest) aregs fregs code | isFloatingRep arg_rep = case fregs of [] -> push_this_arg (r:rs) -> do arg_code <- getAnyReg arg - load_args rest aregs rs (sse_regs+1) (code `appOL` arg_code r) + load_args rest aregs rs (code `appOL` arg_code r) | otherwise = case aregs of [] -> push_this_arg (r:rs) -> do arg_code <- getAnyReg arg - load_args rest rs fregs sse_regs (code `appOL` arg_code r) + load_args rest rs fregs (code `appOL` arg_code r) where arg_rep = cmmExprRep arg push_this_arg = do - (args',sse',code') <- load_args rest aregs fregs sse_regs code - return ((arg,hint):args', sse', code') + (args',ars,frs,code') <- load_args rest aregs fregs code + return ((arg,hint):args', ars, frs, code') push_args [] code = return code push_args ((arg,hint):rest) code diff --git a/ghc/compiler/nativeGen/MachInstrs.hs b/ghc/compiler/nativeGen/MachInstrs.hs index c86f3d1..1a4c4b8 100644 --- a/ghc/compiler/nativeGen/MachInstrs.hs +++ b/ghc/compiler/nativeGen/MachInstrs.hs @@ -504,7 +504,7 @@ bit or 64 bit precision. | JMP Operand | JXX Cond BlockId -- includes unconditional branches | JMP_TBL Operand [BlockId] -- table jump - | CALL (Either Imm Reg) + | CALL (Either Imm Reg) [Reg] -- Other things. | CLTD MachRep -- sign extend %eax into %edx:%eax diff --git a/ghc/compiler/nativeGen/PprMach.hs b/ghc/compiler/nativeGen/PprMach.hs index d1f72f1..61faf24 100644 --- a/ghc/compiler/nativeGen/PprMach.hs +++ b/ghc/compiler/nativeGen/PprMach.hs @@ -1283,8 +1283,8 @@ pprInstr (JXX cond (BlockId id)) pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm) pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand wordRep op) pprInstr (JMP_TBL op ids) = pprInstr (JMP op) -pprInstr (CALL (Left imm)) = (<>) (ptext SLIT("\tcall ")) (pprImm imm) -pprInstr (CALL (Right reg)) = (<>) (ptext SLIT("\tcall *")) (pprReg wordRep reg) +pprInstr (CALL (Left imm) _) = (<>) (ptext SLIT("\tcall ")) (pprImm imm) +pprInstr (CALL (Right reg) _) = (<>) (ptext SLIT("\tcall *")) (pprReg wordRep reg) pprInstr (IDIV sz op) = pprSizeOp SLIT("idiv") sz op pprInstr (DIV sz op) = pprSizeOp SLIT("div") sz op diff --git a/ghc/compiler/nativeGen/RegAllocInfo.hs b/ghc/compiler/nativeGen/RegAllocInfo.hs index 86630cf..1987c28 100644 --- a/ghc/compiler/nativeGen/RegAllocInfo.hs +++ b/ghc/compiler/nativeGen/RegAllocInfo.hs @@ -171,13 +171,8 @@ regUsage instr = case instr of JXX cond lbl -> mkRU [] [] JMP op -> mkRU (use_R op) [] JMP_TBL op ids -> mkRU (use_R op) [] -#if i386_TARGET_ARCH - CALL (Left imm) -> mkRU [] callClobberedRegs - CALL (Right reg) -> mkRU [reg] callClobberedRegs -#else - CALL (Left imm) -> mkRU params callClobberedRegs - CALL (Right reg) -> mkRU (reg:params) callClobberedRegs -#endif + CALL (Left imm) params -> mkRU params callClobberedRegs + CALL (Right reg) params -> mkRU (reg:params) callClobberedRegs CLTD sz -> mkRU [eax] [edx] NOP -> mkRU [] [] @@ -540,8 +535,8 @@ patchRegs instr env = case instr of FDIV sz src dst -> FDIV sz (patchOp src) (patchOp dst) #endif - CALL (Left imm) -> instr - CALL (Right reg) -> CALL (Right (env reg)) + CALL (Left imm) _ -> instr + CALL (Right reg) p -> CALL (Right (env reg)) p FETCHGOT reg -> FETCHGOT (env reg)