Commit efd78ac5 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Small refactor

Moved the default case of genCCall64 out into a separate function
parent 1b7dfd7f
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment