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.c230
1 files changed, 224 insertions, 6 deletions
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index a4ab2251761..746b97df444 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -253,6 +253,31 @@ gfc_resolve_char (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
void
+gfc_resolve_chdir (gfc_expr * f, gfc_expr * d ATTRIBUTE_UNUSED)
+{
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = gfc_default_integer_kind;
+ f->value.function.name = gfc_get_string (PREFIX("chdir_i%d"), f->ts.kind);
+}
+
+
+void
+gfc_resolve_chdir_sub (gfc_code * c)
+{
+ const char *name;
+ int kind;
+
+ if (c->ext.actual->next->expr != NULL)
+ kind = c->ext.actual->next->expr->ts.kind;
+ else
+ kind = gfc_default_integer_kind;
+
+ name = gfc_get_string (PREFIX("chdir_i%d_sub"), kind);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
gfc_resolve_cmplx (gfc_expr * f, gfc_expr * x, gfc_expr * y, gfc_expr * kind)
{
f->ts.type = BT_COMPLEX;
@@ -383,9 +408,9 @@ gfc_resolve_dot_product (gfc_expr * f, gfc_expr * a, gfc_expr * b)
{
temp.expr_type = EXPR_OP;
gfc_clear_ts (&temp.ts);
- temp.operator = INTRINSIC_NONE;
- temp.op1 = a;
- temp.op2 = b;
+ temp.value.op.operator = INTRINSIC_NONE;
+ temp.value.op.op1 = a;
+ temp.value.op.op2 = b;
gfc_type_convert_binary (&temp);
f->ts = temp.ts;
}
@@ -533,6 +558,14 @@ gfc_resolve_getuid (gfc_expr * f)
}
void
+gfc_resolve_hostnm (gfc_expr * f, gfc_expr * n ATTRIBUTE_UNUSED)
+{
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = 4;
+ f->value.function.name = gfc_get_string (PREFIX ("hostnm"));
+}
+
+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
@@ -596,6 +629,15 @@ gfc_resolve_idnint (gfc_expr * f, gfc_expr * a)
void
+gfc_resolve_ierrno (gfc_expr * f)
+{
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = gfc_default_integer_kind;
+ f->value.function.name = gfc_get_string (PREFIX("ierrno_i%d"), f->ts.kind);
+}
+
+
+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
@@ -670,6 +712,17 @@ gfc_resolve_ishftc (gfc_expr * f, gfc_expr * i, gfc_expr * shift,
void
+gfc_resolve_kill (gfc_expr * f, ATTRIBUTE_UNUSED gfc_expr * p,
+ ATTRIBUTE_UNUSED gfc_expr * s)
+{
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = gfc_default_integer_kind;
+
+ f->value.function.name = gfc_get_string (PREFIX("kill_i%d"), f->ts.kind);
+}
+
+
+void
gfc_resolve_lbound (gfc_expr * f, gfc_expr * array,
gfc_expr * dim)
{
@@ -708,6 +761,16 @@ gfc_resolve_len_trim (gfc_expr * f, gfc_expr * string)
void
+gfc_resolve_link (gfc_expr * f, gfc_expr * p1 ATTRIBUTE_UNUSED,
+ gfc_expr * p2 ATTRIBUTE_UNUSED)
+{
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = gfc_default_integer_kind;
+ f->value.function.name = gfc_get_string (PREFIX("link_i%d"), f->ts.kind);
+}
+
+
+void
gfc_resolve_log (gfc_expr * f, gfc_expr * x)
{
f->ts = x->ts;
@@ -753,9 +816,9 @@ gfc_resolve_matmul (gfc_expr * f, gfc_expr * a, gfc_expr * b)
{
temp.expr_type = EXPR_OP;
gfc_clear_ts (&temp.ts);
- temp.operator = INTRINSIC_NONE;
- temp.op1 = a;
- temp.op2 = b;
+ temp.value.op.operator = INTRINSIC_NONE;
+ temp.value.op.op1 = a;
+ temp.value.op.op2 = b;
gfc_type_convert_binary (&temp);
f->ts = temp.ts;
}
@@ -1019,6 +1082,16 @@ gfc_resolve_real (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
void
+gfc_resolve_rename (gfc_expr * f, gfc_expr * p1 ATTRIBUTE_UNUSED,
+ gfc_expr * p2 ATTRIBUTE_UNUSED)
+{
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = gfc_default_integer_kind;
+ f->value.function.name = gfc_get_string (PREFIX("rename_i%d"), f->ts.kind);
+}
+
+
+void
gfc_resolve_repeat (gfc_expr * f, gfc_expr * string,
gfc_expr * ncopies ATTRIBUTE_UNUSED)
{
@@ -1275,6 +1348,16 @@ gfc_resolve_sum (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
}
+void
+gfc_resolve_symlnk (gfc_expr * f, gfc_expr * p1 ATTRIBUTE_UNUSED,
+ gfc_expr * p2 ATTRIBUTE_UNUSED)
+{
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = gfc_default_integer_kind;
+ f->value.function.name = gfc_get_string (PREFIX("symlnk_i%d"), f->ts.kind);
+}
+
+
/* Resolve the g77 compatibility function SYSTEM. */
void
@@ -1305,6 +1388,24 @@ gfc_resolve_tanh (gfc_expr * f, gfc_expr * x)
void
+gfc_resolve_time (gfc_expr * f)
+{
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = 4;
+ f->value.function.name = gfc_get_string (PREFIX("time_func"));
+}
+
+
+void
+gfc_resolve_time8 (gfc_expr * f)
+{
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = 8;
+ f->value.function.name = gfc_get_string (PREFIX("time8_func"));
+}
+
+
+void
gfc_resolve_transfer (gfc_expr * f, gfc_expr * source ATTRIBUTE_UNUSED,
gfc_expr * mold, gfc_expr * size)
{
@@ -1490,6 +1591,70 @@ gfc_resolve_random_number (gfc_code * c ATTRIBUTE_UNUSED)
}
+void
+gfc_resolve_rename_sub (gfc_code * c)
+{
+ const char *name;
+ int kind;
+
+ if (c->ext.actual->next->next->expr != NULL)
+ kind = c->ext.actual->next->next->expr->ts.kind;
+ else
+ kind = gfc_default_integer_kind;
+
+ name = gfc_get_string (PREFIX("rename_i%d_sub"), kind);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_kill_sub (gfc_code * c)
+{
+ const char *name;
+ int kind;
+
+ if (c->ext.actual->next->next->expr != NULL)
+ kind = c->ext.actual->next->next->expr->ts.kind;
+ else
+ kind = gfc_default_integer_kind;
+
+ 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)
+{
+ const char *name;
+ int kind;
+
+ if (c->ext.actual->next->next->expr != NULL)
+ kind = c->ext.actual->next->next->expr->ts.kind;
+ else
+ kind = gfc_default_integer_kind;
+
+ name = gfc_get_string (PREFIX("link_i%d_sub"), kind);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_symlnk_sub (gfc_code * c)
+{
+ const char *name;
+ int kind;
+
+ if (c->ext.actual->next->next->expr != NULL)
+ kind = c->ext.actual->next->next->expr->ts.kind;
+ else
+ kind = gfc_default_integer_kind;
+
+ name = gfc_get_string (PREFIX("symlnk_i%d_sub"), kind);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
/* G77 compatibility subroutines etime() and dtime(). */
void
@@ -1514,6 +1679,22 @@ gfc_resolve_second_sub (gfc_code * c)
}
+void
+gfc_resolve_sleep_sub (gfc_code * c)
+{
+ const char *name;
+ int kind;
+
+ if (c->ext.actual->expr != NULL)
+ kind = c->ext.actual->expr->ts.kind;
+ else
+ kind = gfc_default_integer_kind;
+
+ name = gfc_get_string (PREFIX("sleep_i%d_sub"), kind);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
/* G77 compatibility function srand(). */
void
@@ -1665,6 +1846,43 @@ gfc_resolve_flush (gfc_code * c)
c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
}
+
+void
+gfc_resolve_gerror (gfc_code * c)
+{
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("gerror"));
+}
+
+
+void
+gfc_resolve_getlog (gfc_code * c)
+{
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("getlog"));
+}
+
+
+void
+gfc_resolve_hostnm_sub (gfc_code * c)
+{
+ const char *name;
+ int kind;
+
+ if (c->ext.actual->next->expr != NULL)
+ kind = c->ext.actual->next->expr->ts.kind;
+ else
+ kind = gfc_default_integer_kind;
+
+ name = gfc_get_string (PREFIX("hostnm_i%d_sub"), kind);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_perror (gfc_code * c)
+{
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX ("perror_sub"));
+}
+
/* Resolve the STAT and FSTAT intrinsic subroutines. */
void
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-01 20:32:55 +0000