[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.

7 files changed, 312 insertions, 6 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)
diff --git a/ghc/driver/mangler/ghc-asm.lprl b/ghc/driver/mangler/ghc-asm.lprl
index 8a58e530f7..3c386e2c34 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 0c25a61e14..c54de67e98 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 94ee2a5f1f..8efa48fe1d 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