This is the mail archive of the gcc@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]

g77 assumed array patch [was: fortran regression]


On Thu, Dec 11, 1997 at 06:53:48PM -0500, Craig Burley wrote:
> What I believe I *wanted* to do, long ago, is have g77 simply
> leave the *upper* bound unspecified, i.e. a NULL_TREE, and
> have the back end simply cope.  That would be an explicitly
> documented way to say "upper bound not specified, may be as
> high as the corresponding actual-argument's upper bound".
> 
> But it wasn't then, and might not be now, easy to teach the
> back end about this construct.  If it is now, that would be
> my suggestion -- it's a trivial change in the g77 front end,
> but if someone can implement the back-end changes to cope with
> a NULL_TREE in the "upper" part of a build_range_type call.

The following patch implements this suggestion.

It compiles the null test case

      subroutine star(aap, noot)                
      dimension aap(*)                                        
      end                                       

well enough; I'm about to sick it on SpecFP (which is actually my main
impetus to fix this -- I want to see how well my giv patch works ;-)
So we'll see how well it does on real code soon enough.

I believe I've gotten all of the cases elsewhere in the compiler that
were assuming an upper bound existed.  I may have missed some, and I
may have changed some that could not possibly be called on a range type.
Someone else ought to look through and verify that.


r~
Mon Dec 15 22:46:19 1997  Richard Henderson  <rth@cygnus.com>

	G77 ChangeLog:
	* com.c (ffecom_sym_transform_): Assumed arrays have no upper bound.

	GCC ChangeLog:
	* tree.c (build_range_type): Allow creation of ranges with no maximum.
	* dbxout.c (dbxout_range_type): Handle missing TYPE_MAX_VALUE.
	* dwarf2out.c (add_subscript_info): Likewise.
	* dwarfout.c (subscript_data_attribute, byte_size_attribute): Likewise.
	* sdbout.c (plain_type_1): Likewise.
	* stmt.c (pushcase_range, all_cases_count, node_has_high_bound):
	Likewise.
	* fold-const.c (int_const_binop, fold_convert, make_range, fold):
	Likewise.
	

Index: dbxout.c
===================================================================
RCS file: /cvs/cvsfiles/egcs/gcc/dbxout.c,v
retrieving revision 1.5
diff -u -p -d -r1.5 dbxout.c
--- dbxout.c	1997/12/15 17:55:38	1.5
+++ dbxout.c	1997/12/16 04:53:24
@@ -954,7 +954,8 @@ dbxout_range_type (type)
 	     TREE_INT_CST_LOW (TYPE_MIN_VALUE (type)));
   else
     fprintf (asmfile, ";0");
-  if (TREE_CODE (TYPE_MAX_VALUE (type)) == INTEGER_CST)
+  if (TYPE_MAX_VALUE (type) 
+      && TREE_CODE (TYPE_MAX_VALUE (type)) == INTEGER_CST)
     fprintf (asmfile, ";%d;", 
 	     TREE_INT_CST_LOW (TYPE_MAX_VALUE (type)));
   else
Index: dwarf2out.c
===================================================================
RCS file: /cvs/cvsfiles/egcs/gcc/dwarf2out.c,v
retrieving revision 1.30
diff -u -p -d -r1.30 dwarf2out.c
--- dwarf2out.c	1997/12/15 17:55:52	1.30
+++ dwarf2out.c	1997/12/16 04:53:24
@@ -7162,8 +7162,16 @@ add_subscript_info (type_die, type)
 				    type_die);
 	    }
 
+	  /* ??? If upper is NULL, the array has unspecified length,
+	     but it does have a lower bound.  This happens with Fortran
+	       dimension arr(N:*)
+       	     Since the debugger is definitely going to need to know N
+	     to produce useful results, go ahead and output the lower
+	     bound solo, and hope the debugger can cope.  */
+
 	  add_bound_info (subrange_die, DW_AT_lower_bound, lower);
-	  add_bound_info (subrange_die, DW_AT_upper_bound, upper);
+	  if (upper)
+	    add_bound_info (subrange_die, DW_AT_upper_bound, upper);
 	}
       else
 	/* We have an array type with an unspecified length.  The DWARF-2
Index: dwarfout.c
===================================================================
RCS file: /cvs/cvsfiles/egcs/gcc/dwarfout.c,v
retrieving revision 1.8
diff -u -p -d -r1.8 dwarfout.c
--- dwarfout.c	1997/12/15 17:55:44	1.8
+++ dwarfout.c	1997/12/16 04:53:24
@@ -2587,9 +2587,8 @@ subscript_data_attribute (type)
 	  /* Output the representation format byte for this dimension.  */
 
 	  ASM_OUTPUT_DWARF_FMT_BYTE (asm_out_file,
-				  FMT_CODE (1,
-					    TREE_CODE (lower) == INTEGER_CST,
-					    TREE_CODE (upper) == INTEGER_CST));
+		  FMT_CODE (1, TREE_CODE (lower) == INTEGER_CST,
+			    (upper && TREE_CODE (upper) == INTEGER_CST)));
 
 	  /* Output the index type for this dimension.	*/
 
