trans.h (gfc_set_decl_assembler_name): New prototype.
authorFrancois-Xavier Coudert <fxcoudert@gcc.gnu.org>
Wed, 22 Jul 2009 08:28:10 +0000 (08:28 +0000)
committerFrançois-Xavier Coudert <fxcoudert@gcc.gnu.org>
Wed, 22 Jul 2009 08:28:10 +0000 (08:28 +0000)
* trans.h (gfc_set_decl_assembler_name): New prototype.
* trans-decl.c (gfc_set_decl_assembler_name): New function.
(gfc_get_symbol_decl, gfc_get_extern_function_decl,
build_function_decl): Use gfc_set_decl_assembler_name instead of
SET_DECL_ASSEMBLER_NAME.
* trans-common.c (build_common_decl): Use
gfc_set_decl_assembler_name instead of SET_DECL_ASSEMBLER_NAME.

From-SVN: r149918

gcc/fortran/ChangeLog
gcc/fortran/trans-common.c
gcc/fortran/trans-decl.c
gcc/fortran/trans.h

index ebd8a4c..9370dd7 100644 (file)
@@ -1,3 +1,13 @@
+2009-07-22  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+       * trans.h (gfc_set_decl_assembler_name): New prototype.
+       * trans-decl.c (gfc_set_decl_assembler_name): New function.
+       (gfc_get_symbol_decl, gfc_get_extern_function_decl,
+       build_function_decl): Use gfc_set_decl_assembler_name instead of
+       SET_DECL_ASSEMBLER_NAME.
+       * trans-common.c (build_common_decl): Use
+       gfc_set_decl_assembler_name instead of SET_DECL_ASSEMBLER_NAME.
+
 2009-07-21  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/40726
index f4bbb46..ca94567 100644 (file)
@@ -415,7 +415,7 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init)
     {
       decl = build_decl (input_location,
                         VAR_DECL, get_identifier (com->name), union_type);
-      SET_DECL_ASSEMBLER_NAME (decl, gfc_sym_mangled_common_id (com));
+      gfc_set_decl_assembler_name (decl, gfc_sym_mangled_common_id (com));
       TREE_PUBLIC (decl) = 1;
       TREE_STATIC (decl) = 1;
       DECL_IGNORED_P (decl) = 1;
index fa25782..83c28cd 100644 (file)
@@ -368,6 +368,14 @@ gfc_sym_mangled_function_id (gfc_symbol * sym)
 }
 
 
+void
+gfc_set_decl_assembler_name (tree decl, tree name)
+{
+  tree target_mangled = targetm.mangle_decl_assembler_name (decl, name);
+  SET_DECL_ASSEMBLER_NAME (decl, target_mangled);
+}
+
+
 /* Returns true if a variable of specified size should go on the stack.  */
 
 int
@@ -1111,12 +1119,16 @@ gfc_get_symbol_decl (gfc_symbol * sym)
   decl = build_decl (sym->declared_at.lb->location,
                     VAR_DECL, gfc_sym_identifier (sym), gfc_sym_type (sym));
 
+  /* Add attributes to variables.  Functions are handled elsewhere.  */
+  attributes = add_attributes_to_decl (sym->attr, NULL_TREE);
+  decl_attributes (&decl, attributes, 0);
+
   /* 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.  */
   if (sym->module)
     {
-      SET_DECL_ASSEMBLER_NAME (decl, gfc_sym_mangled_identifier (sym));
+      gfc_set_decl_assembler_name (decl, gfc_sym_mangled_identifier (sym));
       if (sym->attr.use_assoc)
        DECL_IGNORED_P (decl) = 1;
     }
@@ -1162,7 +1174,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
              name[0] = '.';
              strcpy (&name[1],
                      IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (length)));
-             SET_DECL_ASSEMBLER_NAME (decl, get_identifier (name));
+             gfc_set_decl_assembler_name (decl, get_identifier (name));
            }
          gfc_finish_var_decl (length, sym);
          gcc_assert (!sym->value);
@@ -1210,10 +1222,6 @@ gfc_get_symbol_decl (gfc_symbol * sym)
       && !sym->attr.proc_pointer)
     DECL_BY_REFERENCE (decl) = 1;
 
-  /* Add attributes to variables.  Functions are handled elsewhere.  */
-  attributes = add_attributes_to_decl (sym->attr, NULL_TREE);
-  decl_attributes (&decl, attributes, 0);
-
   return decl;
 }
 
@@ -1422,7 +1430,10 @@ gfc_get_extern_function_decl (gfc_symbol * sym)
   fndecl = build_decl (input_location,
                       FUNCTION_DECL, name, type);
 
-  SET_DECL_ASSEMBLER_NAME (fndecl, mangled_name);
+  attributes = add_attributes_to_decl (sym->attr, NULL_TREE);
+  decl_attributes (&fndecl, attributes, 0);
+
+  gfc_set_decl_assembler_name (fndecl, mangled_name);
 
   /* Set the context of this decl.  */
   if (0 && sym->ns && sym->ns->proc_name)
@@ -1465,9 +1476,6 @@ gfc_get_extern_function_decl (gfc_symbol * sym)
   if (DECL_CONTEXT (fndecl) == NULL_TREE)
     pushdecl_top_level (fndecl);
 
-  attributes = add_attributes_to_decl (sym->attr, NULL_TREE);
-  decl_attributes (&fndecl, attributes, 0);
-
   return fndecl;
 }
 
@@ -1501,15 +1509,18 @@ build_function_decl (gfc_symbol * sym)
   fndecl = build_decl (input_location,
                       FUNCTION_DECL, gfc_sym_identifier (sym), type);
 
+  attr = sym->attr;
+
+  attributes = add_attributes_to_decl (attr, NULL_TREE);
+  decl_attributes (&fndecl, attributes, 0);
+
   /* Perform name mangling if this is a top level or module procedure.  */
   if (current_function_decl == NULL_TREE)
-    SET_DECL_ASSEMBLER_NAME (fndecl, gfc_sym_mangled_function_id (sym));
+    gfc_set_decl_assembler_name (fndecl, gfc_sym_mangled_function_id (sym));
 
   /* Figure out the return type of the declared function, and build a
      RESULT_DECL for it.  If this is a subroutine with alternate
      returns, build a RESULT_DECL for it.  */
-  attr = sym->attr;
-
   result_decl = NULL_TREE;
   /* TODO: Shouldn't this just be TREE_TYPE (TREE_TYPE (fndecl)).  */
   if (attr.function)
@@ -1579,8 +1590,6 @@ build_function_decl (gfc_symbol * sym)
       TREE_SIDE_EFFECTS (fndecl) = 0;
     }
 
-  attributes = add_attributes_to_decl (attr, NULL_TREE);
-  decl_attributes (&fndecl, attributes, 0);
 
   /* Layout the function declaration and put it in the binding level
      of the current function.  */
index 5152b95..4469023 100644 (file)
@@ -409,6 +409,10 @@ void gfc_shadow_sym (gfc_symbol *, tree, gfc_saved_var *);
 /* Restore the original variable.  */
 void gfc_restore_sym (gfc_symbol *, gfc_saved_var *);
 
+/* Setting a decl assembler name, mangling it according to target rules
+   (like Windows @NN decorations).  */
+void gfc_set_decl_assembler_name (tree, tree);
+
 /* Returns true if a variable of specified size should go on the stack.  */
 int gfc_can_put_var_on_stack (tree);