[gfortran] PATCH clean up arith.c
Steve Kargl
sgk@troutmask.apl.washington.edu
Sat Feb 26 04:40:00 GMT 2005
On Tue, Feb 22, 2005 at 05:23:21PM +0100, Tobias Schl?ter wrote:
> Steve Kargl wrote:
> > 2005-02-13 Steven G. Kargl <kargls@comcast.net>
> >
> > *arith.c (gfc_check_result): New functions
> > (gfc_arith_uminus, gfc_arith_plus, gfc_arith_minus,
> > gfc_arith_times, gfc_arith_divide, gfc_arith_power): Use it.
> > (gfc_int2real, gfc_int2complex): Remove useless conditional.
>
> > +static arith
> > +gfc_check_result (arith rc, gfc_expr * x, gfc_expr * r, gfc_expr ** rp)
>
> No 'gfc_' prefix for static functions, please. How about moving the call to
> gfc_range_check inside this function, and do away with the rc argument?
Fixed.
> >
> > - if ((rc=gfc_check_real_range(result->value.complex.r, kind)) != ARITH_OK)
> > - {
> > - arith_error (rc, &src->ts, &result->ts, &src->where);
> > - gfc_free_expr (result);
> > - return NULL;
> > - }
> > -
> > return result;
> > }
> >
>
> The case of INTEGER*16 (2*127 - 1 maximum representable integer) and REAL*4
> (exponents up to 128 for IEEE numbers) is just at the limit of triggering
> these ifs, so I think it would be a good idea to keep them, as they come at
> virtually no pain, and I'm not sure there's no architecture which doesn't have
> a smaller REAL type.
>
I've restored these test. I did realize that rth's reworking of
gfortran's types gave of integer*16 on some platforms. It became
apparent while working on the BOZ patch on my amd64 system.
Here's a revised patch. Bootstrap + regtested on i386-*-freebsd6.0.
2005-02-25 Steven G. Kargl <kargls@comcast.net>
* arith.c (gfc_check_real_range): Remove multiple returns
(check_result): New function.
(gfc_arith_uminus,gfc_arith_plus,gfc_arith_times,
gfc_arith_divide,gfc_arith_power,gfc_arith_minus): Use it.
OK for mainline?
--
Steve
-------------- next part --------------
Index: arith.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/arith.c,v
retrieving revision 1.22
diff -u -b -r1.22 arith.c
--- arith.c 23 Feb 2005 21:34:10 -0000 1.22
+++ arith.c 26 Feb 2005 03:30:50 -0000
@@ -373,20 +373,15 @@
mpfr_init (q);
mpfr_abs (q, p, GFC_RND_MODE);
- retval = ARITH_OK;
if (mpfr_sgn (q) == 0)
- goto done;
-
- if (mpfr_cmp (q, gfc_real_kinds[i].huge) > 0)
- {
+ retval = ARITH_OK;
+ else if (mpfr_cmp (q, gfc_real_kinds[i].huge) > 0)
retval = ARITH_OVERFLOW;
- goto done;
- }
-
- if (mpfr_cmp (q, gfc_real_kinds[i].tiny) < 0)
+ else if (mpfr_cmp (q, gfc_real_kinds[i].tiny) < 0)
retval = ARITH_UNDERFLOW;
+ else
+ retval = ARITH_OK;
-done:
mpfr_clear (q);
return retval;
@@ -554,6 +549,30 @@
}
+/* Several of the following routines use the same set of statements to
+ check the validity of the result. Encapsulate the checking here. */
+
+static arith
+check_result (arith rc, gfc_expr * x, gfc_expr * r, gfc_expr ** rp)
+{
+ if (rc != ARITH_OK)
+ gfc_free_expr (r);
+ else
+ {
+ if (rc == ARITH_UNDERFLOW && gfc_option.warn_underflow)
+ gfc_warning ("%s at %L", gfc_arith_error (rc), &x->where);
+
+ if (rc == ARITH_ASYMMETRIC)
+ gfc_warning ("%s at %L", gfc_arith_error (rc), &x->where);
+
+ rc = ARITH_OK;
+ *rp = r;
+ }
+
+ return rc;
+}
+
+
/* It may seem silly to have a subroutine that actually computes the
unary plus of a constant, but it prevents us from making exceptions
in the code elsewhere. */
@@ -595,25 +614,7 @@
rc = gfc_range_check (result);
- if (rc == ARITH_UNDERFLOW)
- {
- if (gfc_option.warn_underflow)
- gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where);
- rc = ARITH_OK;
- *resultp = result;
- }
- else if (rc == ARITH_ASYMMETRIC)
- {
- gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where);
- rc = ARITH_OK;
- *resultp = result;
- }
- else if (rc != ARITH_OK)
- gfc_free_expr (result);
- else
- *resultp = result;
-
- return rc;
+ return check_result (rc, op1, result, resultp);
}
@@ -650,25 +651,7 @@
rc = gfc_range_check (result);
- if (rc == ARITH_UNDERFLOW)
- {
- if (gfc_option.warn_underflow)
- gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where);
- rc = ARITH_OK;
- *resultp = result;
- }
- else if (rc == ARITH_ASYMMETRIC)
- {
- gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where);
- rc = ARITH_OK;
- *resultp = result;
- }
- else if (rc != ARITH_OK)
- gfc_free_expr (result);
- else
- *resultp = result;
-
- return rc;
+ return check_result (rc, op1, result, resultp);
}
@@ -705,25 +688,7 @@
rc = gfc_range_check (result);
- if (rc == ARITH_UNDERFLOW)
- {
- if (gfc_option.warn_underflow)
- gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where);
- rc = ARITH_OK;
- *resultp = result;
- }
- else if (rc == ARITH_ASYMMETRIC)
- {
- gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where);
- rc = ARITH_OK;
- *resultp = result;
- }
- else if (rc != ARITH_OK)
- gfc_free_expr (result);
- else
- *resultp = result;
-
- return rc;
+ return check_result (rc, op1, result, resultp);
}
@@ -774,25 +739,7 @@
rc = gfc_range_check (result);
- if (rc == ARITH_UNDERFLOW)
- {
- if (gfc_option.warn_underflow)
- gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where);
- rc = ARITH_OK;
- *resultp = result;
- }
- else if (rc == ARITH_ASYMMETRIC)
- {
- gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where);
- rc = ARITH_OK;
- *resultp = result;
- }
- else if (rc != ARITH_OK)
- gfc_free_expr (result);
- else
- *resultp = result;
-
- return rc;
+ return check_result (rc, op1, result, resultp);
}
@@ -876,25 +823,7 @@
if (rc == ARITH_OK)
rc = gfc_range_check (result);
- if (rc == ARITH_UNDERFLOW)
- {
- if (gfc_option.warn_underflow)
- gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where);
- rc = ARITH_OK;
- *resultp = result;
- }
- else if (rc == ARITH_ASYMMETRIC)
- {
- gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where);
- rc = ARITH_OK;
- *resultp = result;
- }
- else if (rc != ARITH_OK)
- gfc_free_expr (result);
- else
- *resultp = result;
-
- return rc;
+ return check_result (rc, op1, result, resultp);
}
@@ -1072,25 +1001,7 @@
if (rc == ARITH_OK)
rc = gfc_range_check (result);
- if (rc == ARITH_UNDERFLOW)
- {
- if (gfc_option.warn_underflow)
- gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where);
- rc = ARITH_OK;
- *resultp = result;
- }
- else if (rc == ARITH_ASYMMETRIC)
- {
- gfc_warning ("%s at %L", gfc_arith_error (rc), &op1->where);
- rc = ARITH_OK;
- *resultp = result;
- }
- else if (rc != ARITH_OK)
- gfc_free_expr (result);
- else
- *resultp = result;
-
- return rc;
+ return check_result (rc, op1, result, resultp);
}
More information about the Fortran
mailing list