@@ -2675,9 +2674,9 @@ byte_size_attribute (tree_node)
       case ARRAY_TYPE:
 	{
 	  /* The lower bound is zero, so the length is the upper bound + 1.  */
-	  register tree upper_bound;
-	  upper_bound = TYPE_MAX_VALUE (TYPE_DOMAIN (tree_node));
-	  size = (unsigned) TREE_INT_CST_LOW (upper_bound) + 1;
+	  register tree upper;
+	  upper = TYPE_MAX_VALUE (TYPE_DOMAIN (tree_node));
+	  size = upper ? (unsigned) TREE_INT_CST_LOW (upper) + 1 : -1;
 	  break;
 	}
 
Index: fold-const.c
===================================================================
RCS file: /cvs/cvsfiles/egcs/gcc/fold-const.c,v
retrieving revision 1.13
diff -u -p -d -r1.13 fold-const.c
--- fold-const.c	1997/12/11 16:25:58	1.13
+++ fold-const.c	1997/12/16 04:53:25
@@ -1215,7 +1215,9 @@ int_const_binop (code, arg1, arg2, notru
     }
 
   if (TREE_TYPE (arg1) == sizetype && hi == 0
-      && low >= 0 && low <= TREE_INT_CST_LOW (TYPE_MAX_VALUE (sizetype))
+      && low >= 0
+      && (TYPE_MAX_VALUE (sizetype) == NULL
+	  || low <= TREE_INT_CST_LOW (TYPE_MAX_VALUE (sizetype)))
       && ! overflow
       && ! TREE_OVERFLOW (arg1) && ! TREE_OVERFLOW (arg2))
     t = size_int (low);
@@ -1532,25 +1534,34 @@ fold_convert (t, arg1)
 	  REAL_VALUE_TYPE l;
 	  REAL_VALUE_TYPE u;
 	  tree type1 = TREE_TYPE (arg1);
+	  int no_upper_bound;
 
 	  x = TREE_REAL_CST (arg1);
 	  l = real_value_from_int_cst (type1, TYPE_MIN_VALUE (type));
-	  u = real_value_from_int_cst (type1, TYPE_MAX_VALUE (type));
+
+	  no_upper_bound = (TYPE_MAX_VALUE (type) == NULL);
+	  if (!no_upper_bound)
+	    u = real_value_from_int_cst (type1, TYPE_MAX_VALUE (type));
+
 	  /* See if X will be in range after truncation towards 0.
 	     To compensate for truncation, move the bounds away from 0,
 	     but reject if X exactly equals the adjusted bounds.  */
 #ifdef REAL_ARITHMETIC
 	  REAL_ARITHMETIC (l, MINUS_EXPR, l, dconst1);
-	  REAL_ARITHMETIC (u, PLUS_EXPR, u, dconst1);
+	  if (!no_upper_bound)
+	    REAL_ARITHMETIC (u, PLUS_EXPR, u, dconst1);
 #else
 	  l--;
-	  u++;
+	  if (!no_upper_bound)
+	    u++;
 #endif
 	  /* If X is a NaN, use zero instead and show we have an overflow.
 	     Otherwise, range check.  */
 	  if (REAL_VALUE_ISNAN (x))
 	    overflow = 1, x = dconst0;
-	  else if (! (REAL_VALUES_LESS (l, x) && REAL_VALUES_LESS (x, u)))
+	  else if (! (REAL_VALUES_LESS (l, x)
+		      && !no_upper_bound
+		      && REAL_VALUES_LESS (x, u)))
 	    overflow = 1;
 
 #ifndef REAL_ARITHMETIC
