* gfortran.h (gfc_current_locus, gfc_set_locus): Remove.
(gfc_current_locus): Declare new global variable.
* scanner.c (gfc_current_locus, gfc_set_locus): Remove.
(gfc_current_locus1): Rename ...
(gfc_current_locus): ... to this.
(gfc_at_eof, gfc_at_bol, gfc_at_eol, gfc_advance_line, next_char,
skip_fixed_comments, skip_free_comments, gfc_next_char_literal,
gfc_peek_char, gfc_gobble_whitespace, gfc_new_file): Use
gfc_current_locus instead of gfc_current_locus1, gfc_set_locus()
and gfc_current_locus(), respectively.
* array.c (match_subscript, gfc_match_array_ref, match_array_list,
match_array_cons_element, gfc_match_array_constructor):
Read/modify gfc_current_locus instead of calling gfc_set_locus()
and gfc_current_locus().
* decl.c (gfc_match_null, variable_decl, gfc_match_kind_spec,
match_attr_spec, gfc_match_function_decl, gfc_match_end,
attr_decl1, gfc_match_save): Likewise.
* error.c (error_print, gfc_internal_error): Likewise.
* expr.c (gfc_int_expr, gfc_default_logical_kind): Likewise.
* interface.c (gfc_add_interface): Likewise.
* io.c (gfc_match_format, match_dt_format, match_dt_element,
match_io_iterator, match_io): Likewise.
* match.c (gfc_match_space, gfc_match_eos,
gfc_match_small_literal_int, gfc_match_st_label,
gfc_match_strings, gfc_match_name, gfc_match_iterator,
gfc_match_char, gfc_match, gfc_match_assignment,
gfc_match_pointer_assignment, gfc_match_if, gfc_match_do,
gfc_match_nullify, gfc_match_call, match_implicit_range,
gfc_match_implicit, gfc_match_data, match_case_selector,
gfc_match_case, match_forall_iterator): Likewise.
* matchexp.c (gfc_match_defined_op_name, next_operator,
match_level_1, match_mult_operand, match_ext_mult_operand,
match_add_operand, match_ext_add_operand, match_level_2,
match_level_3, match_level_4, match_and_operand, match_or_operand,
match_equiv_operand, match_level_5, gfc_match_expr): Likewise.
* module.c (gfc_match_use, mio_array_ref, mio_expr): Likewise.
* parse.c (match_word, decode_statement, next_free, next_fixed,
add_statement, verify_st_order, parse_if_block, gfc_parse_file):
Likewise.
* primary.c (match_digits, match_integer_constant,
match_boz_constant, match_real_constant, match_substring,
next_string_char, match_charkind_name, match_string_constant,
match_logical_constant, match_const_complex_part,
match_complex_constant, match_actual_arg, match_keyword_arg,
gfc_match_actual_arglist, gfc_match_structure_constructor,
gfc_match_rvalue, gfc_match_variable): Likewise.
* st.c (gfc_get_code): Likewise.
* symbol.c (check_conflict, check_used, check_done,
duplicate_attr, add_flavor, gfc_add_procedure, gfc_add_intent,
gfc_add_access, gfc_add_explicit_interface, gfc_add_type,
gfc_add_component, gfc_reference_st_label, gfc_new_symbol): Likewise.
From-SVN: r82320
+2004-05-27 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
+
+ * gfortran.h (gfc_current_locus, gfc_set_locus): Remove.
+ (gfc_current_locus): Declare new global variable.
+ * scanner.c (gfc_current_locus, gfc_set_locus): Remove.
+ (gfc_current_locus1): Rename ...
+ (gfc_current_locus): ... to this.
+ (gfc_at_eof, gfc_at_bol, gfc_at_eol, gfc_advance_line, next_char,
+ skip_fixed_comments, skip_free_comments, gfc_next_char_literal,
+ gfc_peek_char, gfc_gobble_whitespace, gfc_new_file): Use
+ gfc_current_locus instead of gfc_current_locus1, gfc_set_locus()
+ and gfc_current_locus(), respectively.
+ * array.c (match_subscript, gfc_match_array_ref, match_array_list,
+ match_array_cons_element, gfc_match_array_constructor):
+ Read/modify gfc_current_locus instead of calling gfc_set_locus()
+ and gfc_current_locus().
+ * decl.c (gfc_match_null, variable_decl, gfc_match_kind_spec,
+ match_attr_spec, gfc_match_function_decl, gfc_match_end,
+ attr_decl1, gfc_match_save): Likewise.
+ * error.c (error_print, gfc_internal_error): Likewise.
+ * expr.c (gfc_int_expr, gfc_default_logical_kind): Likewise.
+ * interface.c (gfc_add_interface): Likewise.
+ * io.c (gfc_match_format, match_dt_format, match_dt_element,
+ match_io_iterator, match_io): Likewise.
+ * match.c (gfc_match_space, gfc_match_eos,
+ gfc_match_small_literal_int, gfc_match_st_label,
+ gfc_match_strings, gfc_match_name, gfc_match_iterator,
+ gfc_match_char, gfc_match, gfc_match_assignment,
+ gfc_match_pointer_assignment, gfc_match_if, gfc_match_do,
+ gfc_match_nullify, gfc_match_call, match_implicit_range,
+ gfc_match_implicit, gfc_match_data, match_case_selector,
+ gfc_match_case, match_forall_iterator): Likewise.
+ * matchexp.c (gfc_match_defined_op_name, next_operator,
+ match_level_1, match_mult_operand, match_ext_mult_operand,
+ match_add_operand, match_ext_add_operand, match_level_2,
+ match_level_3, match_level_4, match_and_operand, match_or_operand,
+ match_equiv_operand, match_level_5, gfc_match_expr): Likewise.
+ * module.c (gfc_match_use, mio_array_ref, mio_expr): Likewise.
+ * parse.c (match_word, decode_statement, next_free, next_fixed,
+ add_statement, verify_st_order, parse_if_block, gfc_parse_file):
+ Likewise.
+ * primary.c (match_digits, match_integer_constant,
+ match_boz_constant, match_real_constant, match_substring,
+ next_string_char, match_charkind_name, match_string_constant,
+ match_logical_constant, match_const_complex_part,
+ match_complex_constant, match_actual_arg, match_keyword_arg,
+ gfc_match_actual_arglist, gfc_match_structure_constructor,
+ gfc_match_rvalue, gfc_match_variable): Likewise.
+ * st.c (gfc_get_code): Likewise.
+ * symbol.c (check_conflict, check_used, check_done,
+ duplicate_attr, add_flavor, gfc_add_procedure, gfc_add_intent,
+ gfc_add_access, gfc_add_explicit_interface, gfc_add_type,
+ gfc_add_component, gfc_reference_st_label, gfc_new_symbol): Likewise.
+
2004-05-26 Roger Sayle <roger@eyesopen.com>
* io.c (format_asterisk): Silence compiler warnings by correcting
i = ar->dimen;
- ar->c_where[i] = *gfc_current_locus ();
+ ar->c_where[i] = gfc_current_locus;
ar->start[i] = ar->end[i] = ar->stride[i] = NULL;
/* We can't be sure of the difference between DIMEN_ELEMENT and
memset (ar, '\0', sizeof (ar));
- ar->where = *gfc_current_locus ();
+ ar->where = gfc_current_locus;
ar->as = as;
if (gfc_match_char ('(') != MATCH_YES)
match m;
int n;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
if (gfc_match_char ('(') == MATCH_NO)
return MATCH_NO;
e->value.constructor = head;
p = gfc_get_constructor ();
- p->where = *gfc_current_locus ();
+ p->where = gfc_current_locus;
p->iterator = gfc_get_iterator ();
*p->iterator = iter;
cleanup:
gfc_free_constructor (head);
gfc_free_iterator (&iter, 0);
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
return m;
}
return m;
p = gfc_get_constructor ();
- p->where = *gfc_current_locus ();
+ p->where = gfc_current_locus;
p->expr = expr;
*result = p;
if (gfc_match (" (/") == MATCH_NO)
return MATCH_NO;
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
head = tail = NULL;
if (gfc_match (" /)") == MATCH_YES)
return MATCH_ERROR;
e = gfc_get_expr ();
- e->where = *gfc_current_locus ();
+ e->where = gfc_current_locus;
e->expr_type = EXPR_NULL;
e->ts.type = BT_UNKNOWN;
if (m != MATCH_YES)
goto cleanup;
- var_locus = *gfc_current_locus ();
+ var_locus = gfc_current_locus;
/* Now we could see the optional array spec. or character length. */
m = gfc_match_array_spec (&as);
m = MATCH_NO;
e = NULL;
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
if (gfc_match_char ('(') == MATCH_NO)
return MATCH_NO;
no_match:
gfc_free_expr (e);
- gfc_set_locus (&where);
+ gfc_current_locus = where;
return m;
}
try t;
gfc_clear_attr (¤t_attr);
- start = *gfc_current_locus ();
+ start = gfc_current_locus;
current_as = NULL;
colon_seen = 0;
break;
seen[d]++;
- seen_at[d] = *gfc_current_locus ();
+ seen_at[d] = gfc_current_locus;
if (d == DECL_DIMENSION)
{
return MATCH_YES;
cleanup:
- gfc_set_locus (&start);
+ gfc_current_locus = start;
gfc_free_array_spec (current_as);
current_as = NULL;
return m;
gfc_clear_ts (¤t_ts);
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
m = match_prefix (¤t_ts);
if (m != MATCH_YES)
{
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
return m;
}
if (gfc_match ("function% %n", name) != MATCH_YES)
{
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
return MATCH_NO;
}
return MATCH_YES;
cleanup:
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
return m;
}
const char *target;
match m;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
if (gfc_match ("end") != MATCH_YES)
return MATCH_NO;
gfc_syntax_error (*st);
cleanup:
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
return MATCH_ERROR;
}
if (find_special (name, &sym))
return MATCH_ERROR;
- var_locus = *gfc_current_locus ();
+ var_locus = gfc_current_locus;
/* Deal with possible array specification for certain attributes. */
if (current_attr.dimension
switch (m)
{
case MATCH_YES:
- if (gfc_add_save (&sym->attr, gfc_current_locus ()) == FAILURE)
+ if (gfc_add_save (&sym->attr, &gfc_current_locus) == FAILURE)
return MATCH_ERROR;
goto next_item;
case 'C':
if (c == 'C')
- loc = gfc_current_locus ();
+ loc = &gfc_current_locus;
if (have_l1)
{
va_start (argp, format);
- show_loci (gfc_current_locus (), NULL);
+ show_loci (&gfc_current_locus, NULL);
error_printf ("Internal Error at (1):");
error_print ("", format, argp);
p->ts.type = BT_INTEGER;
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);
return p;
p->ts.kind = gfc_default_logical_kind ();
if (where == NULL)
- where = gfc_current_locus ();
+ where = &gfc_current_locus;
p->where = *where;
p->value.logical = i;
void gfc_release_include_path (void);
FILE *gfc_open_included_file (const char *);
-locus *gfc_current_locus (void);
-void gfc_set_locus (locus *);
-
int gfc_at_end (void);
int gfc_at_eof (void);
int gfc_at_bol (void);
extern gfc_source_form gfc_current_form;
extern char *gfc_source_file;
-/* extern locus gfc_current_locus; */
+extern locus gfc_current_locus;
/* misc.c */
void *gfc_getmem (size_t) ATTRIBUTE_MALLOC;
intr = gfc_get_interface ();
intr->sym = new;
- intr->where = *gfc_current_locus ();
+ intr->where = gfc_current_locus;
intr->next = *head;
*head = intr;
mode = MODE_FORMAT;
format_length = 0;
- start = *gfc_current_locus ();
+ start = gfc_current_locus;
if (check_format () == FAILURE)
return MATCH_ERROR;
/* The label doesn't get created until after the statement is done
being matched, so we have to leave the string for later. */
- gfc_set_locus (&start); /* Back to the beginning */
+ gfc_current_locus = start; /* Back to the beginning */
new_st.loc = start;
new_st.op = EXEC_NOP;
gfc_expr *e;
gfc_st_label *label;
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
if (gfc_match_char ('*') == MATCH_YES)
{
return MATCH_YES;
}
- gfc_set_locus (&where); /* The only case where we have to restore */
+ gfc_current_locus = where; /* The only case where we have to restore */
return MATCH_NO;
m = match_ltag (&tag_end, &dt->end);
if (m == MATCH_YES)
- dt->end_where = *gfc_current_locus ();
+ dt->end_where = gfc_current_locus;
if (m != MATCH_NO)
return m;
m = match_ltag (&tag_eor, &dt->eor);
if (m == MATCH_YES)
- dt->eor_where = *gfc_current_locus ();
+ dt->eor_where = gfc_current_locus;
if (m != MATCH_NO)
return m;
iter = NULL;
head = NULL;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
if (gfc_match_char ('(') != MATCH_YES)
return MATCH_NO;
cleanup:
gfc_free_iterator (iter, 1);
gfc_free_statements (head);
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
return m;
}
if (m == MATCH_ERROR)
goto cleanup;
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
if (gfc_match_name (name) == MATCH_YES
&& !gfc_find_symbol (name, NULL, 1, &sym)
goto next;
}
- gfc_set_locus (&where);
+ gfc_current_locus = where;
goto loop; /* No matches, try regular elements */
if (gfc_current_form == FORM_FIXED)
return MATCH_YES;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
c = gfc_next_char ();
if (!gfc_is_whitespace (c))
{
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
return MATCH_NO;
}
for (;;)
{
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
gfc_gobble_whitespace ();
c = gfc_next_char ();
break;
}
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
return (flag) ? MATCH_YES : MATCH_NO;
}
char c;
int i;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
gfc_gobble_whitespace ();
c = gfc_next_char ();
if (!ISDIGIT (c))
{
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
return MATCH_NO;
}
for (;;)
{
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
c = gfc_next_char ();
if (!ISDIGIT (c))
}
}
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
*value = i;
return MATCH_YES;
match m;
int i;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
m = gfc_match_small_literal_int (&i);
if (m != MATCH_YES)
}
gfc_error ("Statement label at %C is out of range");
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
return MATCH_ERROR;
}
no_match = p->tag;
best_match = NULL;
- match_loc = *gfc_current_locus ();
+ match_loc = gfc_current_locus;
gfc_gobble_whitespace ();
if (*p->mp == '\0')
{
/* Found a match. */
- match_loc = *gfc_current_locus ();
+ match_loc = gfc_current_locus;
best_match = p;
possibles--;
p->mp = NULL;
}
}
- gfc_set_locus (&match_loc);
+ gfc_current_locus = match_loc;
return (best_match == NULL) ? no_match : best_match->tag;
}
locus old_loc;
int i, c;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
gfc_gobble_whitespace ();
c = gfc_next_char ();
if (!ISALPHA (c))
{
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
return MATCH_NO;
}
return MATCH_ERROR;
}
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
c = gfc_next_char ();
}
while (ISALNUM (c)
|| (gfc_option.flag_dollar_ok && c == '$'));
buffer[i] = '\0';
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
return MATCH_YES;
}
/* Match the start of an iterator without affecting the symbol
table. */
- start = *gfc_current_locus ();
+ start = gfc_current_locus;
m = gfc_match (" %n =", name);
- gfc_set_locus (&start);
+ gfc_current_locus = start;
if (m != MATCH_YES)
return MATCH_NO;
{
locus where;
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
gfc_gobble_whitespace ();
if (gfc_next_char () == c)
return MATCH_YES;
- gfc_set_locus (&where);
+ gfc_current_locus = where;
return MATCH_NO;
}
void **vp;
const char *p;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
va_start (argp, target);
m = MATCH_NO;
matches = 0;
if (m != MATCH_YES)
{
/* Clean up after a failed match. */
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
va_start (argp, target);
p = target;
locus old_loc;
match m;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
lvalue = rvalue = NULL;
m = gfc_match (" %v =", &lvalue);
return MATCH_YES;
cleanup:
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
gfc_free_expr (lvalue);
gfc_free_expr (rvalue);
return m;
locus old_loc;
match m;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
lvalue = rvalue = NULL;
return MATCH_YES;
cleanup:
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
gfc_free_expr (lvalue);
gfc_free_expr (rvalue);
return m;
if (n == MATCH_ERROR)
return n;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
m = gfc_match (" if ( %e", &expr);
if (m != MATCH_YES)
gfc_free_expr (expr);
gfc_undo_symbols ();
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
gfc_match (" if ( %e ) ", &expr); /* Guaranteed to match */
gfc_free_expr (expr);
gfc_undo_symbols ();
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
gfc_match (" if ( %e ) ", &expr); /* Guaranteed to match */
p = gfc_get_code ();
p->next = gfc_get_code ();
*p->next = new_st;
- p->next->loc = *gfc_current_locus ();
+ p->next->loc = gfc_current_locus;
p->expr = expr;
p->op = EXEC_IF;
gfc_st_label *label;
match m;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
label = NULL;
iter.var = iter.start = iter.end = iter.step = NULL;
/* The abortive DO WHILE may have done something to the symbol
table, so we start over: */
gfc_undo_symbols ();
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
gfc_match_label (); /* This won't error */
gfc_match (" do "); /* This will work */
/* build ' => NULL() ' */
e = gfc_get_expr ();
- e->where = *gfc_current_locus ();
+ e->where = gfc_current_locus;
e->expr_type = EXPR_NULL;
e->ts.type = BT_UNKNOWN;
i = 0;
for (a = arglist; a; a = a->next)
if (a->expr == NULL)
- i = 1;
+ i = 1;
if (i)
{
c->expr->expr_type = EXPR_VARIABLE;
c->expr->symtree = select_st;
c->expr->ts = select_sym->ts;
- c->expr->where = *gfc_current_locus ();
+ c->expr->where = gfc_current_locus;
i = 0;
for (a = arglist; a; a = a->next)
int c, c1, c2, inner;
locus cur_loc;
- cur_loc = *gfc_current_locus ();
+ cur_loc = gfc_current_locus;
gfc_gobble_whitespace ();
c = gfc_next_char ();
bad:
gfc_syntax_error (ST_IMPLICIT);
- gfc_set_locus (&cur_loc);
+ gfc_current_locus = cur_loc;
return MATCH_ERROR;
}
if (m == MATCH_NO)
goto syntax;
- cur_loc = *gfc_current_locus ();
+ cur_loc = gfc_current_locus;
m = match_implicit_range (&ts);
if (m == MATCH_YES)
if ((c == '\n') || (c == ','))
continue;
- gfc_set_locus (&cur_loc);
+ gfc_current_locus = cur_loc;
}
/* Last chance -- check <TYPE> (<KIND>) (<RANGE>). */
for (;;)
{
new = gfc_get_data ();
- new->where = *gfc_current_locus ();
+ new->where = gfc_current_locus;
m = top_var_list (new);
if (m != MATCH_YES)
match m;
c = gfc_get_case ();
- c->where = *gfc_current_locus ();
+ c->where = gfc_current_locus;
if (gfc_match_char (':') == MATCH_YES)
{
new_st.op = EXEC_SELECT;
c = gfc_get_case ();
- c->where = *gfc_current_locus ();
+ c->where = gfc_current_locus;
new_st.ext.case_list = c;
return MATCH_YES;
}
locus where;
match m;
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
iter = gfc_getmem (sizeof (gfc_forall_iterator));
m = gfc_match_variable (&iter->var, 0);
m = MATCH_ERROR;
cleanup:
- gfc_set_locus (&where);
+ gfc_current_locus = where;
gfc_free_forall_iterator (iter);
return m;
}
match m;
int i;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
m = gfc_match (" . %n .", name);
if (m != MATCH_YES)
{
if (error_flag)
goto error;
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
return MATCH_NO;
}
gfc_error ("The name '%s' cannot be used as a defined operator at %C",
name);
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
return MATCH_ERROR;
}
gfc_intrinsic_op u;
locus old_loc;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
if (gfc_match_intrinsic_op (&u) == MATCH_YES && t == u)
return 1;
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
return 0;
}
locus where;
match m;
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
uop = NULL;
m = match_defined_operator (&uop);
if (m == MATCH_ERROR)
return MATCH_YES;
}
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
m = match_ext_mult_operand (&exp);
if (m == MATCH_NO)
match m;
int i;
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
i = match_add_op ();
if (i == 0)
{
/* Build up a string of products or quotients. */
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
if (next_operator (INTRINSIC_TIMES))
i = INTRINSIC_TIMES;
break;
}
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
m = match_ext_mult_operand (&e);
if (m == MATCH_NO)
{
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
break;
}
match m;
int i;
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
i = match_add_op ();
if (i == 0)
match m;
int i;
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
i = match_add_op ();
if (i != 0)
for (;;)
{
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
i = match_add_op ();
if (i == 0)
break;
if (!next_operator (INTRINSIC_CONCAT))
break;
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
m = match_level_2 (&e);
if (m == MATCH_NO)
if (m != MATCH_YES)
return m;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
if (gfc_match_intrinsic_op (&i) != MATCH_YES)
{
if (i != INTRINSIC_EQ && i != INTRINSIC_NE && i != INTRINSIC_GE
&& i != INTRINSIC_LE && i != INTRINSIC_LT && i != INTRINSIC_GT)
{
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
*result = left;
return MATCH_YES;
}
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
m = match_level_3 (&right);
if (m == MATCH_NO)
int i;
i = next_operator (INTRINSIC_NOT);
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
m = match_level_4 (&e);
if (m != MATCH_YES)
{
if (!next_operator (INTRINSIC_AND))
break;
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
m = match_and_operand (&e);
if (m == MATCH_NO)
{
if (!next_operator (INTRINSIC_OR))
break;
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
m = match_or_operand (&e);
if (m == MATCH_NO)
break;
}
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
m = match_equiv_operand (&e);
if (m == MATCH_NO)
return MATCH_ERROR;
}
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
m = match_level_5 (&e);
if (m == MATCH_NO)
{
/* Get a new rename struct and add it to the rename list. */
new = gfc_get_use_rename ();
- new->where = *gfc_current_locus ();
+ new->where = gfc_current_locus;
new->found = 0;
if (gfc_rename_list == NULL)
if (iomode == IO_INPUT)
{
- ar->where = *gfc_current_locus ();
+ ar->where = gfc_current_locus;
for (i = 0; i < ar->dimen; i++)
- ar->c_where[i] = *gfc_current_locus ();
+ ar->c_where[i] = gfc_current_locus;
}
mio_rparen ();
bad_module ("Expected expression type");
e = *ep = gfc_get_expr ();
- e->where = *gfc_current_locus ();
+ e->where = gfc_current_locus;
e->expr_type = (expr_t) find_enum (expr_types);
}
if (m != MATCH_YES)
{
- gfc_set_locus (old_locus);
+ gfc_current_locus = *old_locus;
reject_statement ();
}
if (gfc_match_eos () == MATCH_YES)
return ST_NONE;
- old_locus = *gfc_current_locus ();
+ old_locus = gfc_current_locus;
/* Try matching a data declaration or function declaration. The
input "REALFUNCTIONA(N)" can mean several things in different
reject_statement ();
gfc_undo_symbols ();
- gfc_set_locus (&old_locus);
+ gfc_current_locus = old_locus;
}
/* Match statements whose error messages are meant to be overwritten
if (gfc_match_subroutine () == MATCH_YES)
return ST_SUBROUTINE;
gfc_undo_symbols ();
- gfc_set_locus (&old_locus);
+ gfc_current_locus = old_locus;
/* Check for the IF, DO, SELECT, WHERE and FORALL statements, which
might begin with a block label. The match functions for these
if (gfc_match_if (&st) == MATCH_YES)
return st;
gfc_undo_symbols ();
- gfc_set_locus (&old_locus);
+ gfc_current_locus = old_locus;
if (gfc_match_where (&st) == MATCH_YES)
return st;
gfc_undo_symbols ();
- gfc_set_locus (&old_locus);
+ gfc_current_locus = old_locus;
if (gfc_match_forall (&st) == MATCH_YES)
return st;
gfc_undo_symbols ();
- gfc_set_locus (&old_locus);
+ gfc_current_locus = old_locus;
match (NULL, gfc_match_do, ST_DO);
match (NULL, gfc_match_select, ST_SELECT_CASE);
}
else
{
- label_locus = *gfc_current_locus ();
+ label_locus = gfc_current_locus;
if (gfc_statement_label->value == 0)
{
case '8':
case '9':
label = label * 10 + c - '0';
- label_locus = *gfc_current_locus ();
+ label_locus = gfc_current_locus;
digit_flag = 1;
break;
do
{
- loc = *gfc_current_locus ();
+ loc = gfc_current_locus;
c = gfc_next_char_literal (0);
}
while (gfc_is_whitespace (c));
if (c == '!')
goto blank_line;
- gfc_set_locus (&loc);
+ gfc_current_locus = loc;
if (gfc_match_eos () == MATCH_YES)
goto blank_line;
p = gfc_get_code ();
*p = new_st;
- p->loc = *gfc_current_locus ();
+ p->loc = gfc_current_locus;
if (gfc_state_stack->head == NULL)
gfc_state_stack->head = p;
}
/* All is well, record the statement in case we need it next time. */
- p->where = *gfc_current_locus ();
+ p->where = gfc_current_locus;
p->last_statement = st;
return SUCCESS;
}
seen_else = 1;
- else_locus = *gfc_current_locus ();
+ else_locus = gfc_current_locus;
d = new_level (gfc_state_stack->head);
d->op = EXEC_IF;
if (seen_program)
goto duplicate_main;
seen_program = 1;
- prog_locus = *gfc_current_locus ();
+ prog_locus = gfc_current_locus;
push_state (&s, COMP_PROGRAM, gfc_new_block);
accept_statement (st);
if (seen_program)
goto duplicate_main;
seen_program = 1;
- prog_locus = *gfc_current_locus ();
+ prog_locus = gfc_current_locus;
push_state (&s, COMP_PROGRAM, gfc_new_block);
parse_progunit (st);
for (;;)
{
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
c = gfc_next_char ();
if (!check_digit (c, radix))
length++;
}
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
return length;
}
char *buffer;
gfc_expr *e;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
gfc_gobble_whitespace ();
length = match_digits (signflag, 10, NULL);
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
if (length == -1)
return MATCH_NO;
return MATCH_ERROR;
}
- e = gfc_convert_integer (buffer, kind, 10, gfc_current_locus ());
+ e = gfc_convert_integer (buffer, kind, 10, &gfc_current_locus);
if (gfc_range_check (e) != ARITH_OK)
{
gfc_expr *e;
const char *rname;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
gfc_gobble_whitespace ();
switch (gfc_next_char ())
if (delim != '\'' && delim != '\"')
goto backup;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
length = match_digits (0, radix, NULL);
if (length == -1)
return MATCH_ERROR;
}
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
buffer = alloca (length + 1);
memset (buffer, '\0', length + 1);
gfc_next_char ();
e = gfc_convert_integer (buffer, gfc_default_integer_kind (), radix,
- gfc_current_locus ());
+ &gfc_current_locus);
if (gfc_range_check (e) != ARITH_OK)
{
return MATCH_YES;
backup:
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
return MATCH_NO;
}
char *p, *buffer;
gfc_expr *e;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
gfc_gobble_whitespace ();
e = NULL;
goto done;
/* Check to see if "." goes with a following operator like ".eq.". */
- temp_loc = *gfc_current_locus ();
+ temp_loc = gfc_current_locus;
c = gfc_next_char ();
if (c == 'e' || c == 'd' || c == 'q')
if (ISALPHA (c))
goto done; /* Distinguish 1.e9 from 1.eq.2 */
- gfc_set_locus (&temp_loc);
+ gfc_current_locus = temp_loc;
seen_dp = 1;
continue;
}
/* TODO: seen_digits is always true at this point */
if (!seen_digits)
{
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
return MATCH_NO; /* ".e" can be something else */
}
/* See what we've got! */
if (!seen_digits || (!seen_dp && exp_char == ' '))
{
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
return MATCH_NO;
}
/* Convert the number. */
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
gfc_gobble_whitespace ();
buffer = alloca (count + 1);
}
}
- e = gfc_convert_real (buffer, kind, gfc_current_locus ());
+ e = gfc_convert_real (buffer, kind, &gfc_current_locus);
switch (gfc_range_check (e))
{
start = NULL;
end = NULL;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
m = gfc_match_char ('(');
if (m != MATCH_YES)
gfc_free_expr (start);
gfc_free_expr (end);
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
return m;
}
if (c == '\\')
{
- old_locus = *gfc_current_locus ();
+ old_locus = gfc_current_locus;
switch (gfc_next_char_literal (1))
{
default:
/* Unknown backslash codes are simply not expanded */
- gfc_set_locus (&old_locus);
+ gfc_current_locus = old_locus;
break;
}
}
if (c != delimiter)
return c;
- old_locus = *gfc_current_locus ();
+ old_locus = gfc_current_locus;
c = gfc_next_char_literal (1);
if (c == delimiter)
return c;
- gfc_set_locus (&old_locus);
+ gfc_current_locus = old_locus;
return -1;
}
for (;;)
{
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
c = gfc_next_char ();
if (c == '_')
if (peek == '\'' || peek == '\"')
{
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
*name = '\0';
return MATCH_YES;
}
const char *q;
match m;
- old_locus = *gfc_current_locus ();
+ old_locus = gfc_current_locus;
gfc_gobble_whitespace ();
- start_locus = *gfc_current_locus ();
+ start_locus = gfc_current_locus;
c = gfc_next_char ();
if (c == '\'' || c == '"')
}
else
{
- gfc_set_locus (&old_locus);
+ gfc_current_locus = old_locus;
m = match_charkind_name (name);
if (m != MATCH_YES)
goto no_match;
gfc_gobble_whitespace ();
- start_locus = *gfc_current_locus ();
+ start_locus = gfc_current_locus;
c = gfc_next_char ();
if (c != '\'' && c != '"')
break;
if (c == -2)
{
- gfc_set_locus (&start_locus);
+ gfc_current_locus = start_locus;
gfc_error ("Unterminated character constant beginning at %C");
return MATCH_ERROR;
}
e->value.character.string = p = gfc_getmem (length + 1);
e->value.character.length = length;
- gfc_set_locus (&start_locus);
+ gfc_current_locus = start_locus;
gfc_next_char (); /* Skip delimiter */
for (i = 0; i < length; i++)
return MATCH_YES;
no_match:
- gfc_set_locus (&old_locus);
+ gfc_current_locus = old_locus;
return MATCH_NO;
}
e->value.logical = i;
e->ts.type = BT_LOGICAL;
e->ts.kind = kind;
- e->where = *gfc_current_locus ();
+ e->where = gfc_current_locus;
*result = e;
return MATCH_YES;
char *p, c, exp_char, *buffer;
locus old_loc;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
gfc_gobble_whitespace ();
seen_dp = 0;
goto no_match;
/* Convert the number. */
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
gfc_gobble_whitespace ();
buffer = alloca (count + 1);
}
}
- *result = gfc_convert_real (buffer, kind, gfc_current_locus ());
+ *result = gfc_convert_real (buffer, kind, &gfc_current_locus);
return MATCH_YES;
no_match:
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
return MATCH_NO;
}
int kind;
match m;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
real = imag = e = NULL;
m = gfc_match_char ('(');
gfc_convert_type (imag, &target, 2);
e = gfc_convert_complex (real, imag, kind);
- e->where = *gfc_current_locus ();
+ e->where = gfc_current_locus;
gfc_free_expr (real);
gfc_free_expr (imag);
gfc_free_expr (e);
gfc_free_expr (real);
gfc_free_expr (imag);
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
return m;
}
gfc_expr *e;
int c;
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
switch (gfc_match_name (name))
{
break;
case MATCH_YES:
- w = *gfc_current_locus ();
+ w = gfc_current_locus;
gfc_gobble_whitespace ();
c = gfc_next_char ();
- gfc_set_locus (&w);
+ gfc_current_locus = w;
if (c != ',' && c != ')')
break;
return MATCH_YES;
}
- gfc_set_locus (&where);
+ gfc_current_locus = where;
return gfc_match_expr (result);
}
locus name_locus;
match m;
- name_locus = *gfc_current_locus ();
+ name_locus = gfc_current_locus;
m = gfc_match_name (name);
if (m != MATCH_YES)
return MATCH_YES;
cleanup:
- gfc_set_locus (&name_locus);
+ gfc_current_locus = name_locus;
return m;
}
match m;
*argp = tail = NULL;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
seen_keyword = 0;
cleanup:
gfc_free_actual_arglist (head);
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
return MATCH_ERROR;
}
if (gfc_match_char ('(') != MATCH_YES)
goto syntax;
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
gfc_find_component (sym, NULL);
sym = symtree->n.sym;
e = NULL;
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
gfc_set_sym_referenced (sym);
e->symtree = symtree;
e->expr_type = EXPR_FUNCTION;
e->value.function.actual = actual_arglist;
- e->where = *gfc_current_locus ();
+ e->where = gfc_current_locus;
if (sym->as != NULL)
e->rank = sym->as->rank;
m = gfc_match_sym_tree (&st, 1);
if (m != MATCH_YES)
return m;
- where = *gfc_current_locus ();
+ where = gfc_current_locus;
sym = st->n.sym;
gfc_set_sym_referenced (sym);
gfc_source_form gfc_current_form;
static gfc_linebuf *line_head, *line_tail;
-locus gfc_current_locus1;
+locus gfc_current_locus;
char *gfc_source_file;
return NULL;
}
-
-/* Return a pointer to the current locus. */
-
-locus *
-gfc_current_locus (void)
-{
-
- return &gfc_current_locus1;
-}
-
-
-
-/* Let a caller move the current read pointer (backwards). */
-
-void
-gfc_set_locus (locus * lp)
-{
-
- gfc_current_locus1 = *lp;
-}
-
-
/* Test to see if we're at the end of the main source file. */
int
if (line_head == NULL)
return 1; /* Null file */
- if (gfc_current_locus1.lb == NULL)
+ if (gfc_current_locus.lb == NULL)
return 1;
return 0;
if (gfc_at_eof ())
return 1;
- return (gfc_current_locus1.nextc == gfc_current_locus1.lb->line);
+ return (gfc_current_locus.nextc == gfc_current_locus.lb->line);
}
if (gfc_at_eof ())
return 1;
- return (*gfc_current_locus1.nextc == '\0');
+ return (*gfc_current_locus.nextc == '\0');
}
if (gfc_at_end ())
return;
- if (gfc_current_locus1.lb == NULL)
+ if (gfc_current_locus.lb == NULL)
{
end_flag = 1;
return;
}
- gfc_current_locus1.lb = gfc_current_locus1.lb->next;
+ gfc_current_locus.lb = gfc_current_locus.lb->next;
- if (gfc_current_locus1.lb != NULL)
- gfc_current_locus1.nextc = gfc_current_locus1.lb->line;
+ if (gfc_current_locus.lb != NULL)
+ gfc_current_locus.nextc = gfc_current_locus.lb->line;
else
{
- gfc_current_locus1.nextc = NULL;
+ gfc_current_locus.nextc = NULL;
end_flag = 1;
}
}
{
int c;
- if (gfc_current_locus1.nextc == NULL)
+ if (gfc_current_locus.nextc == NULL)
return '\n';
- c = *gfc_current_locus1.nextc++;
+ c = *gfc_current_locus.nextc++;
if (c == '\0')
{
- gfc_current_locus1.nextc--; /* Remain on this line. */
+ gfc_current_locus.nextc--; /* Remain on this line. */
c = '\n';
}
for (;;)
{
- start = gfc_current_locus1;
+ start = gfc_current_locus;
if (gfc_at_eof ())
break;
break;
}
- gfc_set_locus (&start);
+ gfc_current_locus = start;
}
for (;;)
{
- start = gfc_current_locus1;
+ start = gfc_current_locus;
if (gfc_at_eof ())
break;
break;
}
- gfc_set_locus (&start);
+ gfc_current_locus = start;
}
/* If the next nonblank character is a ! or \n, we've got a
continuation line. */
- old_loc = gfc_current_locus1;
+ old_loc = gfc_current_locus;
c = next_char ();
while (gfc_is_whitespace (c))
if (in_string && c != '\n')
{
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
c = '&';
goto done;
}
if (c != '!' && c != '\n')
{
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
c = '&';
goto done;
}
reading starts at the next character, otherwise we must back
up to where the whitespace started and resume from there. */
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
c = next_char ();
while (gfc_is_whitespace (c))
c = next_char ();
if (c != '&')
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
}
else
goto done;
continue_flag = 1;
- old_loc = *gfc_current_locus ();
+ old_loc = gfc_current_locus;
gfc_advance_line ();
gfc_skip_comments ();
not_continuation:
c = '\n';
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
done:
continue_flag = 0;
locus old_loc;
int c;
- old_loc = gfc_current_locus1;
+ old_loc = gfc_current_locus;
c = gfc_next_char ();
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
return c;
}
do
{
- old_loc = gfc_current_locus1;
+ old_loc = gfc_current_locus;
c = gfc_next_char_literal (0);
}
while (gfc_is_whitespace (c));
- gfc_set_locus (&old_loc);
+ gfc_current_locus = old_loc;
}
result = load_file (gfc_source_file, true);
- gfc_current_locus1.lb = line_head;
- gfc_current_locus1.nextc = (line_head == NULL) ? NULL : line_head->line;
+ gfc_current_locus.lb = line_head;
+ gfc_current_locus.nextc = (line_head == NULL) ? NULL : line_head->line;
#if 0 /* Debugging aid. */
for (; line_head; line_head = line_head->next)
gfc_code *c;
c = gfc_getmem (sizeof (gfc_code));
- c->loc = *gfc_current_locus ();
+ c->loc = gfc_current_locus;
return c;
}
const char *a1, *a2;
if (where == NULL)
- where = gfc_current_locus ();
+ where = &gfc_current_locus;
if (attr->pointer && attr->intent != INTENT_UNKNOWN)
{
return 0;
if (where == NULL)
- where = gfc_current_locus ();
+ where = &gfc_current_locus;
gfc_error ("Cannot change attributes of USE-associated symbol at %L",
where);
return 0;
if (where == NULL)
- where = gfc_current_locus ();
+ where = &gfc_current_locus;
gfc_error ("Cannot change attributes of symbol at %L"
" after it has been used", where);
{
if (where == NULL)
- where = gfc_current_locus ();
+ where = &gfc_current_locus;
gfc_error ("Duplicate %s attribute specified at %L", attr, where);
}
if (attr->flavor != FL_UNKNOWN)
{
if (where == NULL)
- where = gfc_current_locus ();
+ where = &gfc_current_locus;
gfc_error ("%s attribute conflicts with %s attribute at %L",
gfc_code2string (flavors, attr->flavor),
return FAILURE;
if (where == NULL)
- where = gfc_current_locus ();
+ where = &gfc_current_locus;
if (attr->proc != PROC_UNKNOWN)
{
}
if (where == NULL)
- where = gfc_current_locus ();
+ where = &gfc_current_locus;
gfc_error ("INTENT (%s) conflicts with INTENT(%s) at %L",
gfc_intent_string (attr->intent),
}
if (where == NULL)
- where = gfc_current_locus ();
+ where = &gfc_current_locus;
gfc_error ("ACCESS specification at %L was already specified", where);
return FAILURE;
return FAILURE;
if (where == NULL)
- where = gfc_current_locus ();
+ where = &gfc_current_locus;
if (sym->attr.if_source != IFSRC_UNKNOWN
&& sym->attr.if_source != IFSRC_DECL)
return FAILURE;*/
if (where == NULL)
- where = gfc_current_locus ();
+ where = &gfc_current_locus;
if (sym->ts.type != BT_UNKNOWN)
{
tail->next = p;
strcpy (p->name, name);
- p->loc = *gfc_current_locus ();
+ p->loc = gfc_current_locus;
*component = p;
return SUCCESS;
else
{
label_type = lp->referenced;
- lp->where = *gfc_current_locus ();
+ lp->where = gfc_current_locus;
}
if (label_type == ST_LABEL_FORMAT && type == ST_LABEL_TARGET)
gfc_clear_attr (&p->attr);
p->ns = ns;
- p->declared_at = *gfc_current_locus ();
+ p->declared_at = gfc_current_locus;
if (strlen (name) > GFC_MAX_SYMBOL_LEN)
gfc_internal_error ("new_symbol(): Symbol name too long");
projects / gcc.git / commitdiff