[PATCH] PR 16917: Add DFLOAT to gfortran
Steve Kargl
sgk@troutmask.apl.washington.edu
Wed Aug 11 20:31:00 GMT 2004
On Wed, Aug 11, 2004 at 10:18:15AM -0700, Steve Kargl wrote:
> On Wed, Aug 11, 2004 at 05:16:17PM +0100, Paul Brook wrote:
> >
> > Steven B pointed out that it would be simpler to just add dfloat as an alias
> > for dble. This means we accept a wider range of arguments to dfloat, but I
> > don't imagine anyone's going to be bothered about that.
> >
>
> (snip)
>
> >
> > + make_alias ("dfloat");
> > +
> > make_generic ("dble", GFC_ISYM_DBLE);
> >
>
> I originally did the above patch, but changed my mind
> because you are technically no longer compatible with
> g77, f2c, and f77 on HP-UX. There may be other vendor
> compilers that support DFLOAT. In all cases, the input
> to DFLOAT is restricted to a scalar integer argument.
> Thus, the following will fail with g77 et al
>
> program d
> real :: x(3) = 1.2e0
> print *, dfloat(x)
> end
>
> but gfortran with your patch will now compile the above.
>
> Additionally, I plan to add a warning in gfc_check_dfloat
> if -std is set. I, however, need to determine how
> gfc_notify_std () works. I think we should issue something
> like "Extension: DFLOAT() is a nonstandard intrinsic. Consider
> using DBLE()." 'make_alias ("dfloat");' does not permit this
> type of checking.
>
Here's a new patch that includes the error message. Examples are
dhcp-78-96:sgk[408] cat d.f
program d
integer*4 i4
i4 = 44
print *, dfloat(i4)
end
dhcp-78-96:sgk[409] gfc -o d d.f
dhcp-78-96:sgk[410] ./d
44.0000000000000
dhcp-78-96:sgk[411] gfc -o d -std=f95 d.f
In file d.f:4
print *, dfloat(i4)
1
Error: Extension: DFLOAT at (1) is a nonstandard intrinsic function. Consider using DBLE.
Note gfc_simplify_dfloat() is a reduced version of gfc_simplify_dble()
and we may be able to re-use gfc_simplify_dble() to eliminate
gfc_simplify_dfloat().
An updated ChangeLog entry is
2004-08-11 Steven G. Kargl <kargls@comcast.net>
* check.c (gfc_check_dfloat): New function.
* gfortran.h (GFC_ISYM_DFLOAT): New symbol.
* intrinsic.c: Add DFLOAT to list of intrinsic functions.
* intrinsic.h: Prototypes for gfc_check_dfloat and gfc_simplify_dfloat.
* simplify.c (gfc_simplify_dfloat): New function.
* trans-intrinsic.c: Use GFC_ISYM_DFLOAT.
--
Steve
-------------- next part --------------
Index: check.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/check.c,v
retrieving revision 1.7
diff -u -r1.7 check.c
--- check.c 14 Jun 2004 15:56:48 -0000 1.7
+++ check.c 11 Aug 2004 20:19:37 -0000
@@ -638,6 +638,24 @@
try
+gfc_check_dfloat (gfc_expr * x)
+{
+
+ gfc_notify_std (GFC_STD_GNU,
+ "Extension: DFLOAT at %L is a nonstandard intrinsic function. Consider using DBLE.",
+ &x->where);
+
+ if (scalar_check (x, 0) == FAILURE)
+ return FAILURE;
+
+ if (type_check (x, 0, BT_INTEGER) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+
+try
gfc_check_digits (gfc_expr * x)
{
Index: gfortran.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/gfortran.h,v
retrieving revision 1.21
diff -u -r1.21 gfortran.h
--- gfortran.h 8 Aug 2004 12:28:25 -0000 1.21
+++ gfortran.h 11 Aug 2004 20:19:38 -0000
@@ -297,6 +297,7 @@
GFC_ISYM_COUNT,
GFC_ISYM_CSHIFT,
GFC_ISYM_DBLE,
+ GFC_ISYM_DFLOAT,
GFC_ISYM_DIM,
GFC_ISYM_DOT_PRODUCT,
GFC_ISYM_DPROD,
Index: intrinsic.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/intrinsic.c,v
retrieving revision 1.14
diff -u -r1.14 intrinsic.c
--- intrinsic.c 6 Aug 2004 21:46:56 -0000 1.14
+++ intrinsic.c 11 Aug 2004 20:19:38 -0000
@@ -1050,6 +1050,12 @@
make_generic ("dble", GFC_ISYM_DBLE);
+ add_sym_1 ("dfloat", 1, 1, BT_REAL, dd,
+ gfc_check_dfloat, gfc_simplify_dfloat, gfc_resolve_dble,
+ a, BT_INTEGER, di, 0);
+
+ make_generic ("dfloat", GFC_ISYM_DFLOAT);
+
add_sym_1 ("digits", 0, 1, BT_INTEGER, di,
gfc_check_digits, gfc_simplify_digits, NULL,
x, BT_UNKNOWN, dr, 0);
Index: intrinsic.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/intrinsic.h,v
retrieving revision 1.9
diff -u -r1.9 intrinsic.h
--- intrinsic.h 6 Aug 2004 21:46:56 -0000 1.9
+++ intrinsic.h 11 Aug 2004 20:19:38 -0000
@@ -41,6 +41,7 @@
try gfc_check_cshift (gfc_expr *, gfc_expr *, gfc_expr *);
try gfc_check_dcmplx (gfc_expr *, gfc_expr *);
try gfc_check_dble (gfc_expr *);
+try gfc_check_dfloat (gfc_expr *);
try gfc_check_digits (gfc_expr *);
try gfc_check_dot_product (gfc_expr *, gfc_expr *);
try gfc_check_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
@@ -137,6 +138,7 @@
gfc_expr *gfc_simplify_cosh (gfc_expr *);
gfc_expr *gfc_simplify_dcmplx (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_dble (gfc_expr *);
+gfc_expr *gfc_simplify_dfloat (gfc_expr *);
gfc_expr *gfc_simplify_digits (gfc_expr *);
gfc_expr *gfc_simplify_dim (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_dprod (gfc_expr *, gfc_expr *);
Index: simplify.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/simplify.c,v
retrieving revision 1.7
diff -u -r1.7 simplify.c
--- simplify.c 8 Aug 2004 12:28:25 -0000 1.7
+++ simplify.c 11 Aug 2004 20:19:38 -0000
@@ -814,6 +814,23 @@
gfc_expr *
+gfc_simplify_dfloat (gfc_expr * e)
+{
+ gfc_expr *result;
+
+ if (e->expr_type != EXPR_CONSTANT)
+ return NULL;
+
+ if (e->ts.type == BT_INTEGER)
+ result = gfc_int2real (e, gfc_default_double_kind ());
+ else
+ gfc_internal_error ("gfc_simplify_dfloat(): bad type at %L", &e->where);
+
+ return range_check (result, "DFLOAT");
+}
+
+
+gfc_expr *
gfc_simplify_digits (gfc_expr * x)
{
int i, digits;
Index: trans-intrinsic.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-intrinsic.c,v
retrieving revision 1.12
diff -u -r1.12 trans-intrinsic.c
--- trans-intrinsic.c 6 Aug 2004 20:36:05 -0000 1.12
+++ trans-intrinsic.c 11 Aug 2004 20:19:38 -0000
@@ -2733,6 +2733,7 @@
case GFC_ISYM_REAL:
case GFC_ISYM_LOGICAL:
case GFC_ISYM_DBLE:
+ case GFC_ISYM_DFLOAT:
gfc_conv_intrinsic_conversion (se, expr);
break;
More information about the Fortran
mailing list