Commit 9d64df18 by Tobias Schlüter Committed by Tobias Schlüter

gfortran.h (gfc_default_*_kind): Remove prototypes, add extern variable declaration of same name.

* gfortran.h (gfc_default_*_kind): Remove prototypes, add extern
variable declaration of same name.
* arith.c, check.c, decl.c, dump_parse_tree.c, expr.c,
intrinsic.c, io.c, iresolve.c, match.c, options.c, primary.c,
resolve.c, simplify.c, symbol.c, trans-const.c, trans-io.c:
Replace all calls to gfc_default_*_kind with variable accesses.
* trans-types.c: Same as above.
(gfc_default_*_kind_1): Rename to gfc_default_*_kind, remove
static qualifier. Replace all occurences.
(gfc_default_*_kind): Remove functions.

From-SVN: r86662
parent 0be27b59
2004-08-27 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
* gfortran.h (gfc_default_*_kind): Remove prototypes, add extern
variable declaration of same name.
* arith.c, check.c, decl.c, dump_parse_tree.c, expr.c,
intrinsic.c, io.c, iresolve.c, match.c, options.c, primary.c,
resolve.c, simplify.c, symbol.c, trans-const.c, trans-io.c:
Replace all calls to gfc_default_*_kind with variable accesses.
* trans-types.c: Same as above.
(gfc_default_*_kind_1): Rename to gfc_default_*_kind, remove
static qualifier. Replace all occurences.
(gfc_default_*_kind): Remove functions.
2004-08-26 Richard Henderson <rth@redhat.com> 2004-08-26 Richard Henderson <rth@redhat.com>
* arith.c: Include system.h, not real system headers. * arith.c: Include system.h, not real system headers.
......
...@@ -1047,7 +1047,7 @@ gfc_arith_concat (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp) ...@@ -1047,7 +1047,7 @@ gfc_arith_concat (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp)
gfc_expr *result; gfc_expr *result;
int len; int len;
result = gfc_constant_result (BT_CHARACTER, gfc_default_character_kind (), result = gfc_constant_result (BT_CHARACTER, gfc_default_character_kind,
&op1->where); &op1->where);
len = op1->value.character.length + op2->value.character.length; len = op1->value.character.length + op2->value.character.length;
...@@ -1161,7 +1161,7 @@ gfc_arith_eq (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp) ...@@ -1161,7 +1161,7 @@ gfc_arith_eq (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp)
{ {
gfc_expr *result; gfc_expr *result;
result = gfc_constant_result (BT_LOGICAL, gfc_default_logical_kind (), result = gfc_constant_result (BT_LOGICAL, gfc_default_logical_kind,
&op1->where); &op1->where);
result->value.logical = (op1->ts.type == BT_COMPLEX) ? result->value.logical = (op1->ts.type == BT_COMPLEX) ?
compare_complex (op1, op2) : (gfc_compare_expr (op1, op2) == 0); compare_complex (op1, op2) : (gfc_compare_expr (op1, op2) == 0);
...@@ -1176,7 +1176,7 @@ gfc_arith_ne (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp) ...@@ -1176,7 +1176,7 @@ gfc_arith_ne (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp)
{ {
gfc_expr *result; gfc_expr *result;
result = gfc_constant_result (BT_LOGICAL, gfc_default_logical_kind (), result = gfc_constant_result (BT_LOGICAL, gfc_default_logical_kind,
&op1->where); &op1->where);
result->value.logical = (op1->ts.type == BT_COMPLEX) ? result->value.logical = (op1->ts.type == BT_COMPLEX) ?
!compare_complex (op1, op2) : (gfc_compare_expr (op1, op2) != 0); !compare_complex (op1, op2) : (gfc_compare_expr (op1, op2) != 0);
...@@ -1191,7 +1191,7 @@ gfc_arith_gt (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp) ...@@ -1191,7 +1191,7 @@ gfc_arith_gt (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp)
{ {
gfc_expr *result; gfc_expr *result;
result = gfc_constant_result (BT_LOGICAL, gfc_default_logical_kind (), result = gfc_constant_result (BT_LOGICAL, gfc_default_logical_kind,
&op1->where); &op1->where);
result->value.logical = (gfc_compare_expr (op1, op2) > 0); result->value.logical = (gfc_compare_expr (op1, op2) > 0);
*resultp = result; *resultp = result;
...@@ -1205,7 +1205,7 @@ gfc_arith_ge (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp) ...@@ -1205,7 +1205,7 @@ gfc_arith_ge (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp)
{ {
gfc_expr *result; gfc_expr *result;
result = gfc_constant_result (BT_LOGICAL, gfc_default_logical_kind (), result = gfc_constant_result (BT_LOGICAL, gfc_default_logical_kind,
&op1->where); &op1->where);
result->value.logical = (gfc_compare_expr (op1, op2) >= 0); result->value.logical = (gfc_compare_expr (op1, op2) >= 0);
*resultp = result; *resultp = result;
...@@ -1219,7 +1219,7 @@ gfc_arith_lt (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp) ...@@ -1219,7 +1219,7 @@ gfc_arith_lt (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp)
{ {
gfc_expr *result; gfc_expr *result;
result = gfc_constant_result (BT_LOGICAL, gfc_default_logical_kind (), result = gfc_constant_result (BT_LOGICAL, gfc_default_logical_kind,
&op1->where); &op1->where);
result->value.logical = (gfc_compare_expr (op1, op2) < 0); result->value.logical = (gfc_compare_expr (op1, op2) < 0);
*resultp = result; *resultp = result;
...@@ -1233,7 +1233,7 @@ gfc_arith_le (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp) ...@@ -1233,7 +1233,7 @@ gfc_arith_le (gfc_expr * op1, gfc_expr * op2, gfc_expr ** resultp)
{ {
gfc_expr *result; gfc_expr *result;
result = gfc_constant_result (BT_LOGICAL, gfc_default_logical_kind (), result = gfc_constant_result (BT_LOGICAL, gfc_default_logical_kind,
&op1->where); &op1->where);
result->value.logical = (gfc_compare_expr (op1, op2) <= 0); result->value.logical = (gfc_compare_expr (op1, op2) <= 0);
*resultp = result; *resultp = result;
...@@ -1479,7 +1479,7 @@ eval_intrinsic (gfc_intrinsic_op operator, ...@@ -1479,7 +1479,7 @@ eval_intrinsic (gfc_intrinsic_op operator,
goto runtime; goto runtime;
temp.ts.type = BT_LOGICAL; temp.ts.type = BT_LOGICAL;
temp.ts.kind = gfc_default_logical_kind (); temp.ts.kind = gfc_default_logical_kind;
unary = 1; unary = 1;
break; break;
...@@ -1493,7 +1493,7 @@ eval_intrinsic (gfc_intrinsic_op operator, ...@@ -1493,7 +1493,7 @@ eval_intrinsic (gfc_intrinsic_op operator,
goto runtime; goto runtime;
temp.ts.type = BT_LOGICAL; temp.ts.type = BT_LOGICAL;
temp.ts.kind = gfc_default_logical_kind (); temp.ts.kind = gfc_default_logical_kind;
unary = 0; unary = 0;
break; break;
...@@ -1515,7 +1515,7 @@ eval_intrinsic (gfc_intrinsic_op operator, ...@@ -1515,7 +1515,7 @@ eval_intrinsic (gfc_intrinsic_op operator,
if (op1->ts.type == BT_COMPLEX || op2->ts.type == BT_COMPLEX) if (op1->ts.type == BT_COMPLEX || op2->ts.type == BT_COMPLEX)
{ {
temp.ts.type = BT_LOGICAL; temp.ts.type = BT_LOGICAL;
temp.ts.kind = gfc_default_logical_kind(); temp.ts.kind = gfc_default_logical_kind;
goto runtime; goto runtime;
} }
...@@ -1527,7 +1527,7 @@ eval_intrinsic (gfc_intrinsic_op operator, ...@@ -1527,7 +1527,7 @@ eval_intrinsic (gfc_intrinsic_op operator,
{ {
unary = 0; unary = 0;
temp.ts.type = BT_LOGICAL; temp.ts.type = BT_LOGICAL;
temp.ts.kind = gfc_default_logical_kind(); temp.ts.kind = gfc_default_logical_kind;
break; break;
} }
...@@ -1557,7 +1557,7 @@ eval_intrinsic (gfc_intrinsic_op operator, ...@@ -1557,7 +1557,7 @@ eval_intrinsic (gfc_intrinsic_op operator,
|| operator == INTRINSIC_LE || operator == INTRINSIC_LT) || operator == INTRINSIC_LE || operator == INTRINSIC_LT)
{ {
temp.ts.type = BT_LOGICAL; temp.ts.type = BT_LOGICAL;
temp.ts.kind = gfc_default_logical_kind (); temp.ts.kind = gfc_default_logical_kind;
} }
unary = 0; unary = 0;
...@@ -1568,7 +1568,7 @@ eval_intrinsic (gfc_intrinsic_op operator, ...@@ -1568,7 +1568,7 @@ eval_intrinsic (gfc_intrinsic_op operator,
goto runtime; goto runtime;
temp.ts.type = BT_CHARACTER; temp.ts.type = BT_CHARACTER;
temp.ts.kind = gfc_default_character_kind (); temp.ts.kind = gfc_default_character_kind;
unary = 0; unary = 0;
break; break;
...@@ -1645,7 +1645,7 @@ eval_type_intrinsic0 (gfc_intrinsic_op operator, gfc_expr *op) ...@@ -1645,7 +1645,7 @@ eval_type_intrinsic0 (gfc_intrinsic_op operator, gfc_expr *op)
case INTRINSIC_EQ: case INTRINSIC_EQ:
case INTRINSIC_NE: case INTRINSIC_NE:
op->ts.type = BT_LOGICAL; op->ts.type = BT_LOGICAL;
op->ts.kind = gfc_default_logical_kind(); op->ts.kind = gfc_default_logical_kind;
break; break;
default: default:
......
...@@ -136,7 +136,7 @@ double_check (gfc_expr * d, int n) ...@@ -136,7 +136,7 @@ double_check (gfc_expr * d, int n)
if (type_check (d, n, BT_REAL) == FAILURE) if (type_check (d, n, BT_REAL) == FAILURE)
return FAILURE; return FAILURE;
if (d->ts.kind != gfc_default_double_kind ()) if (d->ts.kind != gfc_default_double_kind)
{ {
must_be (d, n, "double precision"); must_be (d, n, "double precision");
return FAILURE; return FAILURE;
...@@ -774,7 +774,7 @@ gfc_check_ibclr (gfc_expr * i, gfc_expr * pos) ...@@ -774,7 +774,7 @@ gfc_check_ibclr (gfc_expr * i, gfc_expr * pos)
if (type_check (i, 0, BT_INTEGER) == FAILURE if (type_check (i, 0, BT_INTEGER) == FAILURE
|| type_check (pos, 1, BT_INTEGER) == FAILURE || type_check (pos, 1, BT_INTEGER) == FAILURE
|| kind_value_check (pos, 1, gfc_default_integer_kind ()) == FAILURE) || kind_value_check (pos, 1, gfc_default_integer_kind) == FAILURE)
return FAILURE; return FAILURE;
return SUCCESS; return SUCCESS;
...@@ -787,7 +787,7 @@ gfc_check_ibits (gfc_expr * i, gfc_expr * pos, gfc_expr * len) ...@@ -787,7 +787,7 @@ gfc_check_ibits (gfc_expr * i, gfc_expr * pos, gfc_expr * len)
if (type_check (i, 0, BT_INTEGER) == FAILURE if (type_check (i, 0, BT_INTEGER) == FAILURE
|| type_check (pos, 1, BT_INTEGER) == FAILURE || type_check (pos, 1, BT_INTEGER) == FAILURE
|| kind_value_check (pos, 1, gfc_default_integer_kind ()) == FAILURE || kind_value_check (pos, 1, gfc_default_integer_kind) == FAILURE
|| type_check (len, 2, BT_INTEGER) == FAILURE) || type_check (len, 2, BT_INTEGER) == FAILURE)
return FAILURE; return FAILURE;
...@@ -801,7 +801,7 @@ gfc_check_ibset (gfc_expr * i, gfc_expr * pos) ...@@ -801,7 +801,7 @@ gfc_check_ibset (gfc_expr * i, gfc_expr * pos)
if (type_check (i, 0, BT_INTEGER) == FAILURE if (type_check (i, 0, BT_INTEGER) == FAILURE
|| type_check (pos, 1, BT_INTEGER) == FAILURE || type_check (pos, 1, BT_INTEGER) == FAILURE
|| kind_value_check (pos, 1, gfc_default_integer_kind ()) == FAILURE) || kind_value_check (pos, 1, gfc_default_integer_kind) == FAILURE)
return FAILURE; return FAILURE;
return SUCCESS; return SUCCESS;
...@@ -1036,7 +1036,7 @@ try ...@@ -1036,7 +1036,7 @@ try
gfc_check_min_max_integer (gfc_actual_arglist * arg) gfc_check_min_max_integer (gfc_actual_arglist * arg)
{ {
return check_rest (BT_INTEGER, gfc_default_integer_kind (), arg); return check_rest (BT_INTEGER, gfc_default_integer_kind, arg);
} }
...@@ -1044,7 +1044,7 @@ try ...@@ -1044,7 +1044,7 @@ try
gfc_check_min_max_real (gfc_actual_arglist * arg) gfc_check_min_max_real (gfc_actual_arglist * arg)
{ {
return check_rest (BT_REAL, gfc_default_real_kind (), arg); return check_rest (BT_REAL, gfc_default_real_kind, arg);
} }
...@@ -1052,7 +1052,7 @@ try ...@@ -1052,7 +1052,7 @@ try
gfc_check_min_max_double (gfc_actual_arglist * arg) gfc_check_min_max_double (gfc_actual_arglist * arg)
{ {
return check_rest (BT_REAL, gfc_default_double_kind (), arg); return check_rest (BT_REAL, gfc_default_double_kind, arg);
} }
/* End of min/max family. */ /* End of min/max family. */
...@@ -1545,7 +1545,7 @@ gfc_check_size (gfc_expr * array, gfc_expr * dim) ...@@ -1545,7 +1545,7 @@ gfc_check_size (gfc_expr * array, gfc_expr * dim)
if (type_check (dim, 1, BT_INTEGER) == FAILURE) if (type_check (dim, 1, BT_INTEGER) == FAILURE)
return FAILURE; return FAILURE;
if (kind_value_check (dim, 1, gfc_default_integer_kind ()) == FAILURE) if (kind_value_check (dim, 1, gfc_default_integer_kind) == FAILURE)
return FAILURE; return FAILURE;
if (dim_rank_check (dim, array, 0) == FAILURE) if (dim_rank_check (dim, array, 0) == FAILURE)
...@@ -1834,7 +1834,7 @@ gfc_check_random_seed (gfc_expr * size, gfc_expr * put, gfc_expr * get) ...@@ -1834,7 +1834,7 @@ gfc_check_random_seed (gfc_expr * size, gfc_expr * put, gfc_expr * get)
if (variable_check (size, 0) == FAILURE) if (variable_check (size, 0) == FAILURE)
return FAILURE; return FAILURE;
if (kind_value_check (size, 0, gfc_default_integer_kind ()) == FAILURE) if (kind_value_check (size, 0, gfc_default_integer_kind) == FAILURE)
return FAILURE; return FAILURE;
} }
...@@ -1854,7 +1854,7 @@ gfc_check_random_seed (gfc_expr * size, gfc_expr * put, gfc_expr * get) ...@@ -1854,7 +1854,7 @@ gfc_check_random_seed (gfc_expr * size, gfc_expr * put, gfc_expr * get)
if (type_check (put, 1, BT_INTEGER) == FAILURE) if (type_check (put, 1, BT_INTEGER) == FAILURE)
return FAILURE; return FAILURE;
if (kind_value_check (put, 1, gfc_default_integer_kind ()) == FAILURE) if (kind_value_check (put, 1, gfc_default_integer_kind) == FAILURE)
return FAILURE; return FAILURE;
} }
...@@ -1877,7 +1877,7 @@ gfc_check_random_seed (gfc_expr * size, gfc_expr * put, gfc_expr * get) ...@@ -1877,7 +1877,7 @@ gfc_check_random_seed (gfc_expr * size, gfc_expr * put, gfc_expr * get)
if (variable_check (get, 2) == FAILURE) if (variable_check (get, 2) == FAILURE)
return FAILURE; return FAILURE;
if (kind_value_check (get, 2, gfc_default_integer_kind ()) == FAILURE) if (kind_value_check (get, 2, gfc_default_integer_kind) == FAILURE)
return FAILURE; return FAILURE;
} }
......
...@@ -727,7 +727,7 @@ match_char_spec (gfc_typespec * ts) ...@@ -727,7 +727,7 @@ match_char_spec (gfc_typespec * ts)
gfc_expr *len; gfc_expr *len;
match m; match m;
kind = gfc_default_character_kind (); kind = gfc_default_character_kind;
len = NULL; len = NULL;
seen_length = 0; seen_length = 0;
...@@ -891,7 +891,7 @@ match_type_spec (gfc_typespec * ts, int implicit_flag) ...@@ -891,7 +891,7 @@ match_type_spec (gfc_typespec * ts, int implicit_flag)
if (gfc_match (" integer") == MATCH_YES) if (gfc_match (" integer") == MATCH_YES)
{ {
ts->type = BT_INTEGER; ts->type = BT_INTEGER;
ts->kind = gfc_default_integer_kind (); ts->kind = gfc_default_integer_kind;
goto get_kind; goto get_kind;
} }
...@@ -907,35 +907,35 @@ match_type_spec (gfc_typespec * ts, int implicit_flag) ...@@ -907,35 +907,35 @@ match_type_spec (gfc_typespec * ts, int implicit_flag)
if (gfc_match (" real") == MATCH_YES) if (gfc_match (" real") == MATCH_YES)
{ {
ts->type = BT_REAL; ts->type = BT_REAL;
ts->kind = gfc_default_real_kind (); ts->kind = gfc_default_real_kind;
goto get_kind; goto get_kind;
} }
if (gfc_match (" double precision") == MATCH_YES) if (gfc_match (" double precision") == MATCH_YES)
{ {
ts->type = BT_REAL; ts->type = BT_REAL;
ts->kind = gfc_default_double_kind (); ts->kind = gfc_default_double_kind;
return MATCH_YES; return MATCH_YES;
} }
if (gfc_match (" complex") == MATCH_YES) if (gfc_match (" complex") == MATCH_YES)
{ {
ts->type = BT_COMPLEX; ts->type = BT_COMPLEX;
ts->kind = gfc_default_complex_kind (); ts->kind = gfc_default_complex_kind;
goto get_kind; goto get_kind;
} }
if (gfc_match (" double complex") == MATCH_YES) if (gfc_match (" double complex") == MATCH_YES)
{ {
ts->type = BT_COMPLEX; ts->type = BT_COMPLEX;
ts->kind = gfc_default_double_kind (); ts->kind = gfc_default_double_kind;
return MATCH_YES; return MATCH_YES;
} }
if (gfc_match (" logical") == MATCH_YES) if (gfc_match (" logical") == MATCH_YES)
{ {
ts->type = BT_LOGICAL; ts->type = BT_LOGICAL;
ts->kind = gfc_default_logical_kind (); ts->kind = gfc_default_logical_kind;
goto get_kind; goto get_kind;
} }
...@@ -1141,7 +1141,7 @@ gfc_match_implicit (void) ...@@ -1141,7 +1141,7 @@ gfc_match_implicit (void)
/* Check for CHARACTER with no length parameter. */ /* Check for CHARACTER with no length parameter. */
if (ts.type == BT_CHARACTER && !ts.cl) if (ts.type == BT_CHARACTER && !ts.cl)
{ {
ts.kind = gfc_default_character_kind (); ts.kind = gfc_default_character_kind;
ts.cl = gfc_get_charlen (); ts.cl = gfc_get_charlen ();
ts.cl->next = gfc_current_ns->cl_list; ts.cl->next = gfc_current_ns->cl_list;
gfc_current_ns->cl_list = ts.cl; gfc_current_ns->cl_list = ts.cl;
......
...@@ -351,7 +351,7 @@ gfc_show_expr (gfc_expr * p) ...@@ -351,7 +351,7 @@ gfc_show_expr (gfc_expr * p)
case BT_INTEGER: case BT_INTEGER:
mpz_out_str (stdout, 10, p->value.integer); mpz_out_str (stdout, 10, p->value.integer);
if (p->ts.kind != gfc_default_integer_kind ()) if (p->ts.kind != gfc_default_integer_kind)
gfc_status ("_%d", p->ts.kind); gfc_status ("_%d", p->ts.kind);
break; break;
...@@ -364,7 +364,7 @@ gfc_show_expr (gfc_expr * p) ...@@ -364,7 +364,7 @@ gfc_show_expr (gfc_expr * p)
case BT_REAL: case BT_REAL:
mpfr_out_str (stdout, 10, 0, p->value.real, GFC_RND_MODE); mpfr_out_str (stdout, 10, 0, p->value.real, GFC_RND_MODE);
if (p->ts.kind != gfc_default_real_kind ()) if (p->ts.kind != gfc_default_real_kind)
gfc_status ("_%d", p->ts.kind); gfc_status ("_%d", p->ts.kind);
break; break;
...@@ -389,13 +389,13 @@ gfc_show_expr (gfc_expr * p) ...@@ -389,13 +389,13 @@ gfc_show_expr (gfc_expr * p)
gfc_status ("(complex "); gfc_status ("(complex ");
mpfr_out_str (stdout, 10, 0, p->value.complex.r, GFC_RND_MODE); mpfr_out_str (stdout, 10, 0, p->value.complex.r, GFC_RND_MODE);
if (p->ts.kind != gfc_default_complex_kind ()) if (p->ts.kind != gfc_default_complex_kind)
gfc_status ("_%d", p->ts.kind); gfc_status ("_%d", p->ts.kind);
gfc_status (" "); gfc_status (" ");
mpfr_out_str (stdout, 10, 0, p->value.complex.i, GFC_RND_MODE); mpfr_out_str (stdout, 10, 0, p->value.complex.i, GFC_RND_MODE);
if (p->ts.kind != gfc_default_complex_kind ()) if (p->ts.kind != gfc_default_complex_kind)
gfc_status ("_%d", p->ts.kind); gfc_status ("_%d", p->ts.kind);
gfc_status (")"); gfc_status (")");
......
...@@ -524,7 +524,7 @@ gfc_int_expr (int i) ...@@ -524,7 +524,7 @@ gfc_int_expr (int i)
p->expr_type = EXPR_CONSTANT; p->expr_type = EXPR_CONSTANT;
p->ts.type = BT_INTEGER; p->ts.type = BT_INTEGER;
p->ts.kind = gfc_default_integer_kind (); p->ts.kind = gfc_default_integer_kind;
p->where = gfc_current_locus; p->where = gfc_current_locus;
mpz_init_set_si (p->value.integer, i); mpz_init_set_si (p->value.integer, i);
...@@ -544,7 +544,7 @@ gfc_logical_expr (int i, locus * where) ...@@ -544,7 +544,7 @@ gfc_logical_expr (int i, locus * where)
p->expr_type = EXPR_CONSTANT; p->expr_type = EXPR_CONSTANT;
p->ts.type = BT_LOGICAL; p->ts.type = BT_LOGICAL;
p->ts.kind = gfc_default_logical_kind (); p->ts.kind = gfc_default_logical_kind;
if (where == NULL) if (where == NULL)
where = &gfc_current_locus; where = &gfc_current_locus;
......
...@@ -1505,15 +1505,14 @@ void gfc_arith_init_1 (void); ...@@ -1505,15 +1505,14 @@ void gfc_arith_init_1 (void);
void gfc_arith_done_1 (void); void gfc_arith_done_1 (void);
/* trans-types.c */ /* trans-types.c */
/* FIXME: These should go to symbol.c, really... */
int gfc_default_integer_kind (void);
int gfc_default_real_kind (void);
int gfc_default_double_kind (void);
int gfc_default_character_kind (void);
int gfc_default_logical_kind (void);
int gfc_default_complex_kind (void);
int gfc_validate_kind (bt, int, bool); int gfc_validate_kind (bt, int, bool);
extern int gfc_index_integer_kind; extern int gfc_index_integer_kind;
extern int gfc_default_integer_kind;
extern int gfc_default_real_kind;
extern int gfc_default_double_kind;
extern int gfc_default_character_kind;
extern int gfc_default_logical_kind;
extern int gfc_default_complex_kind;
/* symbol.c */ /* symbol.c */
void gfc_clear_new_implicit (void); void gfc_clear_new_implicit (void);
......
...@@ -849,12 +849,12 @@ add_functions (void) ...@@ -849,12 +849,12 @@ add_functions (void)
int di, dr, dd, dl, dc, dz, ii; int di, dr, dd, dl, dc, dz, ii;
di = gfc_default_integer_kind (); di = gfc_default_integer_kind;
dr = gfc_default_real_kind (); dr = gfc_default_real_kind;
dd = gfc_default_double_kind (); dd = gfc_default_double_kind;
dl = gfc_default_logical_kind (); dl = gfc_default_logical_kind;
dc = gfc_default_character_kind (); dc = gfc_default_character_kind;
dz = gfc_default_complex_kind (); dz = gfc_default_complex_kind;
ii = gfc_index_integer_kind; ii = gfc_index_integer_kind;
add_sym_1 ("abs", 1, 1, BT_REAL, dr, add_sym_1 ("abs", 1, 1, BT_REAL, dr,
...@@ -1806,10 +1806,10 @@ add_subroutines (void) ...@@ -1806,10 +1806,10 @@ add_subroutines (void)
int di, dr, dc, dl; int di, dr, dc, dl;
di = gfc_default_integer_kind (); di = gfc_default_integer_kind;
dr = gfc_default_real_kind (); dr = gfc_default_real_kind;
dc = gfc_default_character_kind (); dc = gfc_default_character_kind;
dl = gfc_default_logical_kind (); dl = gfc_default_logical_kind;
add_sym_0s ("abort", 1, NULL); add_sym_0s ("abort", 1, NULL);
......
...@@ -842,7 +842,7 @@ gfc_match_format (void) ...@@ -842,7 +842,7 @@ gfc_match_format (void)
e = gfc_get_expr(); e = gfc_get_expr();
e->expr_type = EXPR_CONSTANT; e->expr_type = EXPR_CONSTANT;
e->ts.type = BT_CHARACTER; e->ts.type = BT_CHARACTER;
e->ts.kind = gfc_default_character_kind(); e->ts.kind = gfc_default_character_kind;
e->where = start; e->where = start;
e->value.character.string = format_string = gfc_getmem(format_length+1); e->value.character.string = format_string = gfc_getmem(format_length+1);
e->value.character.length = format_length; e->value.character.length = format_length;
......
...@@ -274,7 +274,7 @@ gfc_resolve_btest (gfc_expr * f, gfc_expr * i, gfc_expr * pos) ...@@ -274,7 +274,7 @@ gfc_resolve_btest (gfc_expr * f, gfc_expr * i, gfc_expr * pos)
{ {
f->ts.type = BT_LOGICAL; f->ts.type = BT_LOGICAL;
f->ts.kind = gfc_default_logical_kind (); f->ts.kind = gfc_default_logical_kind;
f->value.function.name = gfc_get_string ("__btest_%d_%d", i->ts.kind, f->value.function.name = gfc_get_string ("__btest_%d_%d", i->ts.kind,
pos->ts.kind); pos->ts.kind);
...@@ -286,7 +286,7 @@ gfc_resolve_ceiling (gfc_expr * f, gfc_expr * a, gfc_expr * kind) ...@@ -286,7 +286,7 @@ gfc_resolve_ceiling (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
{ {
f->ts.type = BT_INTEGER; f->ts.type = BT_INTEGER;
f->ts.kind = (kind == NULL) ? gfc_default_integer_kind () f->ts.kind = (kind == NULL) ? gfc_default_integer_kind
: mpz_get_si (kind->value.integer); : mpz_get_si (kind->value.integer);
f->value.function.name = f->value.function.name =
...@@ -300,7 +300,7 @@ gfc_resolve_char (gfc_expr * f, gfc_expr * a, gfc_expr * kind) ...@@ -300,7 +300,7 @@ gfc_resolve_char (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
{ {
f->ts.type = BT_CHARACTER; f->ts.type = BT_CHARACTER;
f->ts.kind = (kind == NULL) ? gfc_default_character_kind () f->ts.kind = (kind == NULL) ? gfc_default_character_kind
: mpz_get_si (kind->value.integer); : mpz_get_si (kind->value.integer);
f->value.function.name = f->value.function.name =
...@@ -314,7 +314,7 @@ gfc_resolve_cmplx (gfc_expr * f, gfc_expr * x, gfc_expr * y, gfc_expr * kind) ...@@ -314,7 +314,7 @@ gfc_resolve_cmplx (gfc_expr * f, gfc_expr * x, gfc_expr * y, gfc_expr * kind)
{ {
f->ts.type = BT_COMPLEX; f->ts.type = BT_COMPLEX;
f->ts.kind = (kind == NULL) ? gfc_default_real_kind () f->ts.kind = (kind == NULL) ? gfc_default_real_kind
: mpz_get_si (kind->value.integer); : mpz_get_si (kind->value.integer);
if (y == NULL) if (y == NULL)
...@@ -331,7 +331,7 @@ gfc_resolve_cmplx (gfc_expr * f, gfc_expr * x, gfc_expr * y, gfc_expr * kind) ...@@ -331,7 +331,7 @@ gfc_resolve_cmplx (gfc_expr * f, gfc_expr * x, gfc_expr * y, gfc_expr * kind)
void void
gfc_resolve_dcmplx (gfc_expr * f, gfc_expr * x, gfc_expr * y) 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_int_expr (gfc_default_double_kind));
} }
void void
...@@ -368,7 +368,7 @@ gfc_resolve_count (gfc_expr * f, gfc_expr * mask, gfc_expr * dim) ...@@ -368,7 +368,7 @@ gfc_resolve_count (gfc_expr * f, gfc_expr * mask, gfc_expr * dim)
{ {
f->ts.type = BT_INTEGER; f->ts.type = BT_INTEGER;
f->ts.kind = gfc_default_integer_kind (); f->ts.kind = gfc_default_integer_kind;
if (dim != NULL) if (dim != NULL)
{ {
...@@ -416,7 +416,7 @@ gfc_resolve_dble (gfc_expr * f, gfc_expr * a) ...@@ -416,7 +416,7 @@ gfc_resolve_dble (gfc_expr * f, gfc_expr * a)
{ {
f->ts.type = BT_REAL; f->ts.type = BT_REAL;
f->ts.kind = gfc_default_double_kind (); f->ts.kind = gfc_default_double_kind;
f->value.function.name = f->value.function.name =
gfc_get_string ("__dble_%c%d", gfc_type_letter (a->ts.type), a->ts.kind); gfc_get_string ("__dble_%c%d", gfc_type_letter (a->ts.type), a->ts.kind);
} }
...@@ -441,7 +441,7 @@ gfc_resolve_dot_product (gfc_expr * f, gfc_expr * a, gfc_expr * b) ...@@ -441,7 +441,7 @@ gfc_resolve_dot_product (gfc_expr * f, gfc_expr * a, gfc_expr * b)
if (a->ts.type == BT_LOGICAL && b->ts.type == BT_LOGICAL) if (a->ts.type == BT_LOGICAL && b->ts.type == BT_LOGICAL)
{ {
f->ts.type = BT_LOGICAL; f->ts.type = BT_LOGICAL;
f->ts.kind = gfc_default_logical_kind (); f->ts.kind = gfc_default_logical_kind;
} }
else else
{ {
...@@ -465,7 +465,7 @@ gfc_resolve_dprod (gfc_expr * f, ...@@ -465,7 +465,7 @@ gfc_resolve_dprod (gfc_expr * f,
gfc_expr * a ATTRIBUTE_UNUSED, gfc_expr * a ATTRIBUTE_UNUSED,
gfc_expr * b ATTRIBUTE_UNUSED) gfc_expr * b ATTRIBUTE_UNUSED)
{ {
f->ts.kind = gfc_default_double_kind (); f->ts.kind = gfc_default_double_kind;
f->ts.type = BT_REAL; f->ts.type = BT_REAL;
f->value.function.name = gfc_get_string ("__dprod_r%d", f->ts.kind); f->value.function.name = gfc_get_string ("__dprod_r%d", f->ts.kind);
...@@ -515,7 +515,7 @@ gfc_resolve_exponent (gfc_expr * f, gfc_expr * x) ...@@ -515,7 +515,7 @@ gfc_resolve_exponent (gfc_expr * f, gfc_expr * x)
{ {
f->ts.type = BT_INTEGER; f->ts.type = BT_INTEGER;
f->ts.kind = gfc_default_integer_kind (); f->ts.kind = gfc_default_integer_kind;
f->value.function.name = gfc_get_string ("__exponent_%d", x->ts.kind); f->value.function.name = gfc_get_string ("__exponent_%d", x->ts.kind);
} }
...@@ -526,7 +526,7 @@ gfc_resolve_floor (gfc_expr * f, gfc_expr * a, gfc_expr * kind) ...@@ -526,7 +526,7 @@ gfc_resolve_floor (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
{ {
f->ts.type = BT_INTEGER; f->ts.type = BT_INTEGER;
f->ts.kind = (kind == NULL) ? gfc_default_integer_kind () f->ts.kind = (kind == NULL) ? gfc_default_integer_kind
: mpz_get_si (kind->value.integer); : mpz_get_si (kind->value.integer);
f->value.function.name = f->value.function.name =
...@@ -588,7 +588,7 @@ gfc_resolve_ichar (gfc_expr * f, gfc_expr * c) ...@@ -588,7 +588,7 @@ gfc_resolve_ichar (gfc_expr * f, gfc_expr * c)
{ {
f->ts.type = BT_INTEGER; f->ts.type = BT_INTEGER;
f->ts.kind = gfc_default_integer_kind (); f->ts.kind = gfc_default_integer_kind;
f->value.function.name = gfc_get_string ("__ichar_%d", c->ts.kind); f->value.function.name = gfc_get_string ("__ichar_%d", c->ts.kind);
} }
...@@ -626,7 +626,7 @@ gfc_resolve_int (gfc_expr * f, gfc_expr * a, gfc_expr * kind) ...@@ -626,7 +626,7 @@ gfc_resolve_int (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
{ {
f->ts.type = BT_INTEGER; f->ts.type = BT_INTEGER;
f->ts.kind = (kind == NULL) ? gfc_default_integer_kind () f->ts.kind = (kind == NULL) ? gfc_default_integer_kind
: mpz_get_si (kind->value.integer); : mpz_get_si (kind->value.integer);
f->value.function.name = f->value.function.name =
...@@ -651,7 +651,7 @@ gfc_resolve_ishftc (gfc_expr * f, gfc_expr * i, gfc_expr * shift, ...@@ -651,7 +651,7 @@ gfc_resolve_ishftc (gfc_expr * f, gfc_expr * i, gfc_expr * shift,
{ {
int s_kind; int s_kind;
s_kind = (size == NULL) ? gfc_default_integer_kind () : shift->ts.kind; s_kind = (size == NULL) ? gfc_default_integer_kind : shift->ts.kind;
f->ts = i->ts; f->ts = i->ts;
f->value.function.name = f->value.function.name =
...@@ -666,7 +666,7 @@ gfc_resolve_lbound (gfc_expr * f, gfc_expr * array, ...@@ -666,7 +666,7 @@ gfc_resolve_lbound (gfc_expr * f, gfc_expr * array,
static char lbound[] = "__lbound"; static char lbound[] = "__lbound";
f->ts.type = BT_INTEGER; f->ts.type = BT_INTEGER;
f->ts.kind = gfc_default_integer_kind (); f->ts.kind = gfc_default_integer_kind;
if (dim == NULL) if (dim == NULL)
{ {
...@@ -684,7 +684,7 @@ gfc_resolve_len (gfc_expr * f, gfc_expr * string) ...@@ -684,7 +684,7 @@ gfc_resolve_len (gfc_expr * f, gfc_expr * string)
{ {
f->ts.type = BT_INTEGER; f->ts.type = BT_INTEGER;
f->ts.kind = gfc_default_integer_kind (); f->ts.kind = gfc_default_integer_kind;
f->value.function.name = gfc_get_string ("__len_%d", string->ts.kind); f->value.function.name = gfc_get_string ("__len_%d", string->ts.kind);
} }
...@@ -694,7 +694,7 @@ gfc_resolve_len_trim (gfc_expr * f, gfc_expr * string) ...@@ -694,7 +694,7 @@ gfc_resolve_len_trim (gfc_expr * f, gfc_expr * string)
{ {
f->ts.type = BT_INTEGER; f->ts.type = BT_INTEGER;
f->ts.kind = gfc_default_integer_kind (); f->ts.kind = gfc_default_integer_kind;
f->value.function.name = gfc_get_string ("__len_trim%d", string->ts.kind); f->value.function.name = gfc_get_string ("__len_trim%d", string->ts.kind);
} }
...@@ -724,7 +724,7 @@ gfc_resolve_logical (gfc_expr * f, gfc_expr * a, gfc_expr * kind) ...@@ -724,7 +724,7 @@ gfc_resolve_logical (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
{ {
f->ts.type = BT_LOGICAL; f->ts.type = BT_LOGICAL;
f->ts.kind = (kind == NULL) ? gfc_default_logical_kind () f->ts.kind = (kind == NULL) ? gfc_default_logical_kind
: mpz_get_si (kind->value.integer); : mpz_get_si (kind->value.integer);
f->rank = a->rank; f->rank = a->rank;
...@@ -742,7 +742,7 @@ gfc_resolve_matmul (gfc_expr * f, gfc_expr * a, gfc_expr * b) ...@@ -742,7 +742,7 @@ gfc_resolve_matmul (gfc_expr * f, gfc_expr * a, gfc_expr * b)
if (a->ts.type == BT_LOGICAL && b->ts.type == BT_LOGICAL) if (a->ts.type == BT_LOGICAL && b->ts.type == BT_LOGICAL)
{ {
f->ts.type = BT_LOGICAL; f->ts.type = BT_LOGICAL;
f->ts.kind = gfc_default_logical_kind (); f->ts.kind = gfc_default_logical_kind;
} }
else else
{ {
...@@ -803,7 +803,7 @@ gfc_resolve_maxloc (gfc_expr * f, gfc_expr * array, gfc_expr * dim, ...@@ -803,7 +803,7 @@ gfc_resolve_maxloc (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
const char *name; const char *name;
f->ts.type = BT_INTEGER; f->ts.type = BT_INTEGER;
f->ts.kind = gfc_default_integer_kind (); f->ts.kind = gfc_default_integer_kind;
if (dim == NULL) if (dim == NULL)
f->rank = 1; f->rank = 1;
...@@ -866,7 +866,7 @@ gfc_resolve_minloc (gfc_expr * f, gfc_expr * array, gfc_expr * dim, ...@@ -866,7 +866,7 @@ gfc_resolve_minloc (gfc_expr * f, gfc_expr * array, gfc_expr * dim,
const char *name; const char *name;
f->ts.type = BT_INTEGER; f->ts.type = BT_INTEGER;
f->ts.kind = gfc_default_integer_kind (); f->ts.kind = gfc_default_integer_kind;
if (dim == NULL) if (dim == NULL)
f->rank = 1; f->rank = 1;
...@@ -940,7 +940,7 @@ gfc_resolve_nint (gfc_expr * f, gfc_expr * a, gfc_expr * kind) ...@@ -940,7 +940,7 @@ gfc_resolve_nint (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
{ {
f->ts.type = BT_INTEGER; f->ts.type = BT_INTEGER;
f->ts.kind = (kind == NULL) ? gfc_default_integer_kind () f->ts.kind = (kind == NULL) ? gfc_default_integer_kind
: mpz_get_si (kind->value.integer); : mpz_get_si (kind->value.integer);
f->value.function.name = f->value.function.name =
...@@ -1001,7 +1001,7 @@ gfc_resolve_real (gfc_expr * f, gfc_expr * a, gfc_expr * kind) ...@@ -1001,7 +1001,7 @@ gfc_resolve_real (gfc_expr * f, gfc_expr * a, gfc_expr * kind)
f->ts.kind = mpz_get_si (kind->value.integer); f->ts.kind = mpz_get_si (kind->value.integer);
else else
f->ts.kind = (a->ts.type == BT_COMPLEX) ? f->ts.kind = (a->ts.type == BT_COMPLEX) ?
a->ts.kind : gfc_default_real_kind (); a->ts.kind : gfc_default_real_kind;
f->value.function.name = f->value.function.name =
gfc_get_string ("__real_%d_%c%d", f->ts.kind, gfc_get_string ("__real_%d_%c%d", f->ts.kind,
...@@ -1110,7 +1110,7 @@ gfc_resolve_scan (gfc_expr * f, gfc_expr * string, ...@@ -1110,7 +1110,7 @@ gfc_resolve_scan (gfc_expr * f, gfc_expr * string,
{ {
f->ts.type = BT_INTEGER; f->ts.type = BT_INTEGER;
f->ts.kind = gfc_default_integer_kind (); f->ts.kind = gfc_default_integer_kind;
f->value.function.name = gfc_get_string ("__scan_%d", string->ts.kind); f->value.function.name = gfc_get_string ("__scan_%d", string->ts.kind);
} }
...@@ -1130,7 +1130,7 @@ gfc_resolve_shape (gfc_expr * f, gfc_expr * array) ...@@ -1130,7 +1130,7 @@ gfc_resolve_shape (gfc_expr * f, gfc_expr * array)
{ {
f->ts.type = BT_INTEGER; f->ts.type = BT_INTEGER;
f->ts.kind = gfc_default_integer_kind (); f->ts.kind = gfc_default_integer_kind;
f->rank = 1; f->rank = 1;
f->value.function.name = gfc_get_string ("__shape_%d", f->ts.kind); f->value.function.name = gfc_get_string ("__shape_%d", f->ts.kind);
f->shape = gfc_get_shape (1); f->shape = gfc_get_shape (1);
...@@ -1329,7 +1329,7 @@ gfc_resolve_ubound (gfc_expr * f, gfc_expr * array, ...@@ -1329,7 +1329,7 @@ gfc_resolve_ubound (gfc_expr * f, gfc_expr * array,
static char ubound[] = "__ubound"; static char ubound[] = "__ubound";
f->ts.type = BT_INTEGER; f->ts.type = BT_INTEGER;
f->ts.kind = gfc_default_integer_kind (); f->ts.kind = gfc_default_integer_kind;
if (dim == NULL) if (dim == NULL)
{ {
...@@ -1363,7 +1363,7 @@ gfc_resolve_verify (gfc_expr * f, gfc_expr * string, ...@@ -1363,7 +1363,7 @@ gfc_resolve_verify (gfc_expr * f, gfc_expr * string,
{ {
f->ts.type = BT_INTEGER; f->ts.type = BT_INTEGER;
f->ts.kind = gfc_default_integer_kind (); f->ts.kind = gfc_default_integer_kind;
f->value.function.name = gfc_get_string ("__verify_%d", string->ts.kind); f->value.function.name = gfc_get_string ("__verify_%d", string->ts.kind);
} }
...@@ -1441,7 +1441,7 @@ gfc_resolve_getarg (gfc_code * c) ...@@ -1441,7 +1441,7 @@ gfc_resolve_getarg (gfc_code * c)
const char *name; const char *name;
int kind; int kind;
kind = gfc_default_integer_kind (); kind = gfc_default_integer_kind;
name = gfc_get_string (PREFIX("getarg_i%d"), kind); name = gfc_get_string (PREFIX("getarg_i%d"), kind);
c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
} }
...@@ -1455,7 +1455,7 @@ gfc_resolve_get_command (gfc_code * c) ...@@ -1455,7 +1455,7 @@ gfc_resolve_get_command (gfc_code * c)
const char *name; const char *name;
int kind; int kind;
kind = gfc_default_integer_kind (); kind = gfc_default_integer_kind;
name = gfc_get_string (PREFIX("get_command_i%d"), kind); name = gfc_get_string (PREFIX("get_command_i%d"), kind);
c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
} }
...@@ -1469,7 +1469,7 @@ gfc_resolve_get_command_argument (gfc_code * c) ...@@ -1469,7 +1469,7 @@ gfc_resolve_get_command_argument (gfc_code * c)
const char *name; const char *name;
int kind; int kind;
kind = gfc_default_integer_kind (); kind = gfc_default_integer_kind;
name = gfc_get_string (PREFIX("get_command_argument_i%d"), kind); name = gfc_get_string (PREFIX("get_command_argument_i%d"), kind);
c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
} }
...@@ -1482,7 +1482,7 @@ gfc_resolve_get_environment_variable (gfc_code * code) ...@@ -1482,7 +1482,7 @@ gfc_resolve_get_environment_variable (gfc_code * code)
const char *name; const char *name;
int kind; int kind;
kind = gfc_default_integer_kind(); kind = gfc_default_integer_kind;
name = gfc_get_string (PREFIX("get_environment_variable_i%d"), kind); name = gfc_get_string (PREFIX("get_environment_variable_i%d"), kind);
code->resolved_sym = gfc_get_intrinsic_sub_symbol (name); code->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
} }
...@@ -1503,7 +1503,7 @@ gfc_resolve_system_clock (gfc_code * c) ...@@ -1503,7 +1503,7 @@ gfc_resolve_system_clock (gfc_code * c)
else if (c->ext.actual->next->next->expr != NULL) else if (c->ext.actual->next->next->expr != NULL)
kind = c->ext.actual->next->next->expr->ts.kind; kind = c->ext.actual->next->next->expr->ts.kind;
else else
kind = gfc_default_integer_kind (); kind = gfc_default_integer_kind;
name = gfc_get_string (PREFIX("system_clock_%d"), kind); name = gfc_get_string (PREFIX("system_clock_%d"), kind);
c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
......
...@@ -2053,7 +2053,7 @@ gfc_match_call (void) ...@@ -2053,7 +2053,7 @@ gfc_match_call (void)
select_sym = select_st->n.sym; select_sym = select_st->n.sym;
select_sym->ts.type = BT_INTEGER; select_sym->ts.type = BT_INTEGER;
select_sym->ts.kind = gfc_default_integer_kind (); select_sym->ts.kind = gfc_default_integer_kind;
gfc_set_sym_referenced (select_sym); gfc_set_sym_referenced (select_sym);
c->expr = gfc_get_expr (); c->expr = gfc_get_expr ();
c->expr->expr_type = EXPR_VARIABLE; c->expr->expr_type = EXPR_VARIABLE;
......
...@@ -70,7 +70,7 @@ gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED, ...@@ -70,7 +70,7 @@ gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED,
gfc_option.flag_pack_derived = 0; gfc_option.flag_pack_derived = 0;
gfc_option.flag_repack_arrays = 0; gfc_option.flag_repack_arrays = 0;
gfc_option.q_kind = gfc_default_double_kind (); gfc_option.q_kind = gfc_default_double_kind;
gfc_option.i8 = 0; gfc_option.i8 = 0;
gfc_option.r8 = 0; gfc_option.r8 = 0;
gfc_option.d8 = 0; gfc_option.d8 = 0;
......
...@@ -204,7 +204,7 @@ match_integer_constant (gfc_expr ** result, int signflag) ...@@ -204,7 +204,7 @@ match_integer_constant (gfc_expr ** result, int signflag)
kind = get_kind (); kind = get_kind ();
if (kind == -2) if (kind == -2)
kind = gfc_default_integer_kind (); kind = gfc_default_integer_kind;
if (kind == -1) if (kind == -1)
return MATCH_ERROR; return MATCH_ERROR;
...@@ -295,7 +295,7 @@ match_boz_constant (gfc_expr ** result) ...@@ -295,7 +295,7 @@ match_boz_constant (gfc_expr ** result)
match_digits (0, radix, buffer); match_digits (0, radix, buffer);
gfc_next_char (); gfc_next_char ();
e = gfc_convert_integer (buffer, gfc_default_integer_kind (), radix, e = gfc_convert_integer (buffer, gfc_default_integer_kind, radix,
&gfc_current_locus); &gfc_current_locus);
if (gfc_range_check (e) != ARITH_OK) if (gfc_range_check (e) != ARITH_OK)
...@@ -460,7 +460,7 @@ done: ...@@ -460,7 +460,7 @@ done:
("Real number at %C has a 'd' exponent and an explicit kind"); ("Real number at %C has a 'd' exponent and an explicit kind");
goto cleanup; goto cleanup;
} }
kind = gfc_default_double_kind (); kind = gfc_default_double_kind;
break; break;
case 'q': case 'q':
...@@ -475,7 +475,7 @@ done: ...@@ -475,7 +475,7 @@ done:
default: default:
if (kind == -2) if (kind == -2)
kind = gfc_default_real_kind (); kind = gfc_default_real_kind;
if (gfc_validate_kind (BT_REAL, kind, true) < 0) if (gfc_validate_kind (BT_REAL, kind, true) < 0)
{ {
...@@ -758,7 +758,7 @@ match_string_constant (gfc_expr ** result) ...@@ -758,7 +758,7 @@ match_string_constant (gfc_expr ** result)
c = gfc_next_char (); c = gfc_next_char ();
if (c == '\'' || c == '"') if (c == '\'' || c == '"')
{ {
kind = gfc_default_character_kind (); kind = gfc_default_character_kind;
goto got_delim; goto got_delim;
} }
...@@ -905,7 +905,7 @@ match_logical_constant (gfc_expr ** result) ...@@ -905,7 +905,7 @@ match_logical_constant (gfc_expr ** result)
if (kind == -1) if (kind == -1)
return MATCH_ERROR; return MATCH_ERROR;
if (kind == -2) if (kind == -2)
kind = gfc_default_logical_kind (); kind = gfc_default_logical_kind;
if (gfc_validate_kind (BT_LOGICAL, kind, true) < 0) if (gfc_validate_kind (BT_LOGICAL, kind, true) < 0)
gfc_error ("Bad kind for logical constant at %C"); gfc_error ("Bad kind for logical constant at %C");
...@@ -972,7 +972,7 @@ match_sym_complex_part (gfc_expr ** result) ...@@ -972,7 +972,7 @@ match_sym_complex_part (gfc_expr ** result)
break; break;
case BT_INTEGER: case BT_INTEGER:
e = gfc_int2real (sym->value, gfc_default_real_kind ()); e = gfc_int2real (sym->value, gfc_default_real_kind);
if (e == NULL) if (e == NULL)
goto error; goto error;
break; break;
...@@ -1098,7 +1098,7 @@ done: ...@@ -1098,7 +1098,7 @@ done:
if (seen_dp == 0 && exp_char == ' ') if (seen_dp == 0 && exp_char == ' ')
{ {
if (kind == -2) if (kind == -2)
kind = gfc_default_integer_kind (); kind = gfc_default_integer_kind;
} }
else else
...@@ -1111,13 +1111,13 @@ done: ...@@ -1111,13 +1111,13 @@ done:
("Real number at %C has a 'd' exponent and an explicit kind"); ("Real number at %C has a 'd' exponent and an explicit kind");
return MATCH_ERROR; return MATCH_ERROR;
} }
kind = gfc_default_double_kind (); kind = gfc_default_double_kind;
} }
else else
{ {
if (kind == -2) if (kind == -2)
kind = gfc_default_real_kind (); kind = gfc_default_real_kind;
} }
if (gfc_validate_kind (BT_REAL, kind, true) < 0) if (gfc_validate_kind (BT_REAL, kind, true) < 0)
......
...@@ -1392,7 +1392,7 @@ resolve_operator (gfc_expr * e) ...@@ -1392,7 +1392,7 @@ resolve_operator (gfc_expr * e)
if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER) if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER)
{ {
e->ts.type = BT_LOGICAL; e->ts.type = BT_LOGICAL;
e->ts.kind = gfc_default_logical_kind (); e->ts.kind = gfc_default_logical_kind;
break; break;
} }
...@@ -1401,7 +1401,7 @@ resolve_operator (gfc_expr * e) ...@@ -1401,7 +1401,7 @@ resolve_operator (gfc_expr * e)
gfc_type_convert_binary (e); gfc_type_convert_binary (e);
e->ts.type = BT_LOGICAL; e->ts.type = BT_LOGICAL;
e->ts.kind = gfc_default_logical_kind (); e->ts.kind = gfc_default_logical_kind;
break; break;
} }
......
...@@ -212,7 +212,7 @@ gfc_simplify_achar (gfc_expr * e) ...@@ -212,7 +212,7 @@ gfc_simplify_achar (gfc_expr * e)
return &gfc_bad_expr; return &gfc_bad_expr;
} }
result = gfc_constant_result (BT_CHARACTER, gfc_default_character_kind (), result = gfc_constant_result (BT_CHARACTER, gfc_default_character_kind,
&e->where); &e->where);
result->value.character.string = gfc_getmem (2); result->value.character.string = gfc_getmem (2);
...@@ -382,7 +382,7 @@ gfc_simplify_dint (gfc_expr * e) ...@@ -382,7 +382,7 @@ gfc_simplify_dint (gfc_expr * e)
mpfr_trunc (rtrunc->value.real, e->value.real); mpfr_trunc (rtrunc->value.real, e->value.real);
result = gfc_real2real (rtrunc, gfc_default_double_kind ()); result = gfc_real2real (rtrunc, gfc_default_double_kind);
gfc_free_expr (rtrunc); gfc_free_expr (rtrunc);
return range_check (result, "DINT"); return range_check (result, "DINT");
...@@ -445,13 +445,13 @@ gfc_simplify_dnint (gfc_expr * e) ...@@ -445,13 +445,13 @@ gfc_simplify_dnint (gfc_expr * e)
return NULL; return NULL;
result = result =
gfc_constant_result (BT_REAL, gfc_default_double_kind (), &e->where); gfc_constant_result (BT_REAL, gfc_default_double_kind, &e->where);
rtrunc = gfc_copy_expr (e); rtrunc = gfc_copy_expr (e);
cmp = mpfr_cmp_ui (e->value.real, 0); cmp = mpfr_cmp_ui (e->value.real, 0);
gfc_set_model_kind (gfc_default_double_kind ()); gfc_set_model_kind (gfc_default_double_kind);
mpfr_init (half); mpfr_init (half);
mpfr_set_str (half, "0.5", 10, GFC_RND_MODE); mpfr_set_str (half, "0.5", 10, GFC_RND_MODE);
...@@ -576,7 +576,7 @@ gfc_simplify_ceiling (gfc_expr * e, gfc_expr * k) ...@@ -576,7 +576,7 @@ gfc_simplify_ceiling (gfc_expr * e, gfc_expr * k)
gfc_expr *ceil, *result; gfc_expr *ceil, *result;
int kind; int kind;
kind = get_kind (BT_REAL, k, "CEILING", gfc_default_real_kind ()); kind = get_kind (BT_REAL, k, "CEILING", gfc_default_real_kind);
if (kind == -1) if (kind == -1)
return &gfc_bad_expr; return &gfc_bad_expr;
...@@ -602,7 +602,7 @@ gfc_simplify_char (gfc_expr * e, gfc_expr * k) ...@@ -602,7 +602,7 @@ gfc_simplify_char (gfc_expr * e, gfc_expr * k)
gfc_expr *result; gfc_expr *result;
int c, kind; int c, kind;
kind = get_kind (BT_CHARACTER, k, "CHAR", gfc_default_character_kind ()); kind = get_kind (BT_CHARACTER, k, "CHAR", gfc_default_character_kind);
if (kind == -1) if (kind == -1)
return &gfc_bad_expr; return &gfc_bad_expr;
...@@ -687,7 +687,7 @@ gfc_simplify_cmplx (gfc_expr * x, gfc_expr * y, gfc_expr * k) ...@@ -687,7 +687,7 @@ gfc_simplify_cmplx (gfc_expr * x, gfc_expr * y, gfc_expr * k)
|| (y != NULL && y->expr_type != EXPR_CONSTANT)) || (y != NULL && y->expr_type != EXPR_CONSTANT))
return NULL; return NULL;
kind = get_kind (BT_REAL, k, "CMPLX", gfc_default_real_kind ()); kind = get_kind (BT_REAL, k, "CMPLX", gfc_default_real_kind);
if (kind == -1) if (kind == -1)
return &gfc_bad_expr; return &gfc_bad_expr;
...@@ -776,7 +776,7 @@ gfc_simplify_dcmplx (gfc_expr * x, gfc_expr * y) ...@@ -776,7 +776,7 @@ gfc_simplify_dcmplx (gfc_expr * x, gfc_expr * y)
|| (y != NULL && y->expr_type != EXPR_CONSTANT)) || (y != NULL && y->expr_type != EXPR_CONSTANT))
return NULL; return NULL;
return simplify_cmplx ("DCMPLX", x, y, gfc_default_double_kind ()); return simplify_cmplx ("DCMPLX", x, y, gfc_default_double_kind);
} }
...@@ -791,15 +791,15 @@ gfc_simplify_dble (gfc_expr * e) ...@@ -791,15 +791,15 @@ gfc_simplify_dble (gfc_expr * e)
switch (e->ts.type) switch (e->ts.type)
{ {
case BT_INTEGER: case BT_INTEGER:
result = gfc_int2real (e, gfc_default_double_kind ()); result = gfc_int2real (e, gfc_default_double_kind);
break; break;
case BT_REAL: case BT_REAL:
result = gfc_real2real (e, gfc_default_double_kind ()); result = gfc_real2real (e, gfc_default_double_kind);
break; break;
case BT_COMPLEX: case BT_COMPLEX:
result = gfc_complex2real (e, gfc_default_double_kind ()); result = gfc_complex2real (e, gfc_default_double_kind);
break; break;
default: default:
...@@ -880,10 +880,10 @@ gfc_simplify_dprod (gfc_expr * x, gfc_expr * y) ...@@ -880,10 +880,10 @@ gfc_simplify_dprod (gfc_expr * x, gfc_expr * y)
return NULL; return NULL;
result = result =
gfc_constant_result (BT_REAL, gfc_default_double_kind (), &x->where); gfc_constant_result (BT_REAL, gfc_default_double_kind, &x->where);
a1 = gfc_real2real (x, gfc_default_double_kind ()); a1 = gfc_real2real (x, gfc_default_double_kind);
a2 = gfc_real2real (y, gfc_default_double_kind ()); a2 = gfc_real2real (y, gfc_default_double_kind);
mpfr_mul (result->value.real, a1->value.real, a2->value.real, GFC_RND_MODE); mpfr_mul (result->value.real, a1->value.real, a2->value.real, GFC_RND_MODE);
...@@ -957,7 +957,7 @@ gfc_simplify_exponent (gfc_expr * x) ...@@ -957,7 +957,7 @@ gfc_simplify_exponent (gfc_expr * x)
if (x->expr_type != EXPR_CONSTANT) if (x->expr_type != EXPR_CONSTANT)
return NULL; return NULL;
result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind (), result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind,
&x->where); &x->where);
gfc_set_model (x->value.real); gfc_set_model (x->value.real);
...@@ -1006,7 +1006,7 @@ gfc_simplify_float (gfc_expr * a) ...@@ -1006,7 +1006,7 @@ gfc_simplify_float (gfc_expr * a)
if (a->expr_type != EXPR_CONSTANT) if (a->expr_type != EXPR_CONSTANT)
return NULL; return NULL;
result = gfc_int2real (a, gfc_default_real_kind ()); result = gfc_int2real (a, gfc_default_real_kind);
return range_check (result, "FLOAT"); return range_check (result, "FLOAT");
} }
...@@ -1018,7 +1018,7 @@ gfc_simplify_floor (gfc_expr * e, gfc_expr * k) ...@@ -1018,7 +1018,7 @@ gfc_simplify_floor (gfc_expr * e, gfc_expr * k)
mpfr_t floor; mpfr_t floor;
int kind; int kind;
kind = get_kind (BT_REAL, k, "FLOOR", gfc_default_real_kind ()); kind = get_kind (BT_REAL, k, "FLOOR", gfc_default_real_kind);
if (kind == -1) if (kind == -1)
gfc_internal_error ("gfc_simplify_floor(): Bad kind"); gfc_internal_error ("gfc_simplify_floor(): Bad kind");
...@@ -1354,7 +1354,7 @@ gfc_simplify_index (gfc_expr * x, gfc_expr * y, gfc_expr * b) ...@@ -1354,7 +1354,7 @@ gfc_simplify_index (gfc_expr * x, gfc_expr * y, gfc_expr * b)
else else
back = 0; back = 0;
result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind (), result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind,
&x->where); &x->where);
len = x->value.character.length; len = x->value.character.length;
...@@ -1488,7 +1488,7 @@ gfc_simplify_int (gfc_expr * e, gfc_expr * k) ...@@ -1488,7 +1488,7 @@ gfc_simplify_int (gfc_expr * e, gfc_expr * k)
gfc_expr *rpart, *rtrunc, *result; gfc_expr *rpart, *rtrunc, *result;
int kind; int kind;
kind = get_kind (BT_REAL, k, "INT", gfc_default_real_kind ()); kind = get_kind (BT_REAL, k, "INT", gfc_default_real_kind);
if (kind == -1) if (kind == -1)
return &gfc_bad_expr; return &gfc_bad_expr;
...@@ -1537,7 +1537,7 @@ gfc_simplify_ifix (gfc_expr * e) ...@@ -1537,7 +1537,7 @@ gfc_simplify_ifix (gfc_expr * e)
if (e->expr_type != EXPR_CONSTANT) if (e->expr_type != EXPR_CONSTANT)
return NULL; return NULL;
result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind (), result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind,
&e->where); &e->where);
rtrunc = gfc_copy_expr (e); rtrunc = gfc_copy_expr (e);
...@@ -1558,7 +1558,7 @@ gfc_simplify_idint (gfc_expr * e) ...@@ -1558,7 +1558,7 @@ gfc_simplify_idint (gfc_expr * e)
if (e->expr_type != EXPR_CONSTANT) if (e->expr_type != EXPR_CONSTANT)
return NULL; return NULL;
result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind (), result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind,
&e->where); &e->where);
rtrunc = gfc_copy_expr (e); rtrunc = gfc_copy_expr (e);
...@@ -1809,7 +1809,7 @@ gfc_simplify_len (gfc_expr * e) ...@@ -1809,7 +1809,7 @@ gfc_simplify_len (gfc_expr * e)
if (e->expr_type != EXPR_CONSTANT) if (e->expr_type != EXPR_CONSTANT)
return NULL; return NULL;
result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind (), result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind,
&e->where); &e->where);
mpz_set_si (result->value.integer, e->value.character.length); mpz_set_si (result->value.integer, e->value.character.length);
...@@ -1826,7 +1826,7 @@ gfc_simplify_len_trim (gfc_expr * e) ...@@ -1826,7 +1826,7 @@ gfc_simplify_len_trim (gfc_expr * e)
if (e->expr_type != EXPR_CONSTANT) if (e->expr_type != EXPR_CONSTANT)
return NULL; return NULL;
result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind (), result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind,
&e->where); &e->where);
len = e->value.character.length; len = e->value.character.length;
...@@ -1998,7 +1998,7 @@ gfc_simplify_logical (gfc_expr * e, gfc_expr * k) ...@@ -1998,7 +1998,7 @@ gfc_simplify_logical (gfc_expr * e, gfc_expr * k)
gfc_expr *result; gfc_expr *result;
int kind; int kind;
kind = get_kind (BT_LOGICAL, k, "LOGICAL", gfc_default_logical_kind ()); kind = get_kind (BT_LOGICAL, k, "LOGICAL", gfc_default_logical_kind);
if (kind < 0) if (kind < 0)
return &gfc_bad_expr; return &gfc_bad_expr;
...@@ -2342,7 +2342,7 @@ simplify_nint (const char *name, gfc_expr * e, gfc_expr * k) ...@@ -2342,7 +2342,7 @@ simplify_nint (const char *name, gfc_expr * e, gfc_expr * k)
int kind, cmp; int kind, cmp;
mpfr_t half; mpfr_t half;
kind = get_kind (BT_INTEGER, k, name, gfc_default_integer_kind ()); kind = get_kind (BT_INTEGER, k, name, gfc_default_integer_kind);
if (kind == -1) if (kind == -1)
return &gfc_bad_expr; return &gfc_bad_expr;
...@@ -2527,7 +2527,7 @@ gfc_simplify_real (gfc_expr * e, gfc_expr * k) ...@@ -2527,7 +2527,7 @@ gfc_simplify_real (gfc_expr * e, gfc_expr * k)
if (e->ts.type == BT_COMPLEX) if (e->ts.type == BT_COMPLEX)
kind = get_kind (BT_REAL, k, "REAL", e->ts.kind); kind = get_kind (BT_REAL, k, "REAL", e->ts.kind);
else else
kind = get_kind (BT_REAL, k, "REAL", gfc_default_real_kind ()); kind = get_kind (BT_REAL, k, "REAL", gfc_default_real_kind);
if (kind == -1) if (kind == -1)
return &gfc_bad_expr; return &gfc_bad_expr;
...@@ -2975,7 +2975,7 @@ gfc_simplify_scan (gfc_expr * e, gfc_expr * c, gfc_expr * b) ...@@ -2975,7 +2975,7 @@ gfc_simplify_scan (gfc_expr * e, gfc_expr * c, gfc_expr * b)
else else
back = 0; back = 0;
result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind (), result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind,
&e->where); &e->where);
len = e->value.character.length; len = e->value.character.length;
...@@ -3173,7 +3173,7 @@ gfc_simplify_shape (gfc_expr * source) ...@@ -3173,7 +3173,7 @@ gfc_simplify_shape (gfc_expr * source)
if (source->rank == 0 || source->expr_type != EXPR_VARIABLE) if (source->rank == 0 || source->expr_type != EXPR_VARIABLE)
return NULL; return NULL;
result = gfc_start_constructor (BT_INTEGER, gfc_default_integer_kind (), result = gfc_start_constructor (BT_INTEGER, gfc_default_integer_kind,
&source->where); &source->where);
ar = gfc_find_array_ref (source); ar = gfc_find_array_ref (source);
...@@ -3182,7 +3182,7 @@ gfc_simplify_shape (gfc_expr * source) ...@@ -3182,7 +3182,7 @@ gfc_simplify_shape (gfc_expr * source)
for (n = 0; n < source->rank; n++) for (n = 0; n < source->rank; n++)
{ {
e = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind (), e = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind,
&source->where); &source->where);
if (t == SUCCESS) if (t == SUCCESS)
...@@ -3236,7 +3236,7 @@ gfc_simplify_size (gfc_expr * array, gfc_expr * dim) ...@@ -3236,7 +3236,7 @@ gfc_simplify_size (gfc_expr * array, gfc_expr * dim)
return NULL; return NULL;
} }
result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind (), result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind,
&array->where); &array->where);
mpz_set (result->value.integer, size); mpz_set (result->value.integer, size);
...@@ -3350,7 +3350,7 @@ gfc_simplify_sngl (gfc_expr * a) ...@@ -3350,7 +3350,7 @@ gfc_simplify_sngl (gfc_expr * a)
if (a->expr_type != EXPR_CONSTANT) if (a->expr_type != EXPR_CONSTANT)
return NULL; return NULL;
result = gfc_real2real (a, gfc_default_real_kind ()); result = gfc_real2real (a, gfc_default_real_kind);
return range_check (result, "SNGL"); return range_check (result, "SNGL");
} }
...@@ -3654,7 +3654,7 @@ gfc_simplify_verify (gfc_expr * s, gfc_expr * set, gfc_expr * b) ...@@ -3654,7 +3654,7 @@ gfc_simplify_verify (gfc_expr * s, gfc_expr * set, gfc_expr * b)
else else
back = 0; back = 0;
result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind (), result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind,
&s->where); &s->where);
len = s->value.character.length; len = s->value.character.length;
......
...@@ -1576,12 +1576,12 @@ gfc_get_namespace (gfc_namespace * parent) ...@@ -1576,12 +1576,12 @@ gfc_get_namespace (gfc_namespace * parent)
if ('i' <= i && i <= 'n') if ('i' <= i && i <= 'n')
{ {
ts->type = BT_INTEGER; ts->type = BT_INTEGER;
ts->kind = gfc_default_integer_kind (); ts->kind = gfc_default_integer_kind;
} }
else else
{ {
ts->type = BT_REAL; ts->type = BT_REAL;
ts->kind = gfc_default_real_kind (); ts->kind = gfc_default_real_kind;
} }
} }
......
...@@ -252,7 +252,7 @@ gfc_conv_mpfr_to_tree (mpfr_t f, int kind) ...@@ -252,7 +252,7 @@ gfc_conv_mpfr_to_tree (mpfr_t f, int kind)
edigits += 3; edigits += 3;
} }
if (kind == gfc_default_double_kind()) if (kind == gfc_default_double_kind)
p = mpfr_get_str (NULL, &exp, 10, 17, f, GFC_RND_MODE); p = mpfr_get_str (NULL, &exp, 10, 17, f, GFC_RND_MODE);
else else
p = mpfr_get_str (NULL, &exp, 10, 8, f, GFC_RND_MODE); p = mpfr_get_str (NULL, &exp, 10, 8, f, GFC_RND_MODE);
......
...@@ -817,7 +817,7 @@ gfc_new_nml_name_expr (char * name) ...@@ -817,7 +817,7 @@ gfc_new_nml_name_expr (char * name)
nml_name = gfc_get_expr(); nml_name = gfc_get_expr();
nml_name->ref = NULL; nml_name->ref = NULL;
nml_name->expr_type = EXPR_CONSTANT; nml_name->expr_type = EXPR_CONSTANT;
nml_name->ts.kind = gfc_default_character_kind (); nml_name->ts.kind = gfc_default_character_kind;
nml_name->ts.type = BT_CHARACTER; nml_name->ts.type = BT_CHARACTER;
nml_name->value.character.length = strlen(name); nml_name->value.character.length = strlen(name);
nml_name->value.character.string = name; nml_name->value.character.string = name;
......
...@@ -78,12 +78,12 @@ int gfc_index_integer_kind; ...@@ -78,12 +78,12 @@ int gfc_index_integer_kind;
/* The default kinds of the various types. */ /* The default kinds of the various types. */
static int gfc_default_integer_kind_1; int gfc_default_integer_kind;
static int gfc_default_real_kind_1; int gfc_default_real_kind;
static int gfc_default_double_kind_1; int gfc_default_double_kind;
static int gfc_default_character_kind_1; int gfc_default_character_kind;
static int gfc_default_logical_kind_1; int gfc_default_logical_kind;
static int gfc_default_complex_kind_1; int gfc_default_complex_kind;
/* Query the target to determine which machine modes are available for /* Query the target to determine which machine modes are available for
computation. Choose KIND numbers for them. */ computation. Choose KIND numbers for them. */
...@@ -180,31 +180,31 @@ gfc_init_kinds (void) ...@@ -180,31 +180,31 @@ gfc_init_kinds (void)
{ {
if (!saw_i8) if (!saw_i8)
fatal_error ("integer kind=8 not available for -i8 option"); fatal_error ("integer kind=8 not available for -i8 option");
gfc_default_integer_kind_1 = 8; gfc_default_integer_kind = 8;
} }
else if (saw_i4) else if (saw_i4)
gfc_default_integer_kind_1 = 4; gfc_default_integer_kind = 4;
else else
gfc_default_integer_kind_1 = gfc_integer_kinds[i_index - 1].kind; gfc_default_integer_kind = gfc_integer_kinds[i_index - 1].kind;
/* Choose the default real kind. Again, we choose 4 when possible. */ /* Choose the default real kind. Again, we choose 4 when possible. */
if (gfc_option.r8) if (gfc_option.r8)
{ {
if (!saw_r8) if (!saw_r8)
fatal_error ("real kind=8 not available for -r8 option"); fatal_error ("real kind=8 not available for -r8 option");
gfc_default_real_kind_1 = 8; gfc_default_real_kind = 8;
} }
else if (saw_r4) else if (saw_r4)
gfc_default_real_kind_1 = 4; gfc_default_real_kind = 4;
else else
gfc_default_real_kind_1 = gfc_real_kinds[0].kind; gfc_default_real_kind = gfc_real_kinds[0].kind;
/* Choose the default double kind. If -r8 is specified, we use kind=16, /* Choose the default double kind. If -r8 is specified, we use kind=16,
if it's available, otherwise we do not change anything. */ if it's available, otherwise we do not change anything. */
if (gfc_option.r8 && saw_r16) if (gfc_option.r8 && saw_r16)
gfc_default_double_kind_1 = 16; gfc_default_double_kind = 16;
else if (saw_r4 && saw_r8) else if (saw_r4 && saw_r8)
gfc_default_double_kind_1 = 8; gfc_default_double_kind = 8;
else else
{ {
/* F95 14.6.3.1: A nonpointer scalar object of type double precision /* F95 14.6.3.1: A nonpointer scalar object of type double precision
...@@ -218,61 +218,22 @@ gfc_init_kinds (void) ...@@ -218,61 +218,22 @@ gfc_init_kinds (void)
no GCC targets for which a two-word type does not exist, so we no GCC targets for which a two-word type does not exist, so we
just let gfc_validate_kind abort and tell us if something breaks. */ just let gfc_validate_kind abort and tell us if something breaks. */
gfc_default_double_kind_1 gfc_default_double_kind
= gfc_validate_kind (BT_REAL, gfc_default_real_kind_1 * 2, false); = gfc_validate_kind (BT_REAL, gfc_default_real_kind * 2, false);
} }
/* The default logical kind is constrained to be the same as the /* The default logical kind is constrained to be the same as the
default integer kind. Similarly with complex and real. */ default integer kind. Similarly with complex and real. */
gfc_default_logical_kind_1 = gfc_default_integer_kind_1; gfc_default_logical_kind = gfc_default_integer_kind;
gfc_default_complex_kind_1 = gfc_default_real_kind_1; gfc_default_complex_kind = gfc_default_real_kind;
/* Choose the smallest integer kind for our default character. */ /* Choose the smallest integer kind for our default character. */
gfc_default_character_kind_1 = gfc_integer_kinds[0].kind; gfc_default_character_kind = gfc_integer_kinds[0].kind;
/* Choose the integer kind the same size as "void*" for our index kind. */ /* Choose the integer kind the same size as "void*" for our index kind. */
gfc_index_integer_kind = POINTER_SIZE / 8; gfc_index_integer_kind = POINTER_SIZE / 8;
} }
/* ??? These functions should go away in favor of direct access to
the relevant variables. */
int
gfc_default_integer_kind (void)
{
return gfc_default_integer_kind_1;
}
int
gfc_default_real_kind (void)
{
return gfc_default_real_kind_1;
}
int
gfc_default_double_kind (void)
{
return gfc_default_double_kind_1;
}
int
gfc_default_character_kind (void)
{
return gfc_default_character_kind_1;
}
int
gfc_default_logical_kind (void)
{
return gfc_default_logical_kind_1;
}
int
gfc_default_complex_kind (void)
{
return gfc_default_complex_kind_1;
}
/* Make sure that a valid kind is present. Returns an index into the /* Make sure that a valid kind is present. Returns an index into the
associated kinds array, -1 if the kind is not present. */ associated kinds array, -1 if the kind is not present. */
...@@ -315,7 +276,7 @@ validate_logical (int kind) ...@@ -315,7 +276,7 @@ validate_logical (int kind)
static int static int
validate_character (int kind) validate_character (int kind)
{ {
return kind == gfc_default_character_kind_1 ? 0 : -1; return kind == gfc_default_character_kind ? 0 : -1;
} }
/* Validate a kind given a basic type. The return value is the same /* Validate a kind given a basic type. The return value is the same
...@@ -466,7 +427,7 @@ gfc_init_types (void) ...@@ -466,7 +427,7 @@ gfc_init_types (void)
= build_int_cst_wide (long_unsigned_type_node, lo, hi); = build_int_cst_wide (long_unsigned_type_node, lo, hi);
size_type_node = gfc_array_index_type; size_type_node = gfc_array_index_type;
boolean_type_node = gfc_get_logical_type (gfc_default_logical_kind ()); boolean_type_node = gfc_get_logical_type (gfc_default_logical_kind);
boolean_true_node = build_int_cst (boolean_type_node, 1); boolean_true_node = build_int_cst (boolean_type_node, 1);
boolean_false_node = build_int_cst (boolean_type_node, 0); boolean_false_node = build_int_cst (boolean_type_node, 0);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment