Small refactor

Moved the default case of genCCall64 out into a separate function

1 files changed, 92 insertions, 87 deletions

diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index b45ea1e1b0..7900b3ee81 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -1857,97 +1857,102 @@ genCCall64 target dest_regs args =
                               MOV size (OpReg rdx) (OpReg reg_r)]
         _ -> panic "genCCall64: Wrong number of arguments for MO_S_QuotRem"
 
-    _ -> do
-        -- load up the register arguments
-        (stack_args, aregs, fregs, load_args_code)
-             <- load_args args allArgRegs allFPArgRegs nilOL
+    _ -> genCCall64' target dest_regs args
 
-        let
-            fp_regs_used  = reverse (drop (length fregs) (reverse allFPArgRegs))
-            int_regs_used = reverse (drop (length aregs) (reverse allArgRegs))
-            arg_regs = [eax] ++ 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
-
-
-        -- Align stack to 16n for calls, assuming a starting stack
-        -- alignment of 16n - word_size on procedure entry. Which we
-        -- maintiain. See Note [rts/StgCRun.c : Stack Alignment on X86]
-        (real_size, adjust_rsp) <-
-            if (tot_arg_size + wORD_SIZE) `rem` 16 == 0
-                then return (tot_arg_size, nilOL)
-                else do -- we need to adjust...
-                    delta <- getDeltaNat
-                    setDeltaNat (delta - wORD_SIZE)
-                    return (tot_arg_size + wORD_SIZE, toOL [
-                                    SUB II64 (OpImm (ImmInt wORD_SIZE)) (OpReg rsp),
-                                    DELTA (delta - wORD_SIZE) ])
-
-        -- push the stack args, right to left
-        push_code <- push_args (reverse stack_args) nilOL
-        delta <- getDeltaNat
+genCCall64' :: CmmCallTarget            -- function to call
+            -> [HintedCmmFormal]        -- where to put the result
+            -> [HintedCmmActual]        -- arguments (of mixed type)
+            -> NatM InstrBlock
+genCCall64' target dest_regs args = do
+    -- load up the register arguments
+    (stack_args, aregs, fregs, load_args_code)
+         <- load_args args allArgRegs allFPArgRegs nilOL
 
