* sibcall.c (skip_copy_to_return_value): Call

	identify_call_return_value here, and return orig_insn if it
	returns zero.  Hardret and softret arguments now unnecessary.
	(call_ends_block_p): Don't call identify_call_return_value here.

	* ggc-common.c (ggc_mark_rtx_children): No need to mark 'S' or
	's' slots in RTXen.
	* ggc-page.c, ggc-simple.c (ggc_mark_if_gcable): Delete	function.
	* ggc.h (ggc_mark_if_gcable): Delete prototype.

testsuite:
	* g77.dg: New directory.
	* g77.dg/20010216-1.f: New test case.
	* g77.dg/dg.exp: New driver.
	* lib/g77-dg.exp: New driver library.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@39916 138bc75d-0d04-0410-961f-82ee72b054a4

10 files changed, 280 insertions, 51 deletions

diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index e6ebfe761f1..af312cd6b7a 100644
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,3 +1,15 @@
+2001-02-19  Zack Weinberg  <zackw@stanford.edu>
+
+	* sibcall.c (skip_copy_to_return_value): Call
+	identify_call_return_value here, and return orig_insn if it
+	returns zero.  Hardret and softret arguments now unnecessary.
+	(call_ends_block_p): Don't call identify_call_return_value here.
+
+	* ggc-common.c (ggc_mark_rtx_children): No need to mark 'S' or
+	's' slots in RTXen.
+	* ggc-page.c, ggc-simple.c (ggc_mark_if_gcable): Delete	function.
+	* ggc.h (ggc_mark_if_gcable): Delete prototype.
+
 Mon Feb 19 20:30:16 2001  Jeffrey A Law  (law@cygnus.com)
 
 	* pa.c (move_operand): Accept code to load the address of a
diff --git a/gcc/ggc-common.c b/gcc/ggc-common.c
index 44f8cc2a1c7..cb75a75f4be 100644
--- a/gcc/ggc-common.c
+++ b/gcc/ggc-common.c
@@ -1,5 +1,5 @@
 /* Simple garbage collection for the GNU compiler.
-   Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+   Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc.
 
 This file is part of GNU CC.
 
@@ -277,9 +277,6 @@ ggc_mark_rtx_children (r)
 	    case 'V': case 'E':
 	      ggc_mark_rtvec (XVEC (r, i));
 	      break;
-	    case 'S': case 's':
-	      ggc_mark_if_gcable (XSTR (r, i));
-	      break;
 	    }
 	}
     }
diff --git a/gcc/ggc-page.c b/gcc/ggc-page.c
index 4738ed248dd..559183e2d34 100644
--- a/gcc/ggc-page.c
+++ b/gcc/ggc-page.c
@@ -1001,16 +1001,6 @@ ggc_set_mark (p)
   return 0;
 }
 
-/* Mark P, but check first that it was allocated by the collector.  */
-
-void
-ggc_mark_if_gcable (p)
-     const void *p;
-{
-  if (p && ggc_allocated_p (p))
-    ggc_set_mark (p);
-}
-
 /* Return the size of the gc-able object P.  */
 
 size_t
diff --git a/gcc/ggc-simple.c b/gcc/ggc-simple.c
index b5cab1bcb23..457b420f260 100644
--- a/gcc/ggc-simple.c
+++ b/gcc/ggc-simple.c
@@ -1,5 +1,5 @@
 /* Simple garbage collection for the GNU compiler.
-   Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+   Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
 
    This file is part of GNU CC.
 
@@ -228,29 +228,6 @@ ggc_set_mark (p)
   return 0;
 }
 
-/* Mark a node, but check first to see that it's really gc-able memory.  */
-
-void
-ggc_mark_if_gcable (p)
-     const void *p;
-{
-  struct ggc_mem *x;
-
-  if (p == NULL)
-    return;
-
-  x = (struct ggc_mem *) ((const char *)p - offsetof (struct ggc_mem, u));
-  if (! tree_lookup (x))
-    return;
-
-  if (x->mark)
-    return;
-
-  x->mark = 1;
-  G.allocated += x->size;
-  G.objects += 1;
-}
-
 /* Return the size of the gc-able object P.  */
 
 size_t