@@ -2922,11 +2933,22 @@ make_range (exp, pin_p, plow, phigh)
 	  if (TREE_UNSIGNED (type) && ! TREE_UNSIGNED (TREE_TYPE (exp)))
 	    {
 	      tree equiv_type = type_for_mode (TYPE_MODE (type), 1);
-	      tree high_positive
-		= fold (build (RSHIFT_EXPR, type,
-			       convert (type,
-					TYPE_MAX_VALUE (equiv_type)),
-			       convert (type, integer_one_node)));
+	      tree high_positive;
+
+	      /* A range without an upper bound is, naturally, unbounded.
+		 Since convert would have cropped a very large value, use
+		  the max value for the destination type.  */
+
+	      high_positive = TYPE_MAX_VALUE (equiv_type);
+	      if (!high_positive)
+		{
+		  high_positive = TYPE_MAX_VALUE (type);
+		  if (!high_positive)
+		    abort();
+		}
+	      high_positive = fold (build (RSHIFT_EXPR, type,
+					   convert (type, high_positive),
+					   convert (type, integer_one_node)));
 			
 	      /* If the low bound is specified, "and" the range with the
 		 range for which the original unsigned value will be
@@ -4914,6 +4936,7 @@ fold (expr) 
       if (operand_equal_p (arg0, arg1, 0))
 	return arg0;
       if (INTEGRAL_TYPE_P (type)
+	  && TYPE_MAX_VALUE (type)
 	  && operand_equal_p (arg1, TYPE_MAX_VALUE (type), 1))
 	return omit_one_operand (type, arg1, arg0);
       goto associate;
@@ -5397,6 +5420,8 @@ fold (expr) 
 	      && ! (TREE_CONSTANT (cval1) && TREE_CONSTANT (cval2))
 	      && TREE_TYPE (cval1) == TREE_TYPE (cval2)
 	      && INTEGRAL_TYPE_P (TREE_TYPE (cval1))
+	      && TYPE_MAX_VALUE (TREE_TYPE (cval1))
+	      && TYPE_MAX_VALUE (TREE_TYPE (cval2))
 	      && ! operand_equal_p (TYPE_MIN_VALUE (TREE_TYPE (cval1)),
 				    TYPE_MAX_VALUE (TREE_TYPE (cval2)), 0))
 	    {
Index: sdbout.c
===================================================================
RCS file: /cvs/cvsfiles/egcs/gcc/sdbout.c,v
retrieving revision 1.4
diff -u -p -d -r1.4 sdbout.c
--- sdbout.c	1997/12/15 17:55:58	1.4
+++ sdbout.c	1997/12/16 04:53:25
@@ -584,6 +584,7 @@ plain_type_1 (type, level)
 	if (sdb_n_dims < SDB_MAX_DIM)
 	  sdb_dims[sdb_n_dims++]
 	    = (TYPE_DOMAIN (type)
+	       && TYPE_MAX_VALUE (TYPE_DOMAIN (type))
 	       && TREE_CODE (TYPE_MAX_VALUE (TYPE_DOMAIN (type))) == INTEGER_CST
 	       && TREE_CODE (TYPE_MIN_VALUE (TYPE_DOMAIN (type))) == INTEGER_CST
 	       ? (TREE_INT_CST_LOW (TYPE_MAX_VALUE (TYPE_DOMAIN (type)))
Index: stmt.c
===================================================================
RCS file: /cvs/cvsfiles/egcs/gcc/stmt.c,v
retrieving revision 1.11
diff -u -p -d -r1.11 stmt.c
--- stmt.c	1997/12/15 15:46:40	1.11
+++ stmt.c	1997/12/16 04:53:26
@@ -4624,10 +4624,16 @@ pushcase_range (value1, value2, converte
 
   /* Fail if the range is empty.  Do this before any conversion since
      we want to allow out-of-range empty ranges.  */
-  if (tree_int_cst_lt (value2, value1))
+  if (value2 && tree_int_cst_lt (value2, value1))
     return 4;
 
   value1 = (*converter) (nominal_type, value1);
+
+  /* If the max was unbounded, use the max of the nominal_type we are 
+     converting to.  Do this after the < check above to suppress false
+     positives.  */
+  if (!value2)
+    value2 = TYPE_MAX_VALUE (nominal_type);
   value2 = (*converter) (nominal_type, value2);
 
   /* Fail if these values are out of range.  */
@@ -4955,6 +4961,7 @@ all_cases_count (type, spareness)
     default:
     case INTEGER_TYPE:
       if (TREE_CODE (TYPE_MIN_VALUE (type)) != INTEGER_CST
+	  || TYPE_MAX_VALUE (type) == NULL
 	  || TREE_CODE (TYPE_MAX_VALUE (type)) != INTEGER_CST)
 	return -1;
       else
@@ -6193,6 +6200,11 @@ node_has_high_bound (node, index_type)
 {
   tree high_plus_one;
   case_node_ptr pnode;
+
+  /* If there is no upper bound, obviously no test is needed.  */
+
+  if (TYPE_MAX_VALUE (index_type) == NULL)
+    return 1;
 
   /* If the upper bound of this node is the highest value in the type
      of the index expression, we need not test against it.  */
Index: tree.c
===================================================================
RCS file: /cvs/cvsfiles/egcs/gcc/tree.c,v
retrieving revision 1.8
diff -u -p -d -r1.8 tree.c
--- tree.c	1997/12/12 06:49:21	1.8
+++ tree.c	1997/12/16 04:53:27
@@ -4002,19 +4002,25 @@ build_range_type (type, lowval, highval)
 
   push_obstacks (TYPE_OBSTACK (itype), TYPE_OBSTACK (itype));
   TYPE_MIN_VALUE (itype) = convert (type, lowval);
-  TYPE_MAX_VALUE (itype) = convert (type, highval);
+  TYPE_MAX_VALUE (itype) = highval ? convert (type, highval) : NULL;
   pop_obstacks ();
 
   TYPE_PRECISION (itype) = TYPE_PRECISION (type);
   TYPE_MODE (itype) = TYPE_MODE (type);
   TYPE_SIZE (itype) = TYPE_SIZE (type);
   TYPE_ALIGN (itype) = TYPE_ALIGN (type);
-  if ((TREE_CODE (lowval) == INTEGER_CST)
-      && (TREE_CODE (highval) == INTEGER_CST))
+  if (TREE_CODE (lowval) == INTEGER_CST)
     {
-      HOST_WIDE_INT highint = TREE_INT_CST_LOW (highval);
-      HOST_WIDE_INT lowint = TREE_INT_CST_LOW (lowval);
-      int maxint = (int) (highint - lowint);
+      HOST_WIDE_INT lowint, highint;
+      int maxint;
+
+      lowint = TREE_INT_CST_LOW (lowval);
+      if (highval && TREE_CODE (highval) == INTEGER_CST)
+	highint = TREE_INT_CST_LOW (highval);
+      else
+	highint = (~(unsigned HOST_WIDE_INT)0) >> 1;
+
+      maxint = (int) (highint - lowint);
       return type_hash_canon (maxint < 0 ? ~maxint : maxint, itype);
     }
   else
Index: f/com.c
===================================================================
RCS file: /cvs/cvsfiles/egcs/gcc/f/com.c,v
retrieving revision 1.9
diff -u -p -d -r1.9 com.c
--- com.c	1997/12/15 17:34:23	1.9
+++ com.c	1997/12/16 04:53:35
@@ -8260,13 +8260,17 @@ ffecom_sym_transform_ (ffesymbol s)
 		assert (ffebld_right (dim) != NULL);
 		if ((ffebld_op (ffebld_right (dim)) == FFEBLD_opSTAR)
 		    || ffecom_doing_entry_)
-		  /* Used to just do high=low.  But for ffecom_tree_
-		     canonize_ref_, it probably is important to correctly
-		     assess the size.  E.g. given COMPLEX C(*),CFUNC and
-		     C(2)=CFUNC(C), overlap can happen, while it can't
-		     for, say, C(1)=CFUNC(C(2)).  */
-		  high = convert (TREE_TYPE (low),
-				  TYPE_MAX_VALUE (TREE_TYPE (low)));
+		  {
+		    /* Used to just do high=low.  But for ffecom_tree_
+		       canonize_ref_, it probably is important to correctly
+		       assess the size.  E.g. given COMPLEX C(*),CFUNC and
+		       C(2)=CFUNC(C), overlap can happen, while it can't
+		       for, say, C(1)=CFUNC(C(2)).  */
+		    /* Even more recently used to set to INT_MAX, but that
+		       broke when some overflow checking went into the back
+		       end.  Now we just leave the upper bound unspecified.  */
+		    high = NULL;
+		  }
 		else
 		  high = ffecom_expr (ffebld_right (dim));
 
@@ -8406,7 +8410,7 @@ ffecom_sym_transform_ (ffesymbol s)
 
 		if (!adjustable
 		    && ((TREE_CODE (low) != INTEGER_CST)
-			|| (TREE_CODE (high) != INTEGER_CST)))
+			|| (high && TREE_CODE (high) != INTEGER_CST)))
 		  adjustable = TRUE;
 
 #if 0				/* Old approach -- see below. */
@@ -8416,7 +8420,7 @@ ffecom_sym_transform_ (ffesymbol s)
 				  low,
 				  ffecom_integer_zero_node);
 
-		if (TREE_CODE (high) != INTEGER_CST)
+		if (high && TREE_CODE (high) != INTEGER_CST)
 		  high = ffecom_3 (COND_EXPR, integer_type_node,
 				   ffecom_adjarray_passed_ (s),
 				   high,
@@ -8432,7 +8436,7 @@ ffecom_sym_transform_ (ffesymbol s)
 		/* ~~~similarly, this fixes dumb0.f.  The C front end
 		   does this, which is why dumb0.c would work.  */
 
-		if (TREE_CODE (high) != INTEGER_CST)
+		if (high && TREE_CODE (high) != INTEGER_CST)
 		  high = variable_size (high);
 
 		type

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]