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.c85
1 files changed, 85 insertions, 0 deletions
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 0379d70..7516875 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -553,6 +553,18 @@ gfc_resolve_floor (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
void
+gfc_resolve_fnum (gfc_expr * f, gfc_expr * n)
+{
+
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = gfc_default_integer_kind;
+ if (n->ts.kind != f->ts.kind)
+ gfc_convert_type (n, &f->ts, 2);
+ f->value.function.name = gfc_get_string (PREFIX("fnum_i%d"), f->ts.kind);
+}
+
+
+void
gfc_resolve_fraction (gfc_expr * f, gfc_expr * x)
{
@@ -1283,6 +1295,32 @@ gfc_resolve_sqrt (gfc_expr * f, gfc_expr * x)
}
+/* Resolve the g77 compatibility function STAT AND FSTAT. */
+
+void
+gfc_resolve_stat (gfc_expr * f, gfc_expr * n ATTRIBUTE_UNUSED,
+ gfc_expr * a ATTRIBUTE_UNUSED)
+{
+
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = gfc_default_integer_kind;
+ f->value.function.name = gfc_get_string (PREFIX("stat_i%d"), f->ts.kind);
+}
+
+
+void
+gfc_resolve_fstat (gfc_expr * f, gfc_expr * n, gfc_expr * a ATTRIBUTE_UNUSED)
+{
+
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = gfc_default_integer_kind;
+ if (n->ts.kind != f->ts.kind)
+ gfc_convert_type (n, &f->ts, 2);
+
+ f->value.function.name = gfc_get_string (PREFIX("fstat_i%d"), f->ts.kind);
+}
+
+
void
gfc_resolve_sum (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
gfc_expr * mask)
@@ -1679,6 +1717,53 @@ gfc_resolve_exit (gfc_code * c)
c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
}
+/* Resolve the FLUSH intrinsic subroutine. */
+
+void
+gfc_resolve_flush (gfc_code * c)
+{
+ const char *name;
+ gfc_typespec ts;
+ gfc_expr *n;
+
+ ts.type = BT_INTEGER;
+ ts.kind = gfc_default_integer_kind;
+ n = c->ext.actual->expr;
+ if (n != NULL
+ && n->ts.kind != ts.kind)
+ gfc_convert_type (n, &ts, 2);
+
+ name = gfc_get_string (PREFIX("flush_i%d"), ts.kind);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+/* Resolve the STAT and FSTAT intrinsic subroutines. */
+
+void
+gfc_resolve_stat_sub (gfc_code * c)
+{
+ const char *name;
+
+ name = gfc_get_string (PREFIX("stat_i%d_sub"), gfc_default_integer_kind);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_fstat_sub (gfc_code * c)
+{
+ const char *name;
+ gfc_expr *u;
+ gfc_typespec *ts;
+
+ u = c->ext.actual->expr;
+ ts = &c->ext.actual->next->expr->ts;
+ if (u->ts.kind != ts->kind)
+ gfc_convert_type (u, ts, 2);
+ name = gfc_get_string (PREFIX("fstat_i%d_sub"), ts->kind);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
/* Resolve the UMASK intrinsic subroutine. */
void