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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@87142 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f796c85..b8572d8 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,31 @@
+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.
 2004-08-31  Paul Brook  <paul@codesourcery.com>
 
        * trans-types.c (gfc_type_for_mode): Return NULL for unknown modes.

diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c
index d028d5a..3c0d5c8 100644 (file)
--- a/gcc/fortran/error.c
+++ b/gcc/fortran/error.c
@@ -127,7 +127,13 @@ show_locus (int offset, locus * loc)
 
   lb = loc->lb;
   f = lb->file;
 
   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 (;;)
     {
 
   for (;;)
     {

diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index 6018ec8..6a94611 100644 (file)
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -280,6 +280,11 @@ gfc_be_parse_file (int set_yydebug ATTRIBUTE_UNUSED)
 static bool
 gfc_init (void)
 {
 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;
   /* First initialize the backend.  */
   gfc_init_decl_processing ();
   gfc_static_ctors = NULL_TREE;

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 3ae3978..0e15252 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -33,6 +33,7 @@ Software Foundation, 59 Temple Place - Suite 330, Boston, MA
    seem to be sufficient on some systems.  */
 #include "system.h"
 #include "coretypes.h"
    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.  */
 
 /* The following ifdefs are recommended by the autoconf documentation
    for any code using alloca.  */


@@ -459,7 +460,11 @@ typedef struct gfc_file
 
 typedef struct gfc_linebuf 
 {
 
 typedef struct gfc_linebuf 
 {

+#ifdef USE_MAPPED_LOCATION
+  source_location location;
+#else

   int linenum;
   int linenum;

+#endif

   struct gfc_file *file;
   struct gfc_linebuf *next;
 
   struct gfc_file *file;
   struct gfc_linebuf *next;
 

diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c
index ae473d8..a470639 100644 (file)
--- a/gcc/fortran/scanner.c
+++ b/gcc/fortran/scanner.c
@@ -801,7 +801,7 @@ load_line (FILE * input, char **pbuf, char *filename, int linenum)
    the file stack.  */
 
 static gfc_file *
    the file stack.  */
 
 static gfc_file *

-get_file (char *name)
+get_file (char *name, enum lc_reason reason)

 {
   gfc_file *f;
 
 {
   gfc_file *f;
 


@@ -817,6 +817,10 @@ get_file (char *name)
   if (current_file != NULL)
     f->inclusion_line = current_file->line;
 
   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;
 }
 
   return f;
 }
 


@@ -874,7 +878,7 @@ preprocessor_line (char *c)
   
   if (flag[1] || flag[3]) /* Starting new file.  */
     {
   
   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;
     }
       f->up = current_file;
       current_file = f;
     }


@@ -999,7 +1003,7 @@ load_file (char *filename, bool initial)
 
   /* Load the file.  */
 
 
   /* 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;
   f->up = current_file;
   current_file = f;
   current_file->line = 1;


@@ -1032,7 +1036,12 @@ load_file (char *filename, bool initial)
 
       b = gfc_getmem (sizeof (gfc_linebuf) + len + 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++;
       b->linenum = current_file->line++;

+#endif

       b->file = current_file;
       strcpy (b->line, line);
 
       b->file = current_file;
       strcpy (b->line, line);
 


@@ -1050,6 +1059,9 @@ load_file (char *filename, bool initial)
   fclose (input);
 
   current_file = current_file->up;
   fclose (input);
 
   current_file = current_file->up;

+#ifdef USE_MAPPED_LOCATION
+  linemap_add (&line_table, LC_LEAVE, 0, NULL, 0);
+#endif

   return SUCCESS;
 }
 
   return SUCCESS;
 }
 


@@ -1167,7 +1179,12 @@ gfc_new_file (const char *filename, gfc_source_form form)
 #if 0 /* Debugging aid.  */
   for (; line_head; line_head = line_head->next)
     gfc_status ("%s:%3d %s\n", line_head->file->filename, 
 #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
 
   exit (0);
 #endif

diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index 69cb1a3..f9db554 100644 (file)
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -226,6 +226,7 @@ build_field (segment_info *h, tree union_type, record_layout_info rli)
 
   name = get_identifier (h->sym->name);
   field = build_decl (FIELD_DECL, name, h->field);
 
   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;
   known_align = (offset & -offset) * BITS_PER_UNIT;
   if (known_align == 0 || known_align > BIGGEST_ALIGNMENT)
     known_align = BIGGEST_ALIGNMENT;


@@ -268,6 +269,11 @@ build_equiv_decl (tree union_type, bool is_init)
 
   TREE_ADDRESSABLE (decl) = 1;
   TREE_USED (decl) = 1;
 
   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;
   gfc_add_decl_to_function (decl);
 
   return decl;


@@ -321,6 +327,8 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init)
       DECL_ALIGN (decl) = BIGGEST_ALIGNMENT;
       DECL_USER_ALIGN (decl) = 0;
 
       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);
       /* Place the back end declaration for this common block in
          GLOBAL_BINDING_LEVEL.  */
       common_sym->backend_decl = pushdecl_top_level (decl);


@@ -797,6 +805,9 @@ gfc_trans_common (gfc_namespace *ns)
   if (ns->blank_common.head != NULL)
     {
       c = gfc_get_common_head ();
   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);
     }
       strcpy (c->name, BLANK_COMMON_NAME);
       translate_common (c, ns->blank_common.head);
     }

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 730448a..4968939 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -214,6 +214,20 @@ gfc_get_return_label (void)
 }
 
 
 }
 
 