-        -- deal with static vs dynamic call targets
-        (callinsns,_cconv) <-
-          case target of
-            CmmCallee (CmmLit (CmmLabel lbl)) conv
-               -> -- ToDo: stdcall arg sizes
-                  return (unitOL (CALL (Left fn_imm) arg_regs), conv)
-               where fn_imm = ImmCLbl lbl
-            CmmCallee expr conv
-               -> do (dyn_r, dyn_c) <- getSomeReg expr
-                     return (dyn_c `snocOL` CALL (Right dyn_r) arg_regs, conv)
-            CmmPrim _
-                -> panic $ "genCCall: Can't handle CmmPrim call type here, error "
-                            ++ "probably because too many return values."
-
-        let
-            -- The x86_64 ABI requires us to set %al to the number of SSE2
-            -- registers that contain arguments, if the called routine
-            -- is a varargs function.  We don't know whether it's a
-            -- varargs function or not, so we have to assume it is.
-            --
-            -- It's not safe to omit this assignment, even if the number
-            -- of SSE2 regs in use is zero.  If %al is larger than 8
-            -- on entry to a varargs function, seg faults ensue.
-            assign_eax n = unitOL (MOV II32 (OpImm (ImmInt n)) (OpReg eax))
-
-        let call = callinsns `appOL`
-                   toOL (
-                        -- Deallocate parameters after call for ccall;
-                        -- stdcall has callee do it, but is not supported on
-                        -- x86_64 target (see #3336)
-                      (if real_size==0 then [] else
-                       [ADD (intSize wordWidth) (OpImm (ImmInt real_size)) (OpReg esp)])
-                      ++
-                      [DELTA (delta + real_size)]
-                   )
-        -- in
-        setDeltaNat (delta + real_size)
+    let
+        fp_regs_used  = reverse (drop (length fregs) (reverse allFPArgRegs))
+        int_regs_used = reverse (drop (length aregs) (reverse allArgRegs))
+        arg_regs = [eax] ++ 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
+
+
+    -- Align stack to 16n for calls, assuming a starting stack
+    -- alignment of 16n - word_size on procedure entry. Which we
+    -- maintiain. See Note [rts/StgCRun.c : Stack Alignment on X86]
+    (real_size, adjust_rsp) <-
+        if (tot_arg_size + wORD_SIZE) `rem` 16 == 0
+            then return (tot_arg_size, nilOL)
+            else do -- we need to adjust...
+                delta <- getDeltaNat
+                setDeltaNat (delta - wORD_SIZE)
+                return (tot_arg_size + wORD_SIZE, toOL [
+                                SUB II64 (OpImm (ImmInt wORD_SIZE)) (OpReg rsp),
+                                DELTA (delta - wORD_SIZE) ])
+
+    -- push the stack args, right to left
+    push_code <- push_args (reverse stack_args) nilOL
+    delta <- getDeltaNat
+
+    -- deal with static vs dynamic call targets
+    (callinsns,_cconv) <-
+      case target of
+        CmmCallee (CmmLit (CmmLabel lbl)) conv
+           -> -- ToDo: stdcall arg sizes
+              return (unitOL (CALL (Left fn_imm) arg_regs), conv)
+           where fn_imm = ImmCLbl lbl
+        CmmCallee expr conv
+           -> do (dyn_r, dyn_c) <- getSomeReg expr
+                 return (dyn_c `snocOL` CALL (Right dyn_r) arg_regs, conv)
+        CmmPrim _
+            -> panic $ "genCCall: Can't handle CmmPrim call type here, error "
+                        ++ "probably because too many return values."
 
-        let
-            -- assign the results, if necessary
-            assign_code []     = nilOL
-            assign_code [CmmHinted dest _hint] =
-              case typeWidth rep of
-                    W32 | isFloatType rep -> unitOL (MOV (floatSize W32) (OpReg xmm0) (OpReg r_dest))
-                    W64 | isFloatType rep -> unitOL (MOV (floatSize W64) (OpReg xmm0) (OpReg r_dest))
-                    _ -> unitOL (MOV (cmmTypeSize rep) (OpReg rax) (OpReg r_dest))
-              where
-                    rep = localRegType dest
-                    r_dest = getRegisterReg True (CmmLocal dest)
-            assign_code _many = panic "genCCall.assign_code many"
-
-        return (load_args_code      `appOL`
-                adjust_rsp          `appOL`
-                push_code           `appOL`
-                assign_eax sse_regs `appOL`
-                call                `appOL`
-                assign_code dest_regs)
+    let
+        -- The x86_64 ABI requires us to set %al to the number of SSE2
+        -- registers that contain arguments, if the called routine
+        -- is a varargs function.  We don't know whether it's a
+        -- varargs function or not, so we have to assume it is.
+        --
+        -- It's not safe to omit this assignment, even if the number
+        -- of SSE2 regs in use is zero.  If %al is larger than 8
+        -- on entry to a varargs function, seg faults ensue.
+        assign_eax n = unitOL (MOV II32 (OpImm (ImmInt n)) (OpReg eax))
+
+    let call = callinsns `appOL`
+               toOL (
+                    -- Deallocate parameters after call for ccall;
+                    -- stdcall has callee do it, but is not supported on
+                    -- x86_64 target (see #3336)
+                  (if real_size==0 then [] else
+                   [ADD (intSize wordWidth) (OpImm (ImmInt real_size)) (OpReg esp)])
+                  ++
+                  [DELTA (delta + real_size)]
+               )
+    -- in
+    setDeltaNat (delta + real_size)
 
-      where
-        arg_size = 8 -- always, at the mo
+    let
+        -- assign the results, if necessary
+        assign_code []     = nilOL
+        assign_code [CmmHinted dest _hint] =
+          case typeWidth rep of
+                W32 | isFloatType rep -> unitOL (MOV (floatSize W32) (OpReg xmm0) (OpReg r_dest))
+                W64 | isFloatType rep -> unitOL (MOV (floatSize W64) (OpReg xmm0) (OpReg r_dest))
+                _ -> unitOL (MOV (cmmTypeSize rep) (OpReg rax) (OpReg r_dest))
+          where
+                rep = localRegType dest
+                r_dest = getRegisterReg True (CmmLocal dest)
+        assign_code _many = panic "genCCall.assign_code many"
+
+    return (load_args_code      `appOL`
+            adjust_rsp          `appOL`
+            push_code           `appOL`
+            assign_eax sse_regs `appOL`
+            call                `appOL`
+            assign_code dest_regs)
+
+  where arg_size = 8 -- always, at the mo
 
         load_args :: [CmmHinted CmmExpr]
                   -> [Reg]                  -- int regs avail for args