+2004-09-07 Per Bothner <per@bothner.com>
+ Paul Brook <paul@codesourcery.com>
+
+ * error.c (show_locus): Handle mapped locations.
+ * f95-lang.c (gfc_be_parse_file): Initialize mapped locations.
+ * gfortran.h: Include input.h.
+ (struct gfc_linebuf): Use source_location.
+ * scanner.c (get_file): Initialize linemap.
+ (preprocessor_line): Pass extra argument to get_file.
+ (load_file): Ditto. Setup linemap.
+ (gfc_new_file): Handle mapped locations.
+ * trans-common.c (build_field, build_equiv_decl, build_common_decl):
+ Set decl source locations.
+ (gfc_trans_common): Set blank common block location.
+ * trans-decl.c (gfc_set_decl_location): New function.
+ (gfc_get_label_decl, gfc_get_symbol_decl): Use it.
+ (trans_function_start): Move call to gfc_set_backend_locus..
+ (build_function_decl): ... to here.
+ (build_entry_thunks): Set and restore the backend locus.
+ (gfc_generate_constructors): Remove excess arguments to
+ init_function_start.
+ (gfc_generate_block_data): Add comments. Set the decl locus.
+ * trans-io.c (set_error_locus): Handle mapped locations.
+ * trans.c (gfc_get_backend_locus, gfc_get_backend_locus): Ditto.
+ (gfc_trans_code): Use SET_EXPR_LOCATION.
+ (gfc_generate_code): Override the location of the new symbol.
+ * trans.h (gfc_set_decl_location): Add prototype.
+
2004-08-31 Paul Brook <paul@codesourcery.com>
* trans-types.c (gfc_type_for_mode): Return NULL for unknown modes.
lb = loc->lb;
f = lb->file;
- error_printf ("In file %s:%d\n", f->filename, lb->linenum);
+ error_printf ("In file %s:%d\n", f->filename,
+#ifdef USE_MAPPED_LOCATION
+ LOCATION_LINE (lb->location)
+#else
+ lb->linenum
+#endif
+ );
for (;;)
{
static bool
gfc_init (void)
{
+#ifdef USE_MAPPED_LOCATION
+ linemap_add (&line_table, LC_ENTER, false, gfc_option.source, 1);
+ linemap_add (&line_table, LC_RENAME, false, "<built-in>", 0);
+#endif
+
/* First initialize the backend. */
gfc_init_decl_processing ();
gfc_static_ctors = NULL_TREE;
seem to be sufficient on some systems. */
#include "system.h"
#include "coretypes.h"
+#include "input.h"
/* The following ifdefs are recommended by the autoconf documentation
for any code using alloca. */
typedef struct gfc_linebuf
{
+#ifdef USE_MAPPED_LOCATION
+ source_location location;
+#else
int linenum;
+#endif
struct gfc_file *file;
struct gfc_linebuf *next;
the file stack. */
static gfc_file *
-get_file (char *name)
+get_file (char *name, enum lc_reason reason)
{
gfc_file *f;
if (current_file != NULL)
f->inclusion_line = current_file->line;
+#ifdef USE_MAPPED_LOCATION
+ linemap_add (&line_table, reason, false, f->filename, 1);
+#endif
+
return f;
}
if (flag[1] || flag[3]) /* Starting new file. */
{
- f = get_file (filename);
+ f = get_file (filename, LC_RENAME);
f->up = current_file;
current_file = f;
}
/* Load the file. */
- f = get_file (filename);
+ f = get_file (filename, initial ? LC_RENAME : LC_ENTER);
f->up = current_file;
current_file = f;
current_file->line = 1;
b = gfc_getmem (sizeof (gfc_linebuf) + len + 1);
+#ifdef USE_MAPPED_LOCATION
+ b->location
+ = linemap_line_start (&line_table, current_file->line++, 120);
+#else
b->linenum = current_file->line++;
+#endif
b->file = current_file;
strcpy (b->line, line);
fclose (input);
current_file = current_file->up;
+#ifdef USE_MAPPED_LOCATION
+ linemap_add (&line_table, LC_LEAVE, 0, NULL, 0);
+#endif
return SUCCESS;
}
#if 0 /* Debugging aid. */
for (; line_head; line_head = line_head->next)
gfc_status ("%s:%3d %s\n", line_head->file->filename,
- line_head->linenum, line_head->line);
+#ifdef USE_MAPPED_LOCATION
+ LOCATION_LINE (line_head->location),
+#else
+ line_head->linenum,
+#endif
+ line_head->line);
exit (0);
#endif
name = get_identifier (h->sym->name);
field = build_decl (FIELD_DECL, name, h->field);
+ gfc_set_decl_location (field, &h->sym->declared_at);
known_align = (offset & -offset) * BITS_PER_UNIT;
if (known_align == 0 || known_align > BIGGEST_ALIGNMENT)
known_align = BIGGEST_ALIGNMENT;
TREE_ADDRESSABLE (decl) = 1;
TREE_USED (decl) = 1;
+
+ /* The source location has been lost, and doesn't really matter.
+ We need to set it to something though. */
+ gfc_set_decl_location (decl, &gfc_current_locus);
+
gfc_add_decl_to_function (decl);
return decl;
DECL_ALIGN (decl) = BIGGEST_ALIGNMENT;
DECL_USER_ALIGN (decl) = 0;
+ gfc_set_decl_location (decl, &com->where);
+
/* Place the back end declaration for this common block in
GLOBAL_BINDING_LEVEL. */
common_sym->backend_decl = pushdecl_top_level (decl);
if (ns->blank_common.head != NULL)
{
c = gfc_get_common_head ();
+ /* We've lost the real location, so use the location of the
+ enclosing procedure. */
+ c->where = ns->proc_name->declared_at;
strcpy (c->name, BLANK_COMMON_NAME);
translate_common (c, ns->blank_common.head);
}
}
+/* Set the backend source location of a decl. */
+
+void
+gfc_set_decl_location (tree decl, locus * loc)
+{
+#ifdef USE_MAPPED_LOCATION
+ DECL_SOURCE_LOCATION (decl) = loc->lb->location;
+#else
+ DECL_SOURCE_LINE (decl) = loc->lb->linenum;
+ DECL_SOURCE_FILE (decl) = loc->lb->file->filename;
+#endif
+}
+
+
/* Return the backend label declaration for a given label structure,
or create it if it doesn't exist yet. */
/* Tell the debugger where the label came from. */
if (lp->value <= MAX_LABEL_VALUE) /* An internal label. */
- {
- DECL_SOURCE_LINE (label_decl) = lp->where.lb->linenum;
- DECL_SOURCE_FILE (label_decl) = lp->where.lb->file->filename;
- }
+ gfc_set_decl_location (label_decl, &lp->where);
else
DECL_ARTIFICIAL (label_decl) = 1;
/* Create the decl for the variable. */
decl = build_decl (VAR_DECL, gfc_sym_identifier (sym), gfc_sym_type (sym));
+ gfc_set_decl_location (decl, &sym->declared_at);
+
/* Symbols from modules should have their assembler names mangled.
This is done here rather than in gfc_finish_var_decl because it
is different for string length variables. */
assert (!sym->backend_decl);
assert (!sym->attr.external);
+ /* Set the line and filename. sym->declared_at seems to point to the
+ last statement for subroutines, but it'll do for now. */
+ gfc_set_backend_locus (&sym->declared_at);
+
/* Allow only one nesting level. Allow public declarations. */
assert (current_function_decl == NULL_TREE
|| DECL_CONTEXT (current_function_decl) == NULL_TREE);
/* Create RTL for function definition. */
make_decl_rtl (fndecl);
- /* Set the line and filename. sym->declared_at seems to point to the
- last statement for subroutines, but it'll do for now. */
- gfc_set_backend_locus (&sym->declared_at);
-
init_function_start (fndecl);
/* Even though we're inside a function body, we still don't want to
tree args;
tree string_args;
tree tmp;
+ locus old_loc;
/* This should always be a toplevel function. */
assert (current_function_decl == NULL_TREE);
+ gfc_get_backend_locus (&old_loc);
for (el = ns->entries; el; el = el->next)
{
thunk_sym = el->sym;
formal->sym->ts.cl->backend_decl = NULL_TREE;
}
}
+
+ gfc_set_backend_locus (&old_loc);
}
make_decl_rtl (fndecl);
- init_function_start (fndecl, input_filename, input_line);
+ init_function_start (fndecl);
pushlevel (0);
tree decl;
tree id;
+ /* Tell the backend the source location of the block data. */
+ if (ns->proc_name)
+ gfc_set_backend_locus (&ns->proc_name->declared_at);
+ else
+ gfc_set_backend_locus (&gfc_current_locus);
+
+ /* Process the DATA statements. */
gfc_trans_common (ns);
+ /* Create a global symbol with the mane of the block data. This is to
+ generate linker errors if the same name is used twice. It is never
+ really used. */
if (ns->proc_name)
id = gfc_sym_mangled_function_id (ns->proc_name);
else
tmp = gfc_build_addr_expr (pchar_type_node, tmp);
gfc_add_modify_expr (block, locus_file, tmp);
+#ifdef USE_MAPPED_LOCATION
+ line = LOCATION_LINE (where->lb->location);
+#else
line = where->lb->linenum;
+#endif
gfc_add_modify_expr (block, locus_line, build_int_cst (NULL_TREE, line));
}
gfc_get_backend_locus (locus * loc)
{
loc->lb = gfc_getmem (sizeof (gfc_linebuf));
+#ifdef USE_MAPPED_LOCATION
+ loc->lb->location = input_location; // FIXME adjust??
+#else
loc->lb->linenum = input_line - 1;
+#endif
loc->lb->file = gfc_current_backend_file;
}
void
gfc_set_backend_locus (locus * loc)
{
- input_line = loc->lb->linenum;
gfc_current_backend_file = loc->lb->file;
+#ifdef USE_MAPPED_LOCATION
+ input_location = loc->lb->location;
+#else
+ input_line = loc->lb->linenum;
input_filename = loc->lb->file->filename;
+#endif
}
if (TREE_CODE (res) == STATEMENT_LIST)
annotate_all_with_locus (&res, input_location);
else
- annotate_with_locus (res, input_location);
+ SET_EXPR_LOCATION (res, input_location);
/* Add the new statemment to the block. */
gfc_add_expr_to_block (&block, res);
attr.subroutine = 1;
attr.access = ACCESS_PUBLIC;
main_program->attr = attr;
+ /* Set the location to the first line of code. */
+ if (ns->code)
+ main_program->declared_at = ns->code->loc;
ns->proc_name = main_program;
gfc_commit_symbols ();
}
/* Make prototypes for runtime library functions. */
void gfc_build_builtin_function_decls (void);
+/* Set the backend source location of a decl. */
+void gfc_set_decl_location (tree, locus *);
+
/* Return the variable decl for a symbol. */
tree gfc_get_symbol_decl (gfc_symbol *);