From 60ea58ab5cbf8428997d5aa8ec9163a50fe5aed3 Mon Sep 17 00:00:00 2001 From: wolfgang Date: Wed, 10 Dec 2003 11:35:26 +0000 Subject: [PATCH] [project @ 2003-12-10 11:35:24 by wolfgang] PowerPC Linux support for registerised compilation and native code generation. (object splitting and GHCi are still unsupported). Code for other platforms is not affected, so MERGE TO STABLE. --- ghc/compiler/nativeGen/MachCode.lhs | 121 ++++++++++++++++++++++++++++++++++- ghc/compiler/nativeGen/MachMisc.lhs | 3 +- ghc/compiler/nativeGen/MachRegs.lhs | 36 +++++++++++ ghc/compiler/nativeGen/PprMach.lhs | 21 +++++- ghc/driver/mangler/ghc-asm.lprl | 43 ++++++++++++- ghc/includes/MachRegs.h | 16 ++++- ghc/rts/StgCRun.c | 78 +++++++++++++++++++++- 7 files changed, 312 insertions(+), 6 deletions(-) diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs index b810575..7ec09a1 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 63379cb..a641a8a 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 494b983..b7c1680 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 945fab4..0a6b136 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) diff --git a/ghc/driver/mangler/ghc-asm.lprl b/ghc/driver/mangler/ghc-asm.lprl index 8a58e53..3c386e2 100644 --- a/ghc/driver/mangler/ghc-asm.lprl +++ b/ghc/driver/mangler/ghc-asm.lprl @@ -312,7 +312,7 @@ sub init_TARGET_STUFF { # Apple PowerPC Darwin/MacOS X. $T_STABBY = 0; # 1 iff .stab things (usually if a.out format) $T_US = '_'; # _ if symbols have an underscore on the front - $T_PRE_APP = 'WHAT IS THIS'; # regexp that says what comes before APP/NO_APP + $T_PRE_APP = 'DOESNT APPLY'; # regexp that says what comes before APP/NO_APP $T_CONST_LBL = '^\LC\d+:'; # regexp for what such a lbl looks like $T_POST_LBL = ':'; @@ -335,6 +335,33 @@ sub init_TARGET_STUFF { $T_HDR_direct = "\t\.text\n\t\.align 2\n"; #--------------------------------------------------------# + } elsif ( $TargetPlatform =~ /^powerpc-.*-linux/ ) { + # PowerPC Linux + $T_STABBY = 0; # 1 iff .stab things (usually if a.out format) + $T_US = ''; # _ if symbols have an underscore on the front + $T_PRE_APP = '^#'; # regexp that says what comes before APP/NO_APP + $T_CONST_LBL = '^\.LC\d+:'; # regexp for what such a lbl looks like + $T_POST_LBL = ':'; + + $T_MOVE_DIRVS = '^(\s*(\.(p2)?align\s+\d+(,\s*0x90)?|\.globl\s+\S+|\.text|\.data|\.section\s+.*|\.type\s+.*|\.size\s+\S+\s*,\s*\d+|\.ident.*|\.local.*)\n)'; + $T_COPY_DIRVS = '^\s*\.(globl|type|size|local)'; + + $T_hsc_cc_PAT = '\.string.*\)(hsc|cc) (.*)\\\\t(.*)"'; + $T_DOT_WORD = '\.(long|short|byte|fill|space)'; + $T_DOT_GLOBAL = '\.globl'; + $T_HDR_toc = "\.toc\n"; + $T_HDR_literal = "\t\.section\t.rodata\n\t\.align 2\n"; + $T_HDR_misc = "\t\.text\n\t\.align 2\n"; + $T_HDR_data = "\t\.data\n\t\.align 2\n"; + $T_HDR_consist = "\t\.text\n\t\.align 2\n"; + $T_HDR_closure = "\t\.data\n\t\.align 2\n"; + $T_HDR_srt = "\t\.text\n\t\.align 2\n"; + $T_HDR_info = "\t\.text\n\t\.align 2\n"; + $T_HDR_entry = "\t\.text\n\t\.align 2\n"; + $T_HDR_vector = "\t\.text\n\t\.align 2\n"; + $T_HDR_direct = "\t\.text\n\t\.align 2\n"; + + #--------------------------------------------------------# } elsif ( $TargetPlatform =~ /^sparc-.*-(solaris2|openbsd)/ ) { $T_STABBY = 0; # 1 iff .stab things (usually if a.out format) @@ -792,6 +819,19 @@ sub mangle_asm { # I have no idea why, and I don't think it is necessary, so let's toss it. $p =~ s/^\tli r\d+,0\n//g; $p =~ s/^\tstw r\d+,\d+\(r1\)\n//g; + } elsif ($TargetPlatform =~ /^powerpc-.*-linux/) { + $p =~ s/^\tmflr 0\n//; + $p =~ s/^\tstmw \d+,\d+\(1\)\n//; + $p =~ s/^\tstfd \d+,\d+\(1\)\n//g; + $p =~ s/^\tstw r0,8\(1\)\n//; + $p =~ s/^\tstwu 1,-\d+\(1\)\n//; + $p =~ s/^\tstw \d+,\d+\(1\)\n//g; + + # This is bad: GCC 3 seems to zero-fill some local variables in the prologue + # under some circumstances, only when generating position dependent code. + # I have no idea why, and I don't think it is necessary, so let's toss it. + $p =~ s/^\tli \d+,0\n//g; + $p =~ s/^\tstw \d+,\d+\(1\)\n//g; } else { print STDERR "$Pgm: unknown prologue mangling? $TargetPlatform\n"; } @@ -878,6 +918,7 @@ sub mangle_asm { $c =~ s/^\t(call|jbsr|jal)\s+${T_US}__DISCARD__\n//go; $c =~ s/^\tjsr\s+\$26\s*,\s*${T_US}__DISCARD__\n//go if $TargetPlatform =~ /^alpha-/; $c =~ s/^\tbl\s+L___DISCARD__\$stub\n//go if $TargetPlatform =~ /^powerpc-apple-.*/; + $c =~ s/^\tbl\s+__DISCARD__\n//go if $TargetPlatform =~ /^powerpc-.*-linux/; # IA64: mangle tailcalls into jumps here if ($TargetPlatform =~ /^ia64-/) { diff --git a/ghc/includes/MachRegs.h b/ghc/includes/MachRegs.h index 0c25a61..c54de67 100644 --- a/ghc/includes/MachRegs.h +++ b/ghc/includes/MachRegs.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: MachRegs.h,v 1.14 2003/08/29 16:00:26 simonmar Exp $ + * $Id: MachRegs.h,v 1.15 2003/12/10 11:35:25 wolfgang Exp $ * * (c) The GHC Team, 1998-1999 * @@ -409,6 +409,8 @@ #define REG_R7 r20 #define REG_R8 r21 +#ifdef darwin_TARGET_OS + #define REG_F1 f14 #define REG_F2 f15 #define REG_F3 f16 @@ -417,6 +419,18 @@ #define REG_D1 f18 #define REG_D2 f19 +#else + +#define REG_F1 fr14 +#define REG_F2 fr15 +#define REG_F3 fr16 +#define REG_F4 fr17 + +#define REG_D1 fr18 +#define REG_D2 fr19 + +#endif + #define REG_Sp r22 #define REG_SpLim r24 diff --git a/ghc/rts/StgCRun.c b/ghc/rts/StgCRun.c index 94ee2a5..8efa48f 100644 --- a/ghc/rts/StgCRun.c +++ b/ghc/rts/StgCRun.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: StgCRun.c,v 1.40 2003/08/29 16:13:48 simonmar Exp $ + * $Id: StgCRun.c,v 1.41 2003/12/10 11:35:26 wolfgang Exp $ * * (c) The GHC Team, 1998-2003 * @@ -530,6 +530,7 @@ StgRun(StgFunPtr f, StgRegTable *basereg) extern StgThreadReturnCode StgRun(StgFunPtr f, StgRegTable *basereg); +#ifdef darwin_TARGET_OS static void StgRunIsImplementedInAssembler(void) { __asm__ volatile ( @@ -550,6 +551,81 @@ static void StgRunIsImplementedInAssembler(void) "\tb restFP # f14\n" : : "i"(RESERVED_C_STACK_BYTES+288 /*stack frame size*/)); } +#else + +// This version is for PowerPC Linux. + +// Differences from the Darwin/Mac OS X version: +// *) Different Assembler Syntax +// *) Doesn't use Register Saving Helper Functions (although they exist somewhere) +// *) We may not access positive stack offsets +// (no "Red Zone" as in the Darwin ABI) +// *) The Link Register is saved to a different offset in the caller's stack frame +// (Linux: 4(r1), Darwin 8(r1)) + +static void StgRunIsImplementedInAssembler(void) +{ + __asm__ volatile ( + "\t.globl StgRun\n" + "\t.type StgRun,@function\n" + "StgRun:\n" + "\tmflr 0\n" + "\tstw 0,4(1)\n" + "\tmr 5,1\n" + "\tstwu 1,-%0(1)\n" + "\tstmw 13,-220(5)\n" + "\tstfd 14,-144(5)\n" + "\tstfd 15,-136(5)\n" + "\tstfd 16,-128(5)\n" + "\tstfd 17,-120(5)\n" + "\tstfd 18,-112(5)\n" + "\tstfd 19,-104(5)\n" + "\tstfd 20,-96(5)\n" + "\tstfd 21,-88(5)\n" + "\tstfd 22,-80(5)\n" + "\tstfd 23,-72(5)\n" + "\tstfd 24,-64(5)\n" + "\tstfd 25,-56(5)\n" + "\tstfd 26,-48(5)\n" + "\tstfd 27,-40(5)\n" + "\tstfd 28,-32(5)\n" + "\tstfd 29,-24(5)\n" + "\tstfd 30,-16(5)\n" + "\tstfd 31,-8(5)\n" + "\tmtctr 3\n" + "\tmr 12,3\n" + "\tbctr\n" + ".globl StgReturn\n" + "\t.type StgReturn,@function\n" + "StgReturn:\n" + "\tmr 3,14\n" + "\tla 5,%0(1)\n" + "\tlmw 13,-220(5)\n" + "\tlfd 14,-144(5)\n" + "\tlfd 15,-136(5)\n" + "\tlfd 16,-128(5)\n" + "\tlfd 17,-120(5)\n" + "\tlfd 18,-112(5)\n" + "\tlfd 19,-104(5)\n" + "\tlfd 20,-96(5)\n" + "\tlfd 21,-88(5)\n" + "\tlfd 22,-80(5)\n" + "\tlfd 23,-72(5)\n" + "\tlfd 24,-64(5)\n" + "\tlfd 25,-56(5)\n" + "\tlfd 26,-48(5)\n" + "\tlfd 27,-40(5)\n" + "\tlfd 28,-32(5)\n" + "\tlfd 29,-24(5)\n" + "\tlfd 30,-16(5)\n" + "\tlfd 31,-8(5)\n" + "\tmr 1,5\n" + "\tlwz 0,4(1)\n" + "\tmtlr 0\n" + "\tblr\n" + : : "i"(RESERVED_C_STACK_BYTES+288 /*stack frame size*/)); +} +#endif #endif -- 1.7.10.4