summaryrefslogtreecommitdiff
path: root/ghc/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'ghc/compiler')
-rw-r--r--ghc/compiler/nativeGen/MachCode.lhs121
-rw-r--r--ghc/compiler/nativeGen/MachMisc.lhs3
-rw-r--r--ghc/compiler/nativeGen/MachRegs.lhs36
-rw-r--r--ghc/compiler/nativeGen/PprMach.lhs21
4 files changed, 178 insertions, 3 deletions
diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs
index b810575d62..7ec09a1ad6 100644
--- a/ghc/compiler/nativeGen/MachCode.lhs
+++ b/ghc/compiler/nativeGen/MachCode.lhs
@@ -3484,8 +3484,10 @@ genCCall fn cconv kind args
#endif /* sparc_TARGET_ARCH */
#if powerpc_TARGET_ARCH
+
+#if darwin_TARGET_OS
{-
- The PowerPC calling convention (at least for Darwin/Mac OS X)
+ The PowerPC calling convention for Darwin/Mac OS X
is described in Apple's document
"Inside Mac OS X - Mach-O Runtime Architecture".
Parameters may be passed in general-purpose registers, in
@@ -3592,6 +3594,123 @@ genCCall fn cconv kind args
`snocOL` storeWord vr_hi gprs stackOffset
`snocOL` storeWord vr_lo (drop 1 gprs) (stackOffset+4))
((take 2 gprs) ++ accumUsed)
+#else
+
+{-
+ 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".
+
+ Like the Darwin/Mac OS X code above, this allocates a new stack frame
+ so that the parameter area doesn't conflict with the spill slots.
+-}
+
+genCCall fn cconv kind args
+ = mapNat prepArg args `thenNat` \ preppedArgs ->
+ let
+ (argReps,argCodes,vregs) = unzip3 preppedArgs
+
+ -- size of linkage area + size of arguments, in bytes
+ stackDelta = roundTo16 finalStack
+ roundTo16 x | x `mod` 16 == 0 = x
+ | otherwise = x + 16 - (x `mod` 16)
+
+ move_sp_down = toOL [STU W sp (AddrRegImm sp (ImmInt (-stackDelta))), DELTA (-stackDelta)]
+ move_sp_up = toOL [ADD sp sp (RIImm (ImmInt stackDelta)), DELTA 0]
+
+ (moveFinalCode,usedRegs,finalStack) =
+ move_final (zip vregs argReps)
+ allArgRegs allFPArgRegs
+ eXTRA_STK_ARGS_HERE
+ (toOL []) []
+
+ passArguments = concatOL argCodes
+ `appOL` move_sp_down
+ `appOL` moveFinalCode
+ in
+ case fn of
+ Left lbl ->
+ addImportNat lbl `thenNat` \ _ ->
+ returnNat (passArguments
+ `snocOL` BL (ImmLit $ ftext lbl)
+ usedRegs
+ `appOL` move_sp_up)
+ Right dyn ->
+ getRegister dyn `thenNat` \ dynReg ->
+ getNewRegNCG (registerRep dynReg) `thenNat` \ tmp ->
+ returnNat (registerCode dynReg tmp
+ `appOL` passArguments
+ `snocOL` MTCTR (registerName dynReg tmp)
+ `snocOL` BCTRL usedRegs
+ `appOL` move_sp_up)
+ where
+ prepArg arg
+ | is64BitRep (repOfStixExpr arg)
+ = iselExpr64 arg `thenNat` \ (ChildCode64 code vr_lo) ->
+ let r_lo = VirtualRegI vr_lo
+ r_hi = getHiVRegFromLo r_lo
+ in returnNat (repOfStixExpr arg, code, Right (r_hi,r_lo))
+ | otherwise
+ = getRegister arg `thenNat` \ register ->
+ getNewRegNCG (registerRep register) `thenNat` \ tmp ->
+ returnNat (registerRep register, registerCode register tmp, Left (registerName register tmp))
+ move_final [] _ _ stackOffset accumCode accumUsed = (accumCode, accumUsed, stackOffset)
+ move_final ((Left vr,rep):vregs) gprs fprs stackOffset accumCode accumUsed
+ | not (is64BitRep rep) =
+ case rep of
+ FloatRep ->
+ case fprs of
+ fpr : fprs' -> move_final vregs gprs fprs' stackOffset
+ (accumCode `snocOL` MR fpr vr)
+ (fpr : accumUsed)
+ [] -> move_final vregs gprs fprs (stackOffset+4)
+ (accumCode `snocOL`
+ ST F vr (AddrRegImm sp (ImmInt stackOffset)))
+ accumUsed
+ DoubleRep ->
+ case fprs of
+ fpr : fprs' -> move_final vregs gprs fprs' stackOffset
+ (accumCode `snocOL` MR fpr vr)
+ (fpr : accumUsed)
+ [] -> move_final vregs gprs fprs (stackOffset+8)
+ (accumCode `snocOL`
+ ST DF vr (AddrRegImm sp (ImmInt stackOffset)))
+ accumUsed
+ VoidRep -> panic "MachCode.genCCall(powerpc): void parameter"
+ _ ->
+ case gprs of
+ gpr : gprs' -> move_final vregs gprs' fprs stackOffset
+ (accumCode `snocOL` MR gpr vr)
+ (gpr : accumUsed)
+ [] -> move_final vregs gprs fprs (stackOffset+4)
+ (accumCode `snocOL`
+ ST W vr (AddrRegImm sp (ImmInt stackOffset)))
+ accumUsed
+
+ move_final ((Right (vr_hi,vr_lo),rep):vregs) gprs fprs stackOffset accumCode accumUsed
+ | is64BitRep rep =
+ case gprs of
+ hireg : loreg : regs | even (length gprs) ->
+ move_final vregs regs fprs stackOffset
+ (regCode hireg loreg) accumUsed
+ _skipped : hireg : loreg : regs ->
+ move_final vregs regs fprs stackOffset
+ (regCode hireg loreg) accumUsed
+ _ -> -- only one or no regs left
+ move_final vregs [] fprs (stackOffset+8)
+ stackCode accumUsed
+ where
+ stackCode =
+ accumCode
+ `snocOL` ST W vr_hi (AddrRegImm sp (ImmInt stackOffset))
+ `snocOL` ST W vr_lo (AddrRegImm sp (ImmInt (stackOffset+4)))
+ regCode hireg loreg =
+ accumCode
+ `snocOL` MR hireg vr_hi
+ `snocOL` MR loreg vr_lo
+
+#endif
+
#endif /* powerpc_TARGET_ARCH */
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
diff --git a/ghc/compiler/nativeGen/MachMisc.lhs b/ghc/compiler/nativeGen/MachMisc.lhs
index 63379cba32..a641a8a327 100644
--- a/ghc/compiler/nativeGen/MachMisc.lhs
+++ b/ghc/compiler/nativeGen/MachMisc.lhs
@@ -94,7 +94,8 @@ where do we start putting the rest of them?
\begin{code}
eXTRA_STK_ARGS_HERE :: Int
eXTRA_STK_ARGS_HERE
- = IF_ARCH_alpha(0, IF_ARCH_i386(23{-6x4bytes-}, IF_ARCH_sparc(23, IF_ARCH_powerpc(24,???))))
+ = IF_ARCH_alpha(0, IF_ARCH_i386(23{-6x4bytes-}, IF_ARCH_sparc(23,
+ IF_ARCH_powerpc( IF_OS_darwin(24,8{-SVR4 ABI: Linux-}), ???))))
\end{code}
% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
diff --git a/ghc/compiler/nativeGen/MachRegs.lhs b/ghc/compiler/nativeGen/MachRegs.lhs
index 494b9835fc..b7c1680a02 100644
--- a/ghc/compiler/nativeGen/MachRegs.lhs
+++ b/ghc/compiler/nativeGen/MachRegs.lhs
@@ -726,6 +726,8 @@ names in the header files. Gag me with a spoon, eh?
#define r29 29
#define r30 30
#define r31 31
+
+#ifdef darwin_TARGET_OS
#define f0 32
#define f1 33
#define f2 34
@@ -758,6 +760,40 @@ names in the header files. Gag me with a spoon, eh?
#define f29 61
#define f30 62
#define f31 63
+#else
+#define fr0 32
+#define fr1 33
+#define fr2 34
+#define fr3 35
+#define fr4 36
+#define fr5 37
+#define fr6 38
+#define fr7 39
+#define fr8 40
+#define fr9 41
+#define fr10 42
+#define fr11 43
+#define fr12 44
+#define fr13 45
+#define fr14 46
+#define fr15 47
+#define fr16 48
+#define fr17 49
+#define fr18 50
+#define fr19 51
+#define fr20 52
+#define fr21 53
+#define fr22 54
+#define fr23 55
+#define fr24 56
+#define fr25 57
+#define fr26 58
+#define fr27 59
+#define fr28 60
+#define fr29 61
+#define fr30 62
+#define fr31 63
+#endif
#endif
\end{code}
diff --git a/ghc/compiler/nativeGen/PprMach.lhs b/ghc/compiler/nativeGen/PprMach.lhs
index 945fab4267..0a6b136ac5 100644
--- a/ghc/compiler/nativeGen/PprMach.lhs
+++ b/ghc/compiler/nativeGen/PprMach.lhs
@@ -177,6 +177,7 @@ pprReg IF_ARCH_i386(s,) r
})
#endif
#if powerpc_TARGET_ARCH
+#if darwin_TARGET_OS
ppr_reg_no :: Int -> Doc
ppr_reg_no i = ptext
(case i of {
@@ -214,6 +215,12 @@ pprReg IF_ARCH_i386(s,) r
62 -> SLIT("f30"); 63 -> SLIT("f31");
_ -> SLIT("very naughty powerpc register")
})
+#else
+ ppr_reg_no :: Int -> Doc
+ ppr_reg_no i | i <= 31 = int i -- GPRs
+ | i <= 63 = int (i-32) -- FPRs
+ | otherwise = ptext SLIT("very naughty powerpc register")
+#endif
#endif
\end{code}
@@ -366,6 +373,7 @@ pprImm (HI i)
pp_hi = text "%hi("
#endif
#if powerpc_TARGET_ARCH
+#if darwin_TARGET_OS
pprImm (LO i)
= hcat [ pp_lo, pprImm i, rparen ]
where
@@ -380,6 +388,16 @@ pprImm (HA i)
= hcat [ pp_ha, pprImm i, rparen ]
where
pp_ha = text "ha16("
+#else
+pprImm (LO i)
+ = pprImm i <> text "@l"
+
+pprImm (HI i)
+ = pprImm i <> text "@h"
+
+pprImm (HA i)
+ = pprImm i <> text "@ha"
+#endif
#endif
\end{code}
@@ -506,7 +524,8 @@ pprInstr (SEGMENT RoDataSegment)
IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
,IF_ARCH_i386(SLIT(".section .rodata\n\t.align 4")
- ,IF_ARCH_powerpc(SLIT(".const_data\n.align 2")
+ ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
+ SLIT(".section .rodata\n\t.align 2"))
,))))
pprInstr (LABEL clab)
View Lorry Controller Status