diff --git a/gcc/ggc.h b/gcc/ggc.h
index e222916a5a6..3decec35615 100644
--- a/gcc/ggc.h
+++ b/gcc/ggc.h
@@ -1,5 +1,5 @@
 /* Garbage collection for the GNU compiler.
-   Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
+   Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
 
 This file is part of GNU CC.
 
@@ -99,9 +99,6 @@ extern void ggc_mark_rtvec_children PARAMS ((struct rtvec_def *));
       ggc_set_mark (a__);			\
   } while (0)
 
-/* Mark, but only if it was allocated in collectable memory.  */
-extern void ggc_mark_if_gcable PARAMS ((const void *));
-
 /* A GC implementation must provide these functions.  */
 
 /* Initialize the garbage collector.   */
@@ -141,8 +138,8 @@ const char *ggc_alloc_string PARAMS ((const char *contents, int length));
 /* Make a copy of S, in GC-able memory.  */
 #define ggc_strdup(S) ggc_alloc_string((S), -1)
 
-/* Invoke the collector.  This is really just a hint, but in the case of
-   the simple collector, the only time it will happen.  */
+/* Invoke the collector.  Garbage collection occurs only when this
+   function is called, not during allocations.  */
 void ggc_collect PARAMS ((void));
 
 /* Actually set the mark on a particular region of memory, but don't
diff --git a/gcc/sibcall.c b/gcc/sibcall.c
index 67b1e85f8c4..e00e8b790d6 100644
--- a/gcc/sibcall.c
+++ b/gcc/sibcall.c
@@ -33,7 +33,7 @@ Boston, MA 02111-1307, USA.  */
 #include "except.h"
 
 static int identify_call_return_value	PARAMS ((rtx, rtx *, rtx *));
-static rtx skip_copy_to_return_value	PARAMS ((rtx, rtx, rtx));
+static rtx skip_copy_to_return_value	PARAMS ((rtx));
 static rtx skip_use_of_return_value	PARAMS ((rtx, enum rtx_code));
 static rtx skip_stack_adjustment	PARAMS ((rtx));
 static rtx skip_pic_restore		PARAMS ((rtx));
@@ -133,11 +133,15 @@ identify_call_return_value (cp, p_hard_return, p_soft_return)
    copy.  Otherwise return ORIG_INSN.  */
 
 static rtx
-skip_copy_to_return_value (orig_insn, hardret, softret)
+skip_copy_to_return_value (orig_insn)
      rtx orig_insn;
