From 8e9c95ac7ad62c5ce6d39e52ac8da6936f19da4c Mon Sep 17 00:00:00 2001 From: "dias@eecs.tufts.edu" Date: Mon, 23 Mar 2009 18:22:14 +0000 Subject: [PATCH] Code simplification due to separate call/return conventions --- compiler/cmm/CmmCallConv.hs | 48 ++++++++++++++++++++++++++---------------- compiler/cmm/MkZipCfgCmm.hs | 11 +++++----- compiler/cmm/ZipCfgCmmRep.hs | 12 +++++------ 3 files changed, 41 insertions(+), 30 deletions(-) diff --git a/compiler/cmm/CmmCallConv.hs b/compiler/cmm/CmmCallConv.hs index 7c67107..7b3dd0d 100644 --- a/compiler/cmm/CmmCallConv.hs +++ b/compiler/cmm/CmmCallConv.hs @@ -54,24 +54,36 @@ assignArgumentsPos :: (Outputable a) => Convention -> Bool -> (a -> CmmType) -> ArgumentFormat a ByteOff assignArgumentsPos conv isCall arg_ty reps = map cvt assignments where -- The calling conventions (CgCallConv.hs) are complicated, to say the least - regs = if isCall then - case (reps, conv) of - (_, NativeNodeCall) -> getRegsWithNode - (_, NativeDirectCall) -> getRegsWithoutNode - (_, GC ) -> getRegsWithNode - (_, PrimOpCall) -> allRegs - (_, Slow ) -> noRegs - _ -> pprPanic "Unknown calling convention" (ppr conv) - else - case (reps, conv) of - ([_], _) -> allRegs - (_, NativeNodeCall) -> getRegsWithNode - (_, NativeDirectCall) -> getRegsWithoutNode - (_, NativeReturn) -> getRegsWithNode - (_, GC ) -> getRegsWithNode - (_, PrimOpReturn) -> getRegsWithNode - (_, Slow ) -> noRegs - _ -> pprPanic "Unknown calling convention" (ppr conv) + regs = case (reps, conv) of + (_, NativeNodeCall) -> getRegsWithNode + (_, NativeDirectCall) -> getRegsWithoutNode + ([_], NativeReturn) -> allRegs + (_, NativeReturn) -> getRegsWithNode + (_, GC) -> getRegsWithNode + (_, PrimOpCall) -> allRegs + ([_], PrimOpReturn) -> allRegs + (_, PrimOpReturn) -> getRegsWithNode + (_, Slow) -> noRegs + _ -> pprPanic "Unknown calling convention" (ppr conv) + -- regs = if isCall then + -- case (reps, conv) of + -- (_, NativeNodeCall) -> getRegsWithNode + -- (_, NativeDirectCall) -> getRegsWithoutNode + -- (_, GC ) -> getRegsWithNode + -- (_, PrimOpCall) -> allRegs + -- (_, Slow ) -> noRegs + -- _ -> pprPanic "Unknown calling convention" (ppr conv) + -- else + -- case (reps, conv) of + -- (_, NativeNodeCall) -> getRegsWithNode + -- (_, NativeDirectCall) -> getRegsWithoutNode + -- ([_], NativeReturn) -> allRegs + -- (_, NativeReturn) -> getRegsWithNode + -- (_, GC) -> getRegsWithNode + -- ([_], PrimOpReturn) -> allRegs + -- (_, PrimOpReturn) -> getRegsWithNode + -- (_, Slow) -> noRegs + -- _ -> pprPanic "Unknown calling convention" (ppr conv) -- (_, NativeCall) -> getRegsWithoutNode -- (_, GC ) -> getRegsWithNode -- (_, PrimOpCall) -> allRegs diff --git a/compiler/cmm/MkZipCfgCmm.hs b/compiler/cmm/MkZipCfgCmm.hs index b47185b..4b2c022 100644 --- a/compiler/cmm/MkZipCfgCmm.hs +++ b/compiler/cmm/MkZipCfgCmm.hs @@ -64,11 +64,11 @@ mkCall :: CmmExpr -> (Convention, Convention) -> CmmFormals -> CmmActuals UpdFrameOffset -> CmmAGraph mkCmmCall :: CmmExpr -> CmmFormals -> CmmActuals -> UpdFrameOffset -> CmmAGraph - -- Native C-- calling convention + -- Native C-- calling convention mkSafeCall :: MidCallTarget -> CmmFormals -> CmmActuals -> UpdFrameOffset -> CmmAGraph mkUnsafeCall :: MidCallTarget -> CmmFormals -> CmmActuals -> CmmAGraph mkFinalCall :: CmmExpr -> CCallConv -> CmmActuals -> UpdFrameOffset -> CmmAGraph - -- Never returns; like exit() or barf() + -- Never returns; like exit() or barf() ---------- Control transfer mkJump :: CmmExpr -> CmmActuals -> UpdFrameOffset -> CmmAGraph @@ -158,19 +158,18 @@ copyInSlot c i f = snd $ copyIn oneCopySlotI c i (panic "no area for copying to type SlotCopier = Area -> (LocalReg, ByteOff) -> (ByteOff, CmmAGraph) -> (ByteOff, CmmAGraph) -type CopyIn = SlotCopier -> Convention -> Bool -> Area -> CmmFormals -> - (ByteOff, CmmAGraph) +type CopyIn = SlotCopier -> Convention -> Area -> CmmFormals -> (ByteOff, CmmAGraph) -- Return the number of bytes used for copying arguments, as well as the -- instructions to copy the arguments. copyIn :: CopyIn -copyIn oflow conv isCall area formals = +copyIn oflow conv area formals = foldr ci (init_offset, mkNop) args' where ci (reg, RegisterParam r) (n, ms) = (n, mkAssign (CmmLocal reg) (CmmReg $ CmmGlobal r) <*> ms) ci (r, StackParam off) (n, ms) = oflow area (r, off) (n, ms) init_offset = widthInBytes wordWidth -- infotable - args = assignArgumentsPos conv isCall localRegType formals + args = assignArgumentsPos conv localRegType formals args' = foldl adjust [] args where adjust rst (v, StackParam off) = (v, StackParam (off + init_offset)) : rst adjust rst x@(_, RegisterParam _) = x : rst diff --git a/compiler/cmm/ZipCfgCmmRep.hs b/compiler/cmm/ZipCfgCmmRep.hs index b08f2f3..d821b03 100644 --- a/compiler/cmm/ZipCfgCmmRep.hs +++ b/compiler/cmm/ZipCfgCmmRep.hs @@ -114,17 +114,17 @@ data Convention | NativeNodeCall -- Native C-- call including the node argument - | NativeReturn -- Native C-- return + | NativeReturn -- Native C-- return - | Slow -- Slow entry points: all args pushed on the stack + | Slow -- Slow entry points: all args pushed on the stack - | GC -- Entry to the garbage collector: uses the node reg! + | GC -- Entry to the garbage collector: uses the node reg! - | PrimOpCall -- Calling prim ops + | PrimOpCall -- Calling prim ops - | PrimOpReturn -- Returning from prim ops + | PrimOpReturn -- Returning from prim ops - | Foreign -- Foreign call/return + | Foreign -- Foreign call/return ForeignConvention | Private -- 1.7.10.4