+/* 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.  */
 
 /* Return the backend label declaration for a given label structure,
    or create it if it doesn't exist yet.  */
 


@@ -238,10 +252,7 @@ gfc_get_label_decl (gfc_st_label * lp)
 
       /* Tell the debugger where the label came from.  */
       if (lp->value <= MAX_LABEL_VALUE)        /* An internal label.  */
 
       /* 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;
 
       else
        DECL_ARTIFICIAL (label_decl) = 1;
 


@@ -757,6 +768,8 @@ gfc_get_symbol_decl (gfc_symbol * sym)
   /* Create the decl for the variable.  */
   decl = build_decl (VAR_DECL, gfc_sym_identifier (sym), gfc_sym_type (sym));
 
   /* 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.  */
   /* 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.  */


@@ -978,6 +991,10 @@ build_function_decl (gfc_symbol * sym)
   assert (!sym->backend_decl);
   assert (!sym->attr.external);
 
   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);
   /* Allow only one nesting level.  Allow public declarations.  */
   assert (current_function_decl == NULL_TREE
          || DECL_CONTEXT (current_function_decl) == NULL_TREE);


@@ -1298,10 +1315,6 @@ trans_function_start (gfc_symbol * sym)
   /* Create RTL for function definition.  */
   make_decl_rtl (fndecl);
 
   /* 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
   init_function_start (fndecl);
 
   /* Even though we're inside a function body, we still don't want to


@@ -1328,10 +1341,12 @@ build_entry_thunks (gfc_namespace * ns)
   tree args;
   tree string_args;
   tree tmp;
   tree args;
   tree string_args;
   tree tmp;

+  locus old_loc;

 
   /* This should always be a toplevel function.  */
   assert (current_function_decl == NULL_TREE);
 
 
   /* 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;
   for (el = ns->entries; el; el = el->next)
     {
       thunk_sym = el->sym;


@@ -1430,6 +1445,8 @@ build_entry_thunks (gfc_namespace * ns)
            formal->sym->ts.cl->backend_decl = NULL_TREE;
        }
     }
            formal->sym->ts.cl->backend_decl = NULL_TREE;
        }
     }

+
+  gfc_set_backend_locus (&old_loc);

 }
 
 
 }
 
 


@@ -2338,7 +2355,7 @@ gfc_generate_constructors (void)
 
   make_decl_rtl (fndecl);
 
 
   make_decl_rtl (fndecl);
 

-  init_function_start (fndecl, input_filename, input_line);
+  init_function_start (fndecl);

 
   pushlevel (0);
 
 
   pushlevel (0);
 


@@ -2373,8 +2390,18 @@ gfc_generate_block_data (gfc_namespace * ns)
   tree decl;
   tree id;
 
   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);
 
   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
   if (ns->proc_name)
     id = gfc_sym_mangled_function_id (ns->proc_name);
   else

diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index d1bf736..60f8edf 100644 (file)
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -524,7 +524,11 @@ set_error_locus (stmtblock_t * block, locus * where)
   tmp = gfc_build_addr_expr (pchar_type_node, tmp);
   gfc_add_modify_expr (block, locus_file, tmp);
 
   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;
   line = where->lb->linenum;

+#endif

   gfc_add_modify_expr (block, locus_line, build_int_cst (NULL_TREE, line));
 }
 
   gfc_add_modify_expr (block, locus_line, build_int_cst (NULL_TREE, line));
 }
 

diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 727a7d7..59decfe 100644 (file)
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -442,7 +442,11 @@ void
 gfc_get_backend_locus (locus * loc)
 {
   loc->lb = gfc_getmem (sizeof (gfc_linebuf));    
 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;
   loc->lb->linenum = input_line - 1;

+#endif

   loc->lb->file = gfc_current_backend_file;
 }
 
   loc->lb->file = gfc_current_backend_file;
 }
 


@@ -452,9 +456,13 @@ gfc_get_backend_locus (locus * loc)
 void
 gfc_set_backend_locus (locus * loc)
 {
 void
 gfc_set_backend_locus (locus * loc)
 {

-  input_line = loc->lb->linenum;

   gfc_current_backend_file = loc->lb->file;
   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;
   input_filename = loc->lb->file->filename;

+#endif

 }
 
 
 }
 
 


@@ -626,7 +634,7 @@ gfc_trans_code (gfc_code * code)
          if (TREE_CODE (res) == STATEMENT_LIST)
            annotate_all_with_locus (&res, input_location);
          else
          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);
 
          /* Add the new statemment to the block.  */
          gfc_add_expr_to_block (&block, res);


@@ -665,6 +673,9 @@ gfc_generate_code (gfc_namespace * ns)
       attr.subroutine = 1;
       attr.access = ACCESS_PUBLIC;
       main_program->attr = attr;
       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 ();
     }
       ns->proc_name = main_program;
       gfc_commit_symbols ();
     }

diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 1c7c73c..9b7d355 100644 (file)
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -374,6 +374,9 @@ void gfc_add_decl_to_function (tree);
 /* Make prototypes for runtime library functions.  */
 void gfc_build_builtin_function_decls (void);
 
 /* 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 *);
 
 /* Return the variable decl for a symbol.  */
 tree gfc_get_symbol_decl (gfc_symbol *);