* trans-decl.c (gfc_build_qualified_array): Don't skip generation

[pf3gnuchains/gcc-fork.git] / gcc / fortran / trans-decl.c

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 3695555..cbfff29 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -145,6 +145,8 @@ tree gfor_fndecl_convert_char4_to_char1;
 tree gfor_fndecl_size0;
 tree gfor_fndecl_size1;
 tree gfor_fndecl_iargc;
+tree gfor_fndecl_clz128;
+tree gfor_fndecl_ctz128;
 
 /* Intrinsic functions implemented in Fortran.  */
 tree gfor_fndecl_sc_kind;
@@ -287,7 +289,10 @@ gfc_get_label_decl (gfc_st_label * lp)
 static tree
 gfc_sym_identifier (gfc_symbol * sym)
 {
-  return (get_identifier (sym->name));
+  if (sym->attr.is_main_program && strcmp (sym->name, "main") == 0)
+    return (get_identifier ("MAIN__"));
+  else
+    return (get_identifier (sym->name));
 }
 
 
@@ -708,9 +713,6 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
       layout_type (type);
     }
 
-  if (write_symbols == NO_DEBUG)
-    return;
-
   if (TYPE_NAME (type) != NULL_TREE
       && GFC_TYPE_ARRAY_UBOUND (type, sym->as->rank - 1) != NULL_TREE
       && TREE_CODE (GFC_TYPE_ARRAY_UBOUND (type, sym->as->rank - 1)) == VAR_DECL)
@@ -2570,6 +2572,19 @@ gfc_build_intrinsic_function_decls (void)
     gfc_build_library_function_decl (get_identifier (PREFIX ("iargc")),
                                     gfc_int4_type_node,
                                     0);
+
+  if (gfc_type_for_size (128, true))
+    {
+      tree uint128 = gfc_type_for_size (128, true);
+
+      gfor_fndecl_clz128 =
+       gfc_build_library_function_decl (get_identifier (PREFIX ("clz128")),
+                                        integer_type_node, 1, uint128);
+
+      gfor_fndecl_ctz128 =
+       gfc_build_library_function_decl (get_identifier (PREFIX ("ctz128")),
+                                        integer_type_node, 1, uint128);
+    }
 }
 
 
@@ -3838,11 +3853,20 @@ add_argument_checking (stmtblock_t *block, gfc_symbol *sym)
 static void
 create_main_function (tree fndecl)
 {
-
+  tree old_context;
   tree ftn_main;
   tree tmp, decl, result_decl, argc, argv, typelist, arglist;
   stmtblock_t body;
 
+  old_context = current_function_decl;
+
+  if (old_context)
+    {
+      push_function_context ();
+      saved_parent_function_decls = saved_function_decls;
+      saved_function_decls = NULL_TREE;
+    }
+
   /* main() function must be declared with global scope.  */
   gcc_assert (current_function_decl == NULL_TREE);
 
@@ -3850,6 +3874,8 @@ create_main_function (tree fndecl)
   tmp =  build_function_type_list (integer_type_node, integer_type_node,
                                   build_pointer_type (pchar_type_node),
                                   NULL_TREE);
+  main_identifier_node = get_identifier ("main");
+  ftn_main = build_decl (FUNCTION_DECL, main_identifier_node, tmp);
   ftn_main = build_decl (FUNCTION_DECL, get_identifier ("main"), tmp);
   DECL_EXTERNAL (ftn_main) = 0;
   TREE_PUBLIC (ftn_main) = 1;
@@ -3903,6 +3929,8 @@ create_main_function (tree fndecl)
   /* Call some libgfortran initialization routines, call then MAIN__(). */
 
   /* Call _gfortran_set_args (argc, argv).  */
+  TREE_USED (argc) = 1;
+  TREE_USED (argv) = 1;
   tmp = build_call_expr (gfor_fndecl_set_args, 2, argc, argv);
   gfc_add_expr_to_block (&body, tmp);
 
@@ -4000,6 +4028,9 @@ create_main_function (tree fndecl)
   tmp = build_call_expr (fndecl, 0);
   gfc_add_expr_to_block (&body, tmp);
 
+  /* Mark MAIN__ as used.  */
+  TREE_USED (fndecl) = 1;
+
   /* "return 0".  */
   tmp = fold_build2 (MODIFY_EXPR, integer_type_node, DECL_RESULT (ftn_main),
                     build_int_cst (integer_type_node, 0));
@@ -4023,6 +4054,13 @@ create_main_function (tree fndecl)
 
   gfc_gimplify_function (ftn_main);
   cgraph_finalize_function (ftn_main, false);
+
+  if (old_context)
+    {
+      pop_function_context ();
+      saved_function_decls = saved_parent_function_decls;
+    }
+  current_function_decl = old_context;
 }