-     rtx hardret, softret;
 {
   rtx insn, set = NULL_RTX;
+  rtx hardret, softret;
+
+  /* If there is no return value, we have nothing to do.  */
+  if (! identify_call_return_value (PATTERN (orig_insn), &hardret, &softret))
+    return orig_insn;
 
   insn = next_nonnote_insn (orig_insn);
   if (! insn)
@@ -265,8 +269,6 @@ call_ends_block_p (insn, end)
      rtx insn;
      rtx end;
 {
-  rtx hardret, softret;
-
   /* END might be a note, so get the last nonnote insn of the block.  */
   end = next_nonnote_insn (PREV_INSN (end));
 
@@ -277,8 +279,7 @@ call_ends_block_p (insn, end)
   /* Skip over copying from the call's return value pseudo into
      this function's hard return register and if that's the end
      of the block, we're OK.  */
-  identify_call_return_value (PATTERN (insn), &hardret, &softret);
-  insn = skip_copy_to_return_value (insn, hardret, softret);
+  insn = skip_copy_to_return_value (insn);
   if (insn == end)
     return 1;
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 998ef715732..62549f89f1d 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2001-02-19  Zack Weinberg  <zackw@stanford.edu>
+
+	* g77.dg: New directory.
+	* g77.dg/20010216-1.f: New test case.
+	* g77.dg/dg.exp: New driver.
+	* lib/g77-dg.exp: New driver library.
+
 2001-02-18  Kriang Lerdsuwanakij  <lerdsuwa@users.sourceforge.net>
 
 	* g++.old-deja/g++.other/inline19.c: Remove XFAIL.
diff --git a/gcc/testsuite/g77.dg/20010216-1.f b/gcc/testsuite/g77.dg/20010216-1.f
new file mode 100644
index 00000000000..150dc9f016a
--- /dev/null
+++ b/gcc/testsuite/g77.dg/20010216-1.f
@@ -0,0 +1,51 @@
+C Test for bug in reg-stack handling conditional moves.
+C Reported by Tim Prince <tprince@computer.org>
+C
+C { dg-do run { target "i[6789]86-*-*" } }
+C { dg-options "-ffast-math -march=pentiumpro" }
+
+      double precision function foo(x, y)
+         implicit none
+         double precision x, y
+         double precision a, b, c, d
+         if (x /= y) then
+             if (x * y >= 0) then
+                 a = abs(x)
+                 b = abs(y)
+                 c = max(a, b)
+                 d = min(a, b)
+                 foo = 1 - d/c
+             else       
+                 foo = 1
+             end if  
+         else
+             foo = 0
+         end if
+      end
+
+      program test
+      implicit none
+
+      integer ntests
+      parameter (ntests=7)
+      double precision tolerance
+      parameter (tolerance=1.0D-6)
+
+C Each column is a pair of values to feed to foo,
+C and its expected return value.
+      double precision a(ntests) /1, -23, -1,   1,   9,  10,  -9/
+      double precision b(ntests) /1, -23, 12, -12,  10,   9, -10/
+      double precision x(ntests) /0,   0,  1,   1, 0.1, 0.1, 0.1/
+
+      double precision foo
+      double precision result
+      integer i
+
+      do i = 1, ntests
+         result = foo(a(i), b(i))
+         if (abs(result - x(i)) > tolerance) then
+           print *, i, a(i), b(i), x(i), result
+           call abort
+         end if
+      end do
+      end
diff --git a/gcc/testsuite/g77.dg/dg.exp b/gcc/testsuite/g77.dg/dg.exp
new file mode 100644
index 00000000000..446166c49db
--- /dev/null
+++ b/gcc/testsuite/g77.dg/dg.exp
@@ -0,0 +1,36 @@
+#   Copyright (C) 1997 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+# 
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  
+
+# GCC testsuite that uses the `dg.exp' driver.
+
+# Load support procs.
+load_lib g77-dg.exp
+
+# If a testcase doesn't have special options, use these.
+global DEFAULT_FFLAGS
+if ![info exists DEFAULT_FFLAGS] then {
+    set DEFAULT_FFLAGS " -pedantic-errors"
+}
+
+# Initialize `dg'.
+dg-init
+
+# Main loop.
+g77-dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/*.f]] \
+	$DEFAULT_FFLAGS
+
+# All done.
+dg-finish
diff --git a/gcc/testsuite/lib/g77-dg.exp b/gcc/testsuite/lib/g77-dg.exp
new file mode 100644
index 00000000000..cb72c365361
--- /dev/null
+++ b/gcc/testsuite/lib/g77-dg.exp
@@ -0,0 +1,161 @@
+#   Copyright (C) 1997, 1999, 2000 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+# 
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  
+
+load_lib dg.exp
+load_lib file-format.exp
+load_lib target-supports.exp
+load_lib scanasm.exp
+
+if ![info exists TORTURE_OPTIONS] {
+    # It is theoretically beneficial to group all of the O2/O3 options together,
+    # as in many cases the compiler will generate identical executables for
+    # all of them--and the c-torture testsuite will skip testing identical
+    # executables multiple times.
+    # Also note that -finline-functions is explicitly included in one of the
+    # items below, even though -O3 is also specified, because some ports may
+    # choose to disable inlining functions by default, even when optimizing.
+    set TORTURE_OPTIONS [list \
+	{ -O0 } \
+	{ -O1 } \
+	{ -O2 } \
+	{ -O3 -fomit-frame-pointer } \
+	{ -O3 -fomit-frame-pointer -funroll-loops } \
+	{ -O3 -fomit-frame-pointer -funroll-all-loops -finline-functions } \
+	{ -O3 -g } \
+	{ -Os } ]
+}
+
+
+# Split TORTURE_OPTIONS into two choices: one for testcases with loops and
+# one for testcases without loops.
+
+set torture_with_loops $TORTURE_OPTIONS
+set torture_without_loops ""
+foreach option $TORTURE_OPTIONS {
+    if ![string match "*loop*" $option] {
+	lappend torture_without_loops $option
+    }
+}
+
+# Define g77 callbacks for dg.exp.
+
+proc g77-dg-test { prog do_what extra_tool_flags } {
+    # Set up the compiler flags, based on what we're going to do.
+
+    switch $do_what {
+	"preprocess" {
+	    set compile_type "preprocess"
+	    set output_file "[file rootname [file tail $prog]].i"
+	}
+	"compile" {
+	    set compile_type "assembly"
+	    set output_file "[file rootname [file tail $prog]].s"
+	}
+	"assemble" {
+	    set compile_type "object"
+	    set output_file "[file rootname [file tail $prog]].o"
+	}
+	"link" {
+	    set compile_type "executable"
+	    set output_file "a.out"
+	    # The following line is needed for targets like the i960 where
+	    # the default output file is b.out.  Sigh.
+	}
+	"run" {
+	    set compile_type "executable"
+	    # FIXME: "./" is to cope with "." not being in $PATH.
+	    # Should this be handled elsewhere?
+	    # YES.
+	    set output_file "./a.out"
+	    # This is the only place where we care if an executable was
+	    # created or not.  If it was, dg.exp will try to run it.
+	    remote_file build delete $output_file;
+	}
+	default {
+	    perror "$do_what: not a valid dg-do keyword"
+	    return ""
+	}
+    }
+    set options ""
+    if { $extra_tool_flags != "" } {
+	lappend options "additional_flags=$extra_tool_flags"
+    }
+
+    set comp_output [g77_target_compile "$prog" "$output_file" "$compile_type" $options];
+
+    return [list $comp_output $output_file]
+}
+
+proc g77-dg-prune { system text } {
+    set text [prune_g77_output $text]
+
+    # If we see "region xxx is full" then the testcase is too big for ram.
+    # This is tricky to deal with in a large testsuite like c-torture so
+    # deal with it here.  Just mark the testcase as unsupported.
+    if [regexp "(^|\n)\[^\n\]*: region \[^\n\]* is full" $text] {
+	# The format here is important.  See dg.exp.
+	return "::unsupported::memory full"
+    }
+
+    return $text
+}
+
+# Utility routines.
+
+#
+# search_for -- looks for a string match in a file
+#
+proc search_for { file pattern } {
+    set fd [open $file r]
+    while { [gets $fd cur_line]>=0 } {
+	if [string match "*$pattern*" $cur_line] then {
+	    close $fd
+	    return 1
+	}
+    }
+    close $fd
+    return 0
+}
+
+# Modified dg-runtest that can cycle through a list of optimization options
+# as c-torture does.
+proc g77-dg-runtest { testcases default-extra-flags } {
+    global runtests
+
+    foreach test $testcases {
+	# If we're only testing specific files and this isn't one of 
+	# them, skip it.
+	if ![runtest_file_p $runtests $test] {
+	    continue
+        }
+
+	# Look for a loop within the source code - if we don't find one,
+	# don't pass -funroll[-all]-loops.
+	global torture_with_loops torture_without_loops
+	if [expr [search_for $test "do *\[0-9\]"]+[search_for $test "end *do"]] {
+	    set option_list $torture_with_loops
+	} else {
+	    set option_list $torture_without_loops
+	}
+
+	set nshort [file tail [file dirname $test]]/[file tail $test]
+
+	foreach flags $option_list {
+	    verbose "Testing $nshort, $flags" 1
+	    dg-test $test $flags ${default-extra-flags}
+	}
+    }
+}