aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/iresolve.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran/iresolve.c')
-rw-r--r--gcc/fortran/iresolve.c70
1 files changed, 48 insertions, 22 deletions
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 9a4e199..2134432 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -36,10 +36,10 @@ along with GCC; see the file COPYING3. If not see
#include "constructor.h"
#include "arith.h"
-/* Given printf-like arguments, return a stable version of the result string.
+/* Given printf-like arguments, return a stable version of the result string.
We already have a working, optimized string hashing table in the form of
- the identifier table. Reusing this table is likely not to be wasted,
+ the identifier table. Reusing this table is likely not to be wasted,
since if the function name makes it to the gimple output of the frontend,
we'll have to create the identifier anyway. */
@@ -316,7 +316,7 @@ gfc_resolve_aint (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
{
gfc_typespec ts;
gfc_clear_ts (&ts);
-
+
f->ts.type = a->ts.type;
f->ts.kind = (kind == NULL) ? a->ts.kind : mpz_get_si (kind->value.integer);
@@ -363,7 +363,7 @@ gfc_resolve_anint (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
{
gfc_typespec ts;
gfc_clear_ts (&ts);
-
+
f->ts.type = a->ts.type;
f->ts.kind = (kind == NULL) ? a->ts.kind : mpz_get_si (kind->value.integer);
@@ -458,7 +458,7 @@ gfc_resolve_besn (gfc_expr *f, gfc_expr *n, gfc_expr *x)
{
gfc_typespec ts;
gfc_clear_ts (&ts);
-
+
f->ts = x->ts;
if (n->ts.kind != gfc_c_int_kind)
{
@@ -475,7 +475,7 @@ gfc_resolve_bessel_n2 (gfc_expr *f, gfc_expr *n1, gfc_expr *n2, gfc_expr *x)
{
gfc_typespec ts;
gfc_clear_ts (&ts);
-
+
f->ts = x->ts;
f->rank = 1;
if (n1->expr_type == EXPR_CONSTANT && n2->expr_type == EXPR_CONSTANT)
@@ -811,7 +811,7 @@ gfc_resolve_cshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
m = gfc_default_integer_kind;
if (dim != NULL)
m = m < dim->ts.kind ? dim->ts.kind : m;
-
+
/* Convert shift to at least m, so we don't need
kind=1 and kind=2 versions of the library functions. */
if (shift->ts.kind < m)
@@ -822,7 +822,7 @@ gfc_resolve_cshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
ts.kind = m;
gfc_convert_type_warn (shift, &ts, 2, 0);
}
-
+
if (dim != NULL)
{
if (dim->expr_type != EXPR_CONSTANT && dim->symtree != NULL
@@ -861,7 +861,7 @@ gfc_resolve_ctime (gfc_expr *f, gfc_expr *time)
{
gfc_typespec ts;
gfc_clear_ts (&ts);
-
+
f->ts.type = BT_CHARACTER;
f->ts.kind = gfc_default_character_kind;
@@ -976,7 +976,7 @@ gfc_resolve_eoshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
m = gfc_default_integer_kind;
if (dim != NULL)
m = m < dim->ts.kind ? dim->ts.kind : m;
-
+
/* Convert shift to at least m, so we don't need
kind=1 and kind=2 versions of the library functions. */
if (shift->ts.kind < m)
@@ -987,7 +987,7 @@ gfc_resolve_eoshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
ts.kind = m;
gfc_convert_type_warn (shift, &ts, 2, 0);
}
-
+
if (dim != NULL)
{
if (dim->expr_type != EXPR_CONSTANT && dim->symtree != NULL
@@ -1225,7 +1225,7 @@ void
gfc_resolve_iand (gfc_expr *f, gfc_expr *i, gfc_expr *j)
{
/* If the kind of i and j are different, then g77 cross-promoted the
- kinds to the largest value. The Fortran 95 standard requires the
+ kinds to the largest value. The Fortran 95 standard requires the
kinds to match. */
if (i->ts.kind != j->ts.kind)
{
@@ -1316,7 +1316,7 @@ void
gfc_resolve_ieor (gfc_expr *f, gfc_expr *i, gfc_expr *j)
{
/* If the kind of i and j are different, then g77 cross-promoted the
- kinds to the largest value. The Fortran 95 standard requires the
+ kinds to the largest value. The Fortran 95 standard requires the
kinds to match. */
if (i->ts.kind != j->ts.kind)
{
@@ -1335,7 +1335,7 @@ void
gfc_resolve_ior (gfc_expr *f, gfc_expr *i, gfc_expr *j)
{
/* If the kind of i and j are different, then g77 cross-promoted the
- kinds to the largest value. The Fortran 95 standard requires the
+ kinds to the largest value. The Fortran 95 standard requires the
kinds to match. */
if (i->ts.kind != j->ts.kind)
{
@@ -1435,7 +1435,7 @@ gfc_resolve_isatty (gfc_expr *f, gfc_expr *u)
{
gfc_typespec ts;
gfc_clear_ts (&ts);
-
+
f->ts.type = BT_LOGICAL;
f->ts.kind = gfc_default_integer_kind;
if (u->ts.kind != gfc_c_int_kind)
@@ -1642,7 +1642,7 @@ gfc_resolve_matmul (gfc_expr *f, gfc_expr *a, gfc_expr *b)
mpz_init_set (f->shape[0], b->shape[1]);
}
}
- else
+ else
{
/* b->rank == 1 and a->rank == 2 here, all other cases have
been caught in check.c. */
@@ -2961,6 +2961,19 @@ gfc_resolve_image_status (gfc_expr *f, gfc_expr *image ATTRIBUTE_UNUSED,
}
+/* Resolve get_team (). */
+
+void
+gfc_resolve_get_team (gfc_expr *f, gfc_expr *level ATTRIBUTE_UNUSED)
+{
+ static char get_team[] = "_gfortran_caf_get_team";
+ f->rank = 0;
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = gfc_default_integer_kind;
+ f->value.function.name = get_team;
+}
+
+
/* Resolve image_index (...). */
void
@@ -2991,6 +3004,19 @@ gfc_resolve_stopped_images (gfc_expr *f, gfc_expr *team ATTRIBUTE_UNUSED,
}
+/* Resolve team_number (team). */
+
+void
+gfc_resolve_team_number (gfc_expr *f, gfc_expr *team ATTRIBUTE_UNUSED)
+{
+ static char team_number[] = "_gfortran_caf_team_number";
+ f->rank = 0;
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = gfc_default_integer_kind;
+ f->value.function.name = team_number;
+}
+
+
void
gfc_resolve_this_image (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
gfc_expr *distance ATTRIBUTE_UNUSED)
@@ -3180,7 +3206,7 @@ gfc_resolve_ttynam (gfc_expr *f, gfc_expr *unit)
{
gfc_typespec ts;
gfc_clear_ts (&ts);
-
+
f->ts.type = BT_CHARACTER;
f->ts.kind = gfc_default_character_kind;
@@ -3399,7 +3425,7 @@ gfc_resolve_random_number (gfc_code *c)
name = gfc_get_string (PREFIX ("random_r%d"), kind);
else
name = gfc_get_string (PREFIX ("arandom_r%d"), kind);
-
+
c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
}
@@ -3444,7 +3470,7 @@ gfc_resolve_kill_sub (gfc_code *c)
name = gfc_get_string (PREFIX ("kill_i%d_sub"), kind);
c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
}
-
+
void
gfc_resolve_link_sub (gfc_code *c)
@@ -3777,7 +3803,7 @@ gfc_resolve_ctime_sub (gfc_code *c)
{
gfc_typespec ts;
gfc_clear_ts (&ts);
-
+
/* ctime TIME argument is a INTEGER(KIND=8), says the doc */
if (c->ext.actual->expr->ts.kind != 8)
{
@@ -3961,7 +3987,7 @@ gfc_resolve_fput_sub (gfc_code *c)
}
-void
+void
gfc_resolve_fseek_sub (gfc_code *c)
{
gfc_expr *unit;
@@ -4035,7 +4061,7 @@ gfc_resolve_ttynam_sub (gfc_code *c)
{
gfc_typespec ts;
gfc_clear_ts (&ts);
-
+
if (c->ext.actual->expr->ts.kind != gfc_c_int_kind)
{
ts.type = BT_INTEGER;
generated by cgit v1.1 at 2024-09-03 07:32:41 +0000