[project @ 2003-06-09 13:17:38 by matthewc]

Update IA64 port to work with gcc 3.3.

ghc/compiler/codeGen/ClosureInfo.lhs

 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: ClosureInfo.lhs,v 1.57 2003/05/14 09:13:56 simonmar Exp $
+% $Id: ClosureInfo.lhs,v 1.58 2003/06/09 13:17:38 matthewc Exp $
 %
 \section[ClosureInfo]{Data structures which describe closures}
 
@@ -1127,8 +1127,8 @@ represented by a label+offset expression).
 \begin{code}
 mkInfoTable :: ClosureInfo -> [CAddrMode]
 mkInfoTable cl_info
- | opt_Unregisterised = std_info ++ extra_bits
- | otherwise          = extra_bits ++ std_info
+ | tablesNextToCode = extra_bits ++ std_info
+ | otherwise        = std_info ++ extra_bits
  where
     std_info = mkStdInfoTable entry_amode
 		  ty_descr_amode cl_descr_amode cl_type srt_len layout_amode
@@ -1184,8 +1184,8 @@ mkInfoTable cl_info
     (Just (arity, arg_descr)) = maybe_fun_stuff
 
     fun_extra_bits
-	| opt_Unregisterised = reverse reg_fun_extra_bits
-	| otherwise 	     = reg_fun_extra_bits
+	| tablesNextToCode = reg_fun_extra_bits
+	| otherwise        = reverse reg_fun_extra_bits
 
     reg_fun_extra_bits
 	| ArgGen slow_lbl liveness <- arg_descr
@@ -1229,8 +1229,8 @@ mkBitmapInfoTable
    -> [CAddrMode]
    -> [CAddrMode]
 mkBitmapInfoTable entry_amode srt liveness vector
- | opt_Unregisterised = std_info ++ extra_bits
- | otherwise          = extra_bits ++ std_info
+ | tablesNextToCode = extra_bits ++ std_info
+ | otherwise        = std_info ++ extra_bits
  where
    std_info = mkStdInfoTable entry_amode zero_amode zero_amode 
 		cl_type srt_len liveness_amode
@@ -1253,8 +1253,8 @@ mkBitmapInfoTable entry_amode srt liveness vector
    srt_bit | needsSRT srt || not (null vector) = [srt_label]
 	   | otherwise = []
 
-   extra_bits | opt_Unregisterised = srt_bit ++ vector
-	      | otherwise          = reverse vector ++ srt_bit
+   extra_bits | tablesNextToCode = reverse vector ++ srt_bit
+              | otherwise        = srt_bit ++ vector
 
 -- The standard bits of an info table.  This part of the info table
 -- corresponds to the StgInfoTable type defined in InfoTables.h.
@@ -1271,8 +1271,8 @@ mkStdInfoTable entry_lbl type_descr closure_descr cl_type srt_len layout_amode
  = std_info
  where  
     std_info
-	| opt_Unregisterised  = entry_lbl : std_info'
-	| otherwise 	      = std_info'
+	| tablesNextToCode = std_info'
+	| otherwise        = entry_lbl : std_info'
 
     std_info' =
 	  -- par info
@@ -1312,4 +1312,12 @@ livenessToAddrMode (Liveness lbl size bits)
 			_   -> panic "livenessToAddrMode"
 
 zero_amode = mkIntCLit 0
+
+-- IA64 mangler doesn't place tables next to code
+tablesNextToCode :: Bool
+#ifdef ia64_TARGET_ARCH
+tablesNextToCode = False
+#else
+tablesNextToCode = not opt_Unregisterised
+#endif
 \end{code}

ghc/driver/mangler/ghc-asm.lprl

