/* Intrinsic function resolution.
- Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+ 2009, 2010, 2011
Free Software Foundation, Inc.
Contributed by Andy Vaught & Katherine Holcomb
#include "tree.h"
#include "gfortran.h"
#include "intrinsic.h"
+#include "constructor.h"
+#include "arith.h"
/* Given printf-like arguments, return a stable version of the result string.
static void
check_charlen_present (gfc_expr *source)
{
- if (source->ts.cl == NULL)
- {
- source->ts.cl = gfc_get_charlen ();
- source->ts.cl->next = gfc_current_ns->cl_list;
- gfc_current_ns->cl_list = source->ts.cl;
- }
+ if (source->ts.u.cl == NULL)
+ source->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
if (source->expr_type == EXPR_CONSTANT)
{
- source->ts.cl->length = gfc_int_expr (source->value.character.length);
+ source->ts.u.cl->length
+ = gfc_get_int_expr (gfc_default_integer_kind, NULL,
+ source->value.character.length);
source->rank = 0;
}
else if (source->expr_type == EXPR_ARRAY)
- source->ts.cl->length =
- gfc_int_expr (source->value.constructor->expr->value.character.length);
+ {
+ gfc_constructor *c = gfc_constructor_first (source->value.constructor);
+ source->ts.u.cl->length
+ = gfc_get_int_expr (gfc_default_integer_kind, NULL,
+ c->expr->value.character.length);
+ }
}
/* Helper function for resolving the "mask" argument. */
{
ts.type = BT_LOGICAL;
ts.kind = 1;
- gfc_convert_type (mask, &ts, 2);
+ gfc_convert_type_warn (mask, &ts, 2, 0);
}
}
}
+
+static void
+resolve_bound (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *kind,
+ const char *name, bool coarray)
+{
+ f->ts.type = BT_INTEGER;
+ if (kind)
+ f->ts.kind = mpz_get_si (kind->value.integer);
+ else
+ f->ts.kind = gfc_default_integer_kind;
+
+ if (dim == NULL)
+ {
+ f->rank = 1;
+ f->shape = gfc_get_shape (1);
+ mpz_init_set_ui (f->shape[0], coarray ? gfc_get_corank (array)
+ : array->rank);
+ }
+
+ f->value.function.name = xstrdup (name);
+}
+
+
+static void
+resolve_transformational (const char *name, gfc_expr *f, gfc_expr *array,
+ gfc_expr *dim, gfc_expr *mask)
+{
+ const char *prefix;
+
+ f->ts = array->ts;
+
+ if (mask)
+ {
+ if (mask->rank == 0)
+ prefix = "s";
+ else
+ prefix = "m";
+
+ resolve_mask_arg (mask);
+ }
+ else
+ prefix = "";
+
+ if (dim != NULL)
+ {
+ f->rank = array->rank - 1;
+ f->shape = gfc_copy_shape_excluding (array->shape, array->rank, dim);
+ gfc_resolve_dim_arg (dim);
+ }
+
+ f->value.function.name
+ = gfc_get_string (PREFIX ("%s%s_%c%d"), prefix, name,
+ gfc_type_letter (array->ts.type), array->ts.kind);
+}
+
+
/********************** Resolution functions **********************/
f->ts.type = BT_CHARACTER;
f->ts.kind = (kind == NULL)
? gfc_default_character_kind : mpz_get_si (kind->value.integer);
- f->ts.cl = gfc_get_charlen ();
- f->ts.cl->next = gfc_current_ns->cl_list;
- gfc_current_ns->cl_list = f->ts.cl;
- f->ts.cl->length = gfc_int_expr (1);
+ f->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
+ f->ts.u.cl->length = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
f->value.function.name = gfc_get_string (name, f->ts.kind,
gfc_type_letter (x->ts.type),
void
+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)
+ {
+ f->shape = gfc_get_shape (1);
+ mpz_init (f->shape[0]);
+ mpz_sub (f->shape[0], n2->value.integer, n1->value.integer);
+ mpz_add_ui (f->shape[0], f->shape[0], 1);
+ }
+
+ if (n1->ts.kind != gfc_c_int_kind)
+ {
+ ts.type = BT_INTEGER;
+ ts.kind = gfc_c_int_kind;
+ gfc_convert_type (n1, &ts, 2);
+ }
+
+ if (n2->ts.kind != gfc_c_int_kind)
+ {
+ ts.type = BT_INTEGER;
+ ts.kind = gfc_c_int_kind;
+ gfc_convert_type (n2, &ts, 2);
+ }
+
+ if (f->value.function.isym->id == GFC_ISYM_JN2)
+ f->value.function.name = gfc_get_string (PREFIX ("bessel_jn_r%d"),
+ f->ts.kind);
+ else
+ f->value.function.name = gfc_get_string (PREFIX ("bessel_yn_r%d"),
+ f->ts.kind);
+}
+
+
+void
gfc_resolve_btest (gfc_expr *f, gfc_expr *i, gfc_expr *pos)
{
f->ts.type = BT_LOGICAL;
void
gfc_resolve_dcmplx (gfc_expr *f, gfc_expr *x, gfc_expr *y)
{
- gfc_resolve_cmplx (f, x, y, gfc_int_expr (gfc_default_double_kind));
+ gfc_resolve_cmplx (f, x, y, gfc_get_int_expr (gfc_default_integer_kind, NULL,
+ gfc_default_double_kind));
}
{
ts.type = BT_INTEGER;
ts.kind = 8;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (time, &ts, 2);
}
temp.value.op.op = INTRINSIC_NONE;
temp.value.op.op1 = a;
temp.value.op.op2 = b;
- gfc_type_convert_binary (&temp);
+ gfc_type_convert_binary (&temp, 1);
f->ts = temp.ts;
f->value.function.name
= gfc_get_string (PREFIX ("dot_product_%c%d"),
void
+gfc_resolve_dshift (gfc_expr *f, gfc_expr *i, gfc_expr *j ATTRIBUTE_UNUSED,
+ gfc_expr *shift ATTRIBUTE_UNUSED)
+{
+ f->ts = i->ts;
+ if (f->value.function.isym->id == GFC_ISYM_DSHIFTL)
+ f->value.function.name = gfc_get_string ("dshiftl_i%d", f->ts.kind);
+ else if (f->value.function.isym->id == GFC_ISYM_DSHIFTR)
+ f->value.function.name = gfc_get_string ("dshiftr_i%d", f->ts.kind);
+ else
+ gcc_unreachable ();
+}
+
+
+void
gfc_resolve_eoshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
gfc_expr *boundary, gfc_expr *dim)
{
}
+/* Resolve the EXTENDS_TYPE_OF intrinsic function. */
+
+void
+gfc_resolve_extends_type_of (gfc_expr *f, gfc_expr *a, gfc_expr *mo)
+{
+ gfc_symbol *vtab;
+ gfc_symtree *st;
+
+ /* Prevent double resolution. */
+ if (f->ts.type == BT_LOGICAL)
+ return;
+
+ /* Replace the first argument with the corresponding vtab. */
+ if (a->ts.type == BT_CLASS)
+ gfc_add_vptr_component (a);
+ else if (a->ts.type == BT_DERIVED)
+ {
+ vtab = gfc_find_derived_vtab (a->ts.u.derived);
+ /* Clear the old expr. */
+ gfc_free_ref_list (a->ref);
+ memset (a, '\0', sizeof (gfc_expr));
+ /* Construct a new one. */
+ a->expr_type = EXPR_VARIABLE;
+ st = gfc_find_symtree (vtab->ns->sym_root, vtab->name);
+ a->symtree = st;
+ a->ts = vtab->ts;
+ }
+
+ /* Replace the second argument with the corresponding vtab. */
+ if (mo->ts.type == BT_CLASS)
+ gfc_add_vptr_component (mo);
+ else if (mo->ts.type == BT_DERIVED)
+ {
+ vtab = gfc_find_derived_vtab (mo->ts.u.derived);
+ /* Clear the old expr. */
+ gfc_free_ref_list (mo->ref);
+ memset (mo, '\0', sizeof (gfc_expr));
+ /* Construct a new one. */
+ mo->expr_type = EXPR_VARIABLE;
+ st = gfc_find_symtree (vtab->ns->sym_root, vtab->name);
+ mo->symtree = st;
+ mo->ts = vtab->ts;
+ }
+
+ f->ts.type = BT_LOGICAL;
+ f->ts.kind = 4;
+
+ f->value.function.isym->formal->ts = a->ts;
+ f->value.function.isym->formal->next->ts = mo->ts;
+
+ /* Call library function. */
+ f->value.function.name = gfc_get_string (PREFIX ("is_extension_of"));
+}
+
+
void
gfc_resolve_fdate (gfc_expr *f)
{
{
f->ts = x->ts;
f->value.function.name
- = gfc_get_string ("__gamma_%d", x->ts.kind);
+ = gfc_get_string ("__tgamma_%d", x->ts.kind);
}
void
+gfc_resolve_iall (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
+{
+ resolve_transformational ("iall", f, array, dim, mask);
+}
+
+
+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
void
+gfc_resolve_iany (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
+{
+ resolve_transformational ("iany", f, array, dim, mask);
+}
+
+
+void
gfc_resolve_ibclr (gfc_expr *f, gfc_expr *i, gfc_expr *pos ATTRIBUTE_UNUSED)
{
f->ts = i->ts;
{
ts.type = BT_LOGICAL;
ts.kind = gfc_default_integer_kind;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (back, &ts, 2);
}
void
+gfc_resolve_iparity (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
+{
+ resolve_transformational ("iparity", f, array, dim, mask);
+}
+
+
+void
gfc_resolve_isatty (gfc_expr *f, gfc_expr *u)
{
gfc_typespec ts;
{
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (u, &ts, 2);
}
void
gfc_resolve_lbound (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
{
- static char lbound[] = "__lbound";
+ resolve_bound (f, array, dim, kind, "__lbound", false);
+}
- f->ts.type = BT_INTEGER;
- if (kind)
- f->ts.kind = mpz_get_si (kind->value.integer);
- else
- f->ts.kind = gfc_default_integer_kind;
- if (dim == NULL)
- {
- f->rank = 1;
- f->shape = gfc_get_shape (1);
- mpz_init_set_ui (f->shape[0], array->rank);
- }
-
- f->value.function.name = lbound;
+void
+gfc_resolve_lcobound (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
+{
+ resolve_bound (f, array, dim, kind, "__lcobound", true);
}
temp.value.op.op = INTRINSIC_NONE;
temp.value.op.op1 = a;
temp.value.op.op2 = b;
- gfc_type_convert_binary (&temp);
+ gfc_type_convert_binary (&temp, 1);
f->ts = temp.ts;
}
void
+gfc_resolve_mask (gfc_expr *f, gfc_expr *i ATTRIBUTE_UNUSED,
+ gfc_expr *kind)
+{
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = kind ? mpz_get_si (kind->value.integer)
+ : gfc_default_integer_kind;
+
+ if (f->value.function.isym->id == GFC_ISYM_MASKL)
+ f->value.function.name = gfc_get_string ("__maskl_i%d", f->ts.kind);
+ else
+ f->value.function.name = gfc_get_string ("__maskr_i%d", f->ts.kind);
+}
+
+
+void
gfc_resolve_merge (gfc_expr *f, gfc_expr *tsource,
gfc_expr *fsource ATTRIBUTE_UNUSED,
gfc_expr *mask ATTRIBUTE_UNUSED)
void
+gfc_resolve_merge_bits (gfc_expr *f, gfc_expr *i,
+ gfc_expr *j ATTRIBUTE_UNUSED,
+ gfc_expr *mask ATTRIBUTE_UNUSED)
+{
+ f->ts = i->ts;
+ f->value.function.name = gfc_get_string ("__merge_bits_i%d", i->ts.kind);
+}
+
+
+void
gfc_resolve_min (gfc_expr *f, gfc_actual_arglist *args)
{
gfc_resolve_minmax ("__min_%c%d", f, args);
void
+gfc_resolve_norm2 (gfc_expr *f, gfc_expr *array, gfc_expr *dim)
+{
+ resolve_transformational ("norm2", f, array, dim, NULL);
+}
+
+
+void
gfc_resolve_not (gfc_expr *f, gfc_expr *i)
{
f->ts = i->ts;
void
-gfc_resolve_product (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
- gfc_expr *mask)
+gfc_resolve_parity (gfc_expr *f, gfc_expr *array, gfc_expr *dim)
{
- const char *name;
-
- f->ts = array->ts;
-
- if (dim != NULL)
- {
- f->rank = array->rank - 1;
- f->shape = gfc_copy_shape_excluding (array->shape, array->rank, dim);
- gfc_resolve_dim_arg (dim);
- }
-
- if (mask)
- {
- if (mask->rank == 0)
- name = "sproduct";
- else
- name = "mproduct";
+ resolve_transformational ("parity", f, array, dim, NULL);
+}
- resolve_mask_arg (mask);
- }
- else
- name = "product";
- f->value.function.name
- = gfc_get_string (PREFIX ("%s_%c%d"), name,
- gfc_type_letter (array->ts.type), array->ts.kind);
+void
+gfc_resolve_product (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
+ gfc_expr *mask)
+{
+ resolve_transformational ("product", f, array, dim, mask);
}
void
gfc_resolve_repeat (gfc_expr *f, gfc_expr *string,
- gfc_expr *ncopies ATTRIBUTE_UNUSED)
+ gfc_expr *ncopies)
{
+ int len;
+ gfc_expr *tmp;
f->ts.type = BT_CHARACTER;
f->ts.kind = string->ts.kind;
f->value.function.name = gfc_get_string ("__repeat_%d", string->ts.kind);
+
+ /* If possible, generate a character length. */
+ if (f->ts.u.cl == NULL)
+ f->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
+
+ tmp = NULL;
+ if (string->expr_type == EXPR_CONSTANT)
+ {
+ len = string->value.character.length;
+ tmp = gfc_get_int_expr (gfc_default_integer_kind, NULL , len);
+ }
+ else if (string->ts.u.cl && string->ts.u.cl->length)
+ {
+ tmp = gfc_copy_expr (string->ts.u.cl->length);
+ }
+
+ if (tmp)
+ f->ts.u.cl->length = gfc_multiply (tmp, gfc_copy_expr (ncopies));
}
{
gfc_constructor *c;
f->shape = gfc_get_shape (f->rank);
- c = shape->value.constructor;
+ c = gfc_constructor_first (shape->value.constructor);
for (i = 0; i < f->rank; i++)
{
mpz_init_set (f->shape[i], c->expr->value.integer);
- c = c->next;
+ c = gfc_constructor_next (c);
}
}
void
-gfc_resolve_shape (gfc_expr *f, gfc_expr *array)
+gfc_resolve_shape (gfc_expr *f, gfc_expr *array, gfc_expr *kind)
{
f->ts.type = BT_INTEGER;
- f->ts.kind = gfc_default_integer_kind;
+
+ if (kind)
+ f->ts.kind = mpz_get_si (kind->value.integer);
+ else
+ f->ts.kind = gfc_default_integer_kind;
+
f->rank = 1;
f->shape = gfc_get_shape (1);
mpz_init_set_ui (f->shape[0], array->rank);
void
+gfc_resolve_shift (gfc_expr *f, gfc_expr *i, gfc_expr *shift ATTRIBUTE_UNUSED)
+{
+ f->ts = i->ts;
+ if (f->value.function.isym->id == GFC_ISYM_SHIFTA)
+ f->value.function.name = gfc_get_string ("shifta_i%d", f->ts.kind);
+ else if (f->value.function.isym->id == GFC_ISYM_SHIFTL)
+ f->value.function.name = gfc_get_string ("shiftl_i%d", f->ts.kind);
+ else if (f->value.function.isym->id == GFC_ISYM_SHIFTR)
+ f->value.function.name = gfc_get_string ("shiftr_i%d", f->ts.kind);
+ else
+ gcc_unreachable ();
+}
+
+
+void
gfc_resolve_sign (gfc_expr *f, gfc_expr *a, gfc_expr *b ATTRIBUTE_UNUSED)
{
f->ts = a->ts;
{
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (u, &ts, 2);
}
{
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (u, &ts, 2);
}
{
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (u, &ts, 2);
}
void
-gfc_resolve_sum (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
+gfc_resolve_storage_size (gfc_expr *f, gfc_expr *a ATTRIBUTE_UNUSED,
+ gfc_expr *kind)
{
- const char *name;
-
- f->ts = array->ts;
-
- if (mask)
- {
- if (mask->rank == 0)
- name = "ssum";
- else
- name = "msum";
-
- resolve_mask_arg (mask);
- }
+ f->ts.type = BT_INTEGER;
+ if (kind)
+ f->ts.kind = mpz_get_si (kind->value.integer);
else
- name = "sum";
+ f->ts.kind = gfc_default_integer_kind;
+}
- if (dim != NULL)
- {
- f->rank = array->rank - 1;
- f->shape = gfc_copy_shape_excluding (array->shape, array->rank, dim);
- gfc_resolve_dim_arg (dim);
- }
- f->value.function.name
- = gfc_get_string (PREFIX ("%s_%c%d"), name,
- gfc_type_letter (array->ts.type), array->ts.kind);
+void
+gfc_resolve_sum (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *mask)
+{
+ resolve_transformational ("sum", f, array, dim, mask);
}
void
+gfc_resolve_image_index (gfc_expr *f, gfc_expr *array ATTRIBUTE_UNUSED,
+ gfc_expr *sub ATTRIBUTE_UNUSED)
+{
+ static char image_index[] = "__image_index";
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = gfc_default_integer_kind;
+ f->value.function.name = image_index;
+}
+
+
+void
+gfc_resolve_this_image (gfc_expr *f, gfc_expr *array, gfc_expr *dim)
+{
+ static char this_image[] = "__this_image";
+ if (array)
+ resolve_bound (f, array, dim, NULL, "__this_image", true);
+ else
+ {
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = gfc_default_integer_kind;
+ f->value.function.name = this_image;
+ }
+}
+
+
+void
gfc_resolve_time (gfc_expr *f)
{
f->ts.type = BT_INTEGER;
/* TODO: Make this do something meaningful. */
static char transfer0[] = "__transfer0", transfer1[] = "__transfer1";
- if (mold->ts.type == BT_CHARACTER && !mold->ts.cl->length
- && !(mold->expr_type == EXPR_VARIABLE && mold->symtree->n.sym->attr.dummy))
- mold->ts.cl->length = gfc_int_expr (mold->value.character.length);
+ if (mold->ts.type == BT_CHARACTER
+ && !mold->ts.u.cl->length
+ && gfc_is_constant_expr (mold))
+ {
+ int len;
+ if (mold->expr_type == EXPR_CONSTANT)
+ {
+ len = mold->value.character.length;
+ mold->ts.u.cl->length = gfc_get_int_expr (gfc_default_integer_kind,
+ NULL, len);
+ }
+ else
+ {
+ gfc_constructor *c = gfc_constructor_first (mold->value.constructor);
+ len = c->expr->value.character.length;
+ mold->ts.u.cl->length = gfc_get_int_expr (gfc_default_integer_kind,
+ NULL, len);
+ }
+ }
f->ts = mold->ts;
void
gfc_resolve_ubound (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
{
- static char ubound[] = "__ubound";
-
- f->ts.type = BT_INTEGER;
- if (kind)
- f->ts.kind = mpz_get_si (kind->value.integer);
- else
- f->ts.kind = gfc_default_integer_kind;
+ resolve_bound (f, array, dim, kind, "__ubound", false);
+}
- if (dim == NULL)
- {
- f->rank = 1;
- f->shape = gfc_get_shape (1);
- mpz_init_set_ui (f->shape[0], array->rank);
- }
- f->value.function.name = ubound;
+void
+gfc_resolve_ucobound (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
+{
+ resolve_bound (f, array, dim, kind, "__ucobound", true);
}
{
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (unit, &ts, 2);
}
gfc_resolve_alarm_sub (gfc_code *c)
{
const char *name;
- gfc_expr *seconds, *handler, *status;
+ gfc_expr *seconds, *handler;
gfc_typespec ts;
gfc_clear_ts (&ts);
seconds = c->ext.actual->expr;
handler = c->ext.actual->next->expr;
- status = c->ext.actual->next->next->expr;
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
void
+gfc_resolve_atomic_def (gfc_code *c)
+{
+ const char *name = "atomic_define";
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
+gfc_resolve_atomic_ref (gfc_code *c)
+{
+ const char *name = "atomic_ref";
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
+void
gfc_resolve_mvbits (gfc_code *c)
{
static const sym_intent INTENTS[] = {INTENT_IN, INTENT_IN, INTENT_IN,
}
+/* Resolve the EXECUTE_COMMAND_LINE intrinsic subroutine. */
+void
+gfc_resolve_execute_command_line (gfc_code *c)
+{
+ const char *name;
+ name = gfc_get_string (PREFIX ("execute_command_line_i%d"),
+ gfc_default_integer_kind);
+ c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
+}
+
+
/* Resolve the EXIT intrinsic subroutine. */
void
{
ts.type = BT_INTEGER;
ts.kind = 8;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (c->ext.actual->expr, &ts, 2);
}
{
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (u, &ts, 2);
}
{
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (u, &ts, 2);
}
gfc_expr *unit;
gfc_expr *offset;
gfc_expr *whence;
- gfc_expr *status;
gfc_typespec ts;
gfc_clear_ts (&ts);
unit = c->ext.actual->expr;
offset = c->ext.actual->next->expr;
whence = c->ext.actual->next->next->expr;
- status = c->ext.actual->next->next->next->expr;
if (unit->ts.kind != gfc_c_int_kind)
{
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (unit, &ts, 2);
}
{
ts.type = BT_INTEGER;
ts.kind = gfc_intio_kind;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (offset, &ts, 2);
}
{
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (whence, &ts, 2);
}
{
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (unit, &ts, 2);
}
{
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
- ts.derived = NULL;
- ts.cl = NULL;
+ ts.u.derived = NULL;
+ ts.u.cl = NULL;
gfc_convert_type (c->ext.actual->expr, &ts, 2);
}
OSDN Git Service