@@ -701,12 +701,18 @@ sub mangle_asm {
 
 		} elsif ($TargetPlatform =~ /^ia64-/) {
 		    $p =~ s/^\t\.prologue .*\n//;
-		    $p =~ s/^\t\.save ar\.pfs, r\d+\n\talloc r\d+ = ar\.pfs, 0, 31, \d+, 0\n//;
+		    $p =~ s/^\t\.save ar\.pfs, r\d+\n\talloc r\d+ = ar\.pfs, 0, 3[12], \d+, 0\n//;
 		    $p =~ s/^\t\.fframe \d+\n\tadds r12 = -\d+, r12\n//;
 		    $p =~ s/^\t\.save rp, r\d+\n\tmov r\d+ = b0\n//;
-		    $p =~ s/^\t\.(mii|mmi)\n//;	# bundling is no longer sensible
+		    $p =~ s/^\t\.(mii|mmi)\n//g;	# bundling is no longer sensible
 		    $p =~ s/^\t;;\n//g;		# discard stops
 		    $p =~ s/^\t\/\/.*\n//g;	# gcc inserts timings in // comments
+
+		    # GCC 3.3 saves r1 in the prologue, move this to the body
+		    if ($p =~ /^\tmov r\d+ = r1\n/) {
+			  $p = $` . $';
+			  $r = $& . $r;
+		    }
 		} elsif ($TargetPlatform =~ /^m68k-/) {
 		    $p =~ s/^\tlink a6,#-?\d.*\n//;
  		    $p =~ s/^\tpea a6@\n\tmovel sp,a6\n//;    
@@ -840,8 +846,13 @@ sub mangle_asm {
 	$c =~ s/^\tbl\s+L___DISCARD__\$stub\n//go if $TargetPlatform =~ /^powerpc-apple-.*/;
 
 	# IA64: mangle tailcalls into jumps here
-	$c =~ s/^\tbr\.call\.sptk\.many b0 = (.*)\n\t;;\n(\tmov r1 = r\d+\n)?\t;;\n\t--- TAILCALL ---\n/\tbr\.few $1\n/g
-		if $TargetPlatform =~ /^ia64-/;
+	if ($TargetPlatform =~ /^ia64-/) {
+	    while ($c =~ s/^\tbr\.call\.sptk\.many b0 = (.*)\n(?:^\.L([0-9]*):\n)?(?:\t;;\n)?(?:\tmov r1 = r\d+\n)?(?:\t;;\n)?\t--- TAILCALL ---\n(?:\t;;\n\tbr \.L\d+\n)?/\tbr\.few $1\n/) {
+		# Eek, the gcc optimiser is getting smarter... if we see a jump to the --- TAILCALL ---
+		# marker then we reapply the substitution at the source sites
+		$c =~ s/^\tbr \.L$2\n/\t--- TAILCALL ---\n/g if ($2);
+	    }
+	}
 
 	# MIPS: that may leave some gratuitous asm macros around
 	# (no harm done; but we get rid of them to be tidier)

ghc/rts/Linker.c

 /* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.120 2003/05/30 09:06:24 simonmar Exp $
+ * $Id: Linker.c,v 1.121 2003/06/09 13:17:40 matthewc Exp $
  *
  * (c) The GHC Team, 2000-2003
  *
@@ -553,18 +553,18 @@ typedef struct _RtsSymbolVal {
       Sym(__ashrdi3)				\
       Sym(__lshrdi3)				\
       Sym(__eprintf)
+#elif defined(ia64_TARGET_ARCH)
+#define RTS_LIBGCC_SYMBOLS			\
+      Sym(__divdi3)				\
+      Sym(__udivdi3)                            \
+      Sym(__moddi3)				\
+      Sym(__umoddi3)				\
+      Sym(__divsf3)				\
+      Sym(__divdf3)
 #else
 #define RTS_LIBGCC_SYMBOLS
 #endif
 
-#ifdef ia64_TARGET_ARCH
-/* force these symbols to be present */
-#define RTS_EXTRA_SYMBOLS			\
-      Sym(__divsf3)
-#else
-#define RTS_EXTRA_SYMBOLS /* nothing */
-#endif
-
 #ifdef darwin_TARGET_OS
       // Symbols that don't have a leading underscore
       // on Mac OS X. They have to receive special treatment,
@@ -575,12 +575,11 @@ typedef struct _RtsSymbolVal {
 #endif
 
 /* entirely bogus claims about types of these symbols */
-#define Sym(vvv)  extern void (vvv);
+#define Sym(vvv)  extern void vvv();
 #define SymX(vvv) /**/
 #define SymX_redirect(vvv,xxx) /**/
 RTS_SYMBOLS
 RTS_LONG_LONG_SYMS
-RTS_EXTRA_SYMBOLS
 RTS_POSIX_ONLY_SYMBOLS
 RTS_MINGW_ONLY_SYMBOLS
 RTS_CYGWIN_ONLY_SYMBOLS
@@ -608,7 +607,6 @@ RTS_LIBGCC_SYMBOLS
 static RtsSymbolVal rtsSyms[] = {
       RTS_SYMBOLS
       RTS_LONG_LONG_SYMS
-      RTS_EXTRA_SYMBOLS
       RTS_POSIX_ONLY_SYMBOLS
       RTS_MINGW_ONLY_SYMBOLS
       RTS_CYGWIN_ONLY_SYMBOLS
@@ -2708,8 +2706,8 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
 #ifdef ELF_FUNCTION_DESC
 	    /* If a function, already a function descriptor - we would
 	       have to copy it to add an offset. */
-            if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC)
-               assert(A == 0);
+            if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
+               belch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
 #endif
 	 }
          if (!S) {
@@ -2768,6 +2766,9 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
 	 case R_IA64_FPTR64LSB:
 	    *pP = value;
 	    break;
+	 case R_IA64_PCREL64LSB:
+	    *pP = value - P;
+	    break;
 	 case R_IA64_SEGREL64LSB:
 	    addr = findElfSegment(ehdrC, value);
 	    *pP = value - addr;
@@ -2776,6 +2777,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
 	    ia64_reloc_gprel22(P, value);
 	    break;
 	 case R_IA64_LTOFF22:
+	 case R_IA64_LTOFF22X:
 	 case R_IA64_LTOFF_FPTR22:
 	    addr = allocateGOTEntry(value);
 	    ia64_reloc_gprel22(P, addr);
@@ -2783,6 +2785,10 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
 	 case R_IA64_PCREL21B:
 	    ia64_reloc_pcrel21(P, S, oc);
 	    break;
+	 case R_IA64_LDXMOV:
+	    /* This goes with R_IA64_LTOFF22X and points to the load to
+	     * convert into a move.  We don't implement relaxation. */
+	    break;
 #        endif
          default:
             belch("%s: unhandled ELF relocation(RelA) type %d\n",

ghc/rts/RtsUtils.h

 /* -----------------------------------------------------------------------------
- * $Id: RtsUtils.h,v 1.16 2003/03/31 19:19:34 sof Exp $
+ * $Id: RtsUtils.h,v 1.17 2003/06/09 13:17:40 matthewc Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -27,7 +27,7 @@ extern void resetNonBlockingFd(int fd);
 extern nat stg_strlen(char *str);
 
 /*Defined in Main.c, but made visible here*/
-extern void stg_exit(I_ n) __attribute__((noreturn));
+extern void stg_exit(int n) __attribute__((noreturn));
 
 char *time_str(void);
 char *ullong_format_string(ullong, char *, rtsBool);

ghc/rts/StgCRun.c

 /* -----------------------------------------------------------------------------
- * $Id: StgCRun.c,v 1.38 2003/01/31 17:29:46 wolfgang Exp $
+ * $Id: StgCRun.c,v 1.39 2003/06/09 13:17:41 matthewc Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -498,6 +498,7 @@ static void StgRunIsImplementedInAssembler(void)
    loc16 - loc28: STG registers
            loc29: saved ar.pfs
            loc30: saved b0
+           loc31: saved gp (gcc 3.3 uses this slot)
    -------------------------------------------------------------------------- */
 
 #ifdef ia64_TARGET_ARCH
@@ -506,12 +507,19 @@ static void StgRunIsImplementedInAssembler(void)
 #undef RESERVED_C_STACK_BYTES
 #define RESERVED_C_STACK_BYTES 1024
 
+#if ((__GNUC__ == 3) && (__GNUC_MINOR__ >= 3)) || (__GNUC__ > 3)
+/* gcc 3.3+: leave an extra slot for gp saves */
+#define LOCALS 32
+#else
+#define LOCALS 31
+#endif
+
 static void StgRunIsImplementedInAssembler(void)
 {
     __asm__ volatile(
 		".global StgRun\n"
 		"StgRun:\n"
-		"\talloc loc29 = ar.pfs, 0, 31, 8, 0\n"	/* setup register frame */
+		"\talloc loc29 = ar.pfs, 0, %1, 8, 0\n"	/* setup register frame */
 		"\tld8 r18 = [r32],8\n"			/* get procedure address */
 		"\tadds sp = -%0, sp ;;\n"		/* setup stack */
 		"\tld8 gp = [r32]\n"			/* get procedure GP */
@@ -541,7 +549,7 @@ static void StgRunIsImplementedInAssembler(void)
 		"\tldf.fill f21 = [r17],32\n"
 		"\tadds sp = %0, sp\n"		/* restore stack */
 		"\tbr.ret.sptk.many b0 ;;\n"	/* return */
-	: : "i"(RESERVED_C_STACK_BYTES + 6*16));
+	: : "i"(RESERVED_C_STACK_BYTES + 6*16), "i"(LOCALS));
 }
 
 #endif