fortran/

2009-05-26  Tobias Burnus  <burnus@net-b.de>

        PR fortran/39178
        * gfortranspec.c (lang_specific_driver): Stop linking
        libgfortranbegin.
        * trans-decl.c (gfc_build_builtin_function_decls): Stop
        making MAIN__ publicly visible.
        (gfc_build_builtin_function_decls): Add
        gfor_fndecl_set_args.
        (create_main_function) New function.
        (gfc_generate_function_code): Use it.

libgfortran/
2009-05-26  Tobias Burnus  <burnus@net-b.de>

        PR fortran/39178
        * runtime/main.c (store_exe_path): Make static
        and multiple-times callable.
        (set_args): Call store_exe_path.
        * libgfortran.h: Remove store_exe_path prototype.
        * fmain.c (main): Remove store_exe_path call.



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

7 files changed, 253 insertions, 156 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 048d44e191a..805596293e2 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,17 @@
 2009-05-26  Tobias Burnus  <burnus@net-b.de>
 
+	PR fortran/39178
+	* gfortranspec.c (lang_specific_driver): Stop linking
+	libgfortranbegin.
+	* trans-decl.c (gfc_build_builtin_function_decls): Stop
+	making MAIN__ publicly visible.
+	(gfc_build_builtin_function_decls): Add
+	gfor_fndecl_set_args.
+	(create_main_function) New function.
+	(gfc_generate_function_code): Use it.
+
+2009-05-26  Tobias Burnus  <burnus@net-b.de>
+
 	PR fortran/40246
 	* match.c (gfc_match_nullify): NULLify freed pointer.
 
diff --git a/gcc/fortran/gfortranspec.c b/gcc/fortran/gfortranspec.c
index 0e5e7913e97..a6f9b42b474 100644
--- a/gcc/fortran/gfortranspec.c
+++ b/gcc/fortran/gfortranspec.c
@@ -58,10 +58,6 @@ along with GCC; see the file COPYING3.  If not see
 #define MATH_LIBRARY "-lm"
 #endif
 
-#ifndef FORTRAN_INIT
-#define FORTRAN_INIT "-lgfortranbegin"
-#endif
-
 #ifndef FORTRAN_LIBRARY
 #define FORTRAN_LIBRARY "-lgfortran"
 #endif
@@ -278,10 +274,6 @@ lang_specific_driver (int *in_argc, const char *const **in_argv,
      2 => last two args were -l<library> -lm.  */
   int saw_library = 0;
 
-  /* 0 => initial/reset state
-     1 => FORTRAN_INIT linked in */
-  int use_init = 0;
-
   /* By default, we throw on the math library if we have one.  */
   int need_math = (MATH_LIBRARY[0] != '\0');
 
@@ -505,12 +497,6 @@ For more information about these matters, see the file named COPYING\n\n"));
 		saw_library = 2;	/* -l<library> -lm.  */
 	      else
 		{
-		  if (0 == use_init)
-		    {
-		      append_arg (FORTRAN_INIT);
-		      use_init = 1;
-		    }
-
 		  ADD_ARG_LIBGFORTRAN (FORTRAN_LIBRARY);
 		}
 	    }
@@ -540,11 +526,6 @@ For more information about these matters, see the file named COPYING\n\n"));
       switch (saw_library)
 	{
 	case 0:
-	  if (0 == use_init)
-	    {
-	      append_arg (FORTRAN_INIT);
-	      use_init = 1;
-	    }
 	  ADD_ARG_LIBGFORTRAN (library);
 	  /* Fall through.  */
 
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 8f355f6a373..36955552042 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -86,6 +86,7 @@ tree gfor_fndecl_runtime_error_at;
 tree gfor_fndecl_runtime_warning_at;
 tree gfor_fndecl_os_error;
 tree gfor_fndecl_generate_error;
+tree gfor_fndecl_set_args;
 tree gfor_fndecl_set_fpe;
 tree gfor_fndecl_set_options;
 tree gfor_fndecl_set_convert;
@@ -1525,7 +1526,7 @@ build_function_decl (gfc_symbol * sym)
   /* This specifies if a function is globally visible, i.e. it is
      the opposite of declaring static in C.  */
   if (DECL_CONTEXT (fndecl) == NULL_TREE
-      && !sym->attr.entry_master)
+      && !sym->attr.entry_master && !sym->attr.is_main_program)
     TREE_PUBLIC (fndecl) = 1;
 
   /* TREE_STATIC means the function body is defined here.  */
@@ -1544,12 +1545,6 @@ build_function_decl (gfc_symbol * sym)
       TREE_SIDE_EFFECTS (fndecl) = 0;
     }
 
-  /* For -fwhole-program to work well, the main program needs to have the
-     "externally_visible" attribute.  */
-  if (attr.is_main_program)
-    DECL_ATTRIBUTES (fndecl)
-      = tree_cons (get_identifier("externally_visible"), NULL_TREE, NULL_TREE);
-
   /* Layout the function declaration and put it in the binding level
      of the current function.  */
   pushdecl (fndecl);
@@ -2635,6 +2630,11 @@ gfc_build_builtin_function_decls (void)
   /* The runtime_error function does not return.  */
   TREE_THIS_VOLATILE (gfor_fndecl_os_error) = 1;
 
+  gfor_fndecl_set_args =
+    gfc_build_library_function_decl (get_identifier (PREFIX("set_args")),
+				     void_type_node, 2, integer_type_node,
+				     build_pointer_type (pchar_type_node));
+
   gfor_fndecl_set_fpe =
     gfc_build_library_function_decl (get_identifier (PREFIX("set_fpe")),
 				    void_type_node, 1, integer_type_node);
@@ -2643,7 +2643,7 @@ gfc_build_builtin_function_decls (void)
   gfor_fndecl_set_options =
     gfc_build_library_function_decl (get_identifier (PREFIX("set_options")),
 				    void_type_node, 2, integer_type_node,
-				    pvoid_type_node);
+				    build_pointer_type (integer_type_node));
 
   gfor_fndecl_set_convert =
     gfc_build_library_function_decl (get_identifier (PREFIX("set_convert")),
@@ -3835,6 +3835,197 @@ add_argument_checking (stmtblock_t *block, gfc_symbol *sym)
 }
 
 
+static void
+create_main_function (tree fndecl)
+{
+
+  tree ftn_main;
+  tree tmp, decl, result_decl, argc, argv, typelist, arglist;
+  stmtblock_t body;
+
+  /* main() function must be declared with global scope.  */
+  gcc_assert (current_function_decl == NULL_TREE);
+
+  /* Declare the function.  */
+  tmp =  build_function_type_list (integer_type_node, integer_type_node,
+				   build_pointer_type (pchar_type_node),
+				   NULL_TREE);
+  ftn_main = build_decl (FUNCTION_DECL, get_identifier ("main"), tmp);
+  DECL_EXTERNAL (ftn_main) = 0;
+  TREE_PUBLIC (ftn_main) = 1;
+  TREE_STATIC (ftn_main) = 1;
+  DECL_ATTRIBUTES (ftn_main)
+      = tree_cons (get_identifier("externally_visible"), NULL_TREE, NULL_TREE);
+
+  /* Setup the result declaration (for "return 0").  */
+  result_decl = build_decl (RESULT_DECL, NULL_TREE, integer_type_node);
+  DECL_ARTIFICIAL (result_decl) = 1;
+  DECL_IGNORED_P (result_decl) = 1;
+  DECL_CONTEXT (result_decl) = ftn_main;
+  DECL_RESULT (ftn_main) = result_decl;
+
+  pushdecl (ftn_main);
+
+  /* Get the arguments.  */
+
+  arglist = NULL_TREE;
+  typelist = TYPE_ARG_TYPES (TREE_TYPE (ftn_main));
+
+  tmp = TREE_VALUE (typelist);
+  argc = build_decl (PARM_DECL, get_identifier ("argc"), tmp);
+  DECL_CONTEXT (argc) = ftn_main;
+  DECL_ARG_TYPE (argc) = TREE_VALUE (typelist);
+  TREE_READONLY (argc) = 1;
+  gfc_finish_decl (argc);
+  arglist = chainon (arglist, argc);
+
+  typelist = TREE_CHAIN (typelist);
+  tmp = TREE_VALUE (typelist);
+  argv = build_decl (PARM_DECL, get_identifier ("argv"), tmp);
+  DECL_CONTEXT (argv) = ftn_main;
+  DECL_ARG_TYPE (argv) = TREE_VALUE (typelist);
+  TREE_READONLY (argv) = 1;
+  DECL_BY_REFERENCE (argv) = 1;
+  gfc_finish_decl (argv);
+  arglist = chainon (arglist, argv);
+
+  DECL_ARGUMENTS (ftn_main) = arglist;
+  current_function_decl = ftn_main;
+  announce_function (ftn_main);
+
+  rest_of_decl_compilation (ftn_main, 1, 0);
+  make_decl_rtl (ftn_main);
+  init_function_start (ftn_main);
+  pushlevel (0);
+
+  gfc_init_block (&body);
+
+  /* Call some libgfortran initialization routines, call then MAIN__(). */
+
+  /* Call _gfortran_set_args (argc, argv).  */
+  tmp = build_call_expr (gfor_fndecl_set_args, 2, argc, argv);
+  gfc_add_expr_to_block (&body, tmp);
+
+  /* Add a call to set_options to set up the runtime library Fortran
+     language standard parameters.  */
+  {
+    tree array_type, array, var;
+
+    /* Passing a new option to the library requires four modifications:
+     + add it to the tree_cons list below
+          + change the array size in the call to build_array_type
+          + change the first argument to the library call
+            gfor_fndecl_set_options
+          + modify the library (runtime/compile_options.c)!  */
+
+    array = tree_cons (NULL_TREE, build_int_cst (integer_type_node,
+		       gfc_option.warn_std), NULL_TREE);
+    array = tree_cons (NULL_TREE, build_int_cst (integer_type_node,
+		       gfc_option.allow_std), array);
+    array = tree_cons (NULL_TREE, build_int_cst (integer_type_node, pedantic),
+		       array);
+    array = tree_cons (NULL_TREE, build_int_cst (integer_type_node,
+		       gfc_option.flag_dump_core), array);
+    array = tree_cons (NULL_TREE, build_int_cst (integer_type_node,
+		       gfc_option.flag_backtrace), array);
+    array = tree_cons (NULL_TREE, build_int_cst (integer_type_node,
+		       gfc_option.flag_sign_zero), array);
+
+    array = tree_cons (NULL_TREE, build_int_cst (integer_type_node,
+		       (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)), array);
+
+    array = tree_cons (NULL_TREE, build_int_cst (integer_type_node,
+		       gfc_option.flag_range_check), array);
+
+    array_type = build_array_type (integer_type_node,
+		       build_index_type (build_int_cst (NULL_TREE, 7)));
+    array = build_constructor_from_list (array_type, nreverse (array));
+    TREE_CONSTANT (array) = 1;
+    TREE_STATIC (array) = 1;
+
+    /* Create a static variable to hold the jump table.  */
+    var = gfc_create_var (array_type, "options");
+    TREE_CONSTANT (var) = 1;
+    TREE_STATIC (var) = 1;
+    TREE_READONLY (var) = 1;
+    DECL_INITIAL (var) = array;
+    var = gfc_build_addr_expr (build_pointer_type (integer_type_node), var);
+
+    tmp = build_call_expr (gfor_fndecl_set_options, 2,
+			   build_int_cst (integer_type_node, 8), var);
+    gfc_add_expr_to_block (&body, tmp);
+  }
+
+  /* If -ffpe-trap option was provided, add a call to set_fpe so that
+     the library will raise a FPE when needed.  */
+  if (gfc_option.fpe != 0)
+    {
+      tmp = build_call_expr (gfor_fndecl_set_fpe, 1,
+			     build_int_cst (integer_type_node,
+					    gfc_option.fpe));
+      gfc_add_expr_to_block (&body, tmp);
+    }
+
+  /* If this is the main program and an -fconvert option was provided,
+     add a call to set_convert.  */
+
+  if (gfc_option.convert != GFC_CONVERT_NATIVE)
+    {
+      tmp = build_call_expr (gfor_fndecl_set_convert, 1,
+			     build_int_cst (integer_type_node,
+					    gfc_option.convert));
+      gfc_add_expr_to_block (&body, tmp);
+    }
+
+  /* If this is the main program and an -frecord-marker option was provided,
+     add a call to set_record_marker.  */
+
+  if (gfc_option.record_marker != 0)
+    {
+      tmp = build_call_expr (gfor_fndecl_set_record_marker, 1,
+			     build_int_cst (integer_type_node,
+					    gfc_option.record_marker));
+      gfc_add_expr_to_block (&body, tmp);
+    }
+
+  if (gfc_option.max_subrecord_length != 0)
+    {
+      tmp = build_call_expr (gfor_fndecl_set_max_subrecord_length, 1,
+			     build_int_cst (integer_type_node,
+					    gfc_option.max_subrecord_length));
+      gfc_add_expr_to_block (&body, tmp);
+    }
+
+  /* Call MAIN__().  */
+  tmp = build_call_expr (fndecl, 0);
+  gfc_add_expr_to_block (&body, tmp);
+
+  /* "return 0".  */
+  tmp = fold_build2 (MODIFY_EXPR, integer_type_node, DECL_RESULT (ftn_main),
+		     build_int_cst (integer_type_node, 0));
+  tmp = build1_v (RETURN_EXPR, tmp);
+  gfc_add_expr_to_block (&body, tmp);
+
+
+  DECL_SAVED_TREE (ftn_main) = gfc_finish_block (&body);
+  decl = getdecls ();
+
+  /* Finish off this function and send it for code generation.  */
+  poplevel (1, 0, 1);
+  BLOCK_SUPERCONTEXT (DECL_INITIAL (ftn_main)) = ftn_main;
+
+  DECL_SAVED_TREE (ftn_main)
+    = build3_v (BIND_EXPR, decl, DECL_SAVED_TREE (ftn_main),
+		DECL_INITIAL (ftn_main));
+
+  /* Output the GENERIC tree.  */
+  dump_function (TDI_original, ftn_main);
+
+  gfc_gimplify_function (ftn_main);
+  cgraph_finalize_function (ftn_main, false);
+}
+
+
 /* Generate code for a function.  */
 
 void
@@ -3919,107 +4110,6 @@ gfc_generate_function_code (gfc_namespace * ns)
   /* Now generate the code for the body of this function.  */
   gfc_init_block (&body);
 
-  /* If this is the main program, add a call to set_options to set up the
-     runtime library Fortran language standard parameters.  */
-  if (sym->attr.is_main_program)
-    {
-      tree array_type, array, var;
-
-      /* Passing a new option to the library requires four modifications:
-	   + add it to the tree_cons list below
-	   + change the array size in the call to build_array_type
-	   + change the first argument to the library call
-	     gfor_fndecl_set_options
-	   + modify the library (runtime/compile_options.c)!  */
-      array = tree_cons (NULL_TREE,
-			 build_int_cst (integer_type_node,
-					gfc_option.warn_std), NULL_TREE);
-      array = tree_cons (NULL_TREE,
-			 build_int_cst (integer_type_node,
-					gfc_option.allow_std), array);
-      array = tree_cons (NULL_TREE,
-			 build_int_cst (integer_type_node, pedantic), array);
-      array = tree_cons (NULL_TREE,
-			 build_int_cst (integer_type_node,
-					gfc_option.flag_dump_core), array);
-      array = tree_cons (NULL_TREE,
-			 build_int_cst (integer_type_node,
-					gfc_option.flag_backtrace), array);
-      array = tree_cons (NULL_TREE,
-			 build_int_cst (integer_type_node,
-					gfc_option.flag_sign_zero), array);
-
-      array = tree_cons (NULL_TREE,
-			 build_int_cst (integer_type_node,
-					(gfc_option.rtcheck
-					 & GFC_RTCHECK_BOUNDS)), array);
-
-      array = tree_cons (NULL_TREE,
-			 build_int_cst (integer_type_node,
-					gfc_option.flag_range_check), array);
-
-      array_type = build_array_type (integer_type_node,
-				     build_index_type (build_int_cst (NULL_TREE,
-								      7)));
-      array = build_constructor_from_list (array_type, nreverse (array));
-      TREE_CONSTANT (array) = 1;
-      TREE_STATIC (array) = 1;
-
-      /* Create a static variable to hold the jump table.  */
-      var = gfc_create_var (array_type, "options");
-      TREE_CONSTANT (var) = 1;
-      TREE_STATIC (var) = 1;
-      TREE_READONLY (var) = 1;
-      DECL_INITIAL (var) = array;
-      var = gfc_build_addr_expr (pvoid_type_node, var);
-
-      tmp = build_call_expr (gfor_fndecl_set_options, 2,
-			     build_int_cst (integer_type_node, 8), var);
-      gfc_add_expr_to_block (&body, tmp);
-    }
-
-  /* If this is the main program and a -ffpe-trap option was provided,
-     add a call to set_fpe so that the library will raise a FPE when
-     needed.  */
-  if (sym->attr.is_main_program && gfc_option.fpe != 0)
-    {
-      tmp = build_call_expr (gfor_fndecl_set_fpe, 1,
-			     build_int_cst (integer_type_node,
-					    gfc_option.fpe));
-      gfc_add_expr_to_block (&body, tmp);
-    }
-
-  /* If this is the main program and an -fconvert option was provided,
-     add a call to set_convert.  */
-
-  if (sym->attr.is_main_program && gfc_option.convert != GFC_CONVERT_NATIVE)
-    {
-      tmp = build_call_expr (gfor_fndecl_set_convert, 1,
-			     build_int_cst (integer_type_node,
-					    gfc_option.convert));
-      gfc_add_expr_to_block (&body, tmp);
-    }
-
-  /* If this is the main program and an -frecord-marker option was provided,
-     add a call to set_record_marker.  */
-
-  if (sym->attr.is_main_program && gfc_option.record_marker != 0)
-    {
-      tmp = build_call_expr (gfor_fndecl_set_record_marker, 1,
-			     build_int_cst (integer_type_node,
-					    gfc_option.record_marker));
-      gfc_add_expr_to_block (&body, tmp);
-    }
-
-  if (sym->attr.is_main_program && gfc_option.max_subrecord_length != 0)
-    {
-      tmp = build_call_expr (gfor_fndecl_set_max_subrecord_length,
-			     1,
-			     build_int_cst (integer_type_node,
-					    gfc_option.max_subrecord_length));
-      gfc_add_expr_to_block (&body, tmp);
-    }
-
    is_recursive = sym->attr.recursive
 		  || (sym->attr.entry_master
 		      && sym->ns->entries->sym->attr.recursive);
@@ -4203,8 +4293,12 @@ gfc_generate_function_code (gfc_namespace * ns)
 
   gfc_trans_use_stmts (ns);
   gfc_traverse_ns (ns, gfc_emit_parameter_debug_info);
+
+  if (sym->attr.is_main_program)
+    create_main_function (fndecl);
 }
 
+
 void
 gfc_generate_constructors (void)
 {
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index e9acb8b5c89..e6516066b8f 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,12 @@
+2009-05-26  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/39178
+	* runtime/main.c (store_exe_path): Make static
+	and multiple-times callable.
+	(set_args): Call store_exe_path.
+	* libgfortran.h: Remove store_exe_path prototype.
+	* fmain.c (main): Remove store_exe_path call.
+
 2009-05-19  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR libfortran/37754
diff --git a/libgfortran/fmain.c b/libgfortran/fmain.c
index 1d6b45e111d..2e8ed885778 100644
--- a/libgfortran/fmain.c
+++ b/libgfortran/fmain.c
@@ -9,12 +9,8 @@ void MAIN__ (void);
 int
 main (int argc, char *argv[])
 {
-  /* Store the path of the executable file.  */
-  store_exe_path (argv[0]);
-
   /* Set up the runtime environment.  */
-  set_args (argc, argv);
-
+  PREFIX(set_args) (argc, argv);
 
   /* Call the Fortran main program.  Internally this is a function
      called MAIN__ */
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index 3591fa9c279..85b454d1c32 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -610,9 +610,6 @@ export_proto(set_args);
 extern void get_args (int *, char ***);
 internal_proto(get_args);
 
-extern void store_exe_path (const char *);
-export_proto(store_exe_path);
-
 extern char * full_exe_path (void);
 internal_proto(full_exe_path);
 
diff --git a/libgfortran/runtime/main.c b/libgfortran/runtime/main.c
index 3cccc3d0304..6df2775d26e 100644
--- a/libgfortran/runtime/main.c
+++ b/libgfortran/runtime/main.c
@@ -69,31 +69,12 @@ determine_endianness (void)
 static int argc_save;
 static char **argv_save;
 
-/* Set the saved values of the command line arguments.  */
-
-void
-set_args (int argc, char **argv)
-{
-  argc_save = argc;
-  argv_save = argv;
-}
-
-/* Retrieve the saved values of the command line arguments.  */
-
-void
-get_args (int *argc, char ***argv)
-{
-  *argc = argc_save;
-  *argv = argv_save;
-}
-
-
 static const char *exe_path;
 static int please_free_exe_path_when_done;
 
 /* Save the path under which the program was called, for use in the
    backtrace routines.  */
-void
+static void
 store_exe_path (const char * argv0)
 {
 #ifndef PATH_MAX
@@ -106,6 +87,10 @@ store_exe_path (const char * argv0)
 
   char buf[PATH_MAX], *cwd, *path;
 
+  /* This can only happen if store_exe_path is called multiple times.  */
+  if (please_free_exe_path_when_done)
+    free ((char *) exe_path);
+
   /* On the simulator argv is not set.  */
   if (argv0 == NULL || argv0[0] == '/')
     {
@@ -128,6 +113,7 @@ store_exe_path (const char * argv0)
   please_free_exe_path_when_done = 1;
 }
 
+
 /* Return the full path of the executable.  */
 char *
 full_exe_path (void)
@@ -135,6 +121,28 @@ full_exe_path (void)
   return (char *) exe_path;
 }
 
+
+/* Set the saved values of the command line arguments.  */
+
+void
+set_args (int argc, char **argv)
+{
+  argc_save = argc;
+  argv_save = argv;
+  store_exe_path (argv[0]);
+}
+
+
+/* Retrieve the saved values of the command line arguments.  */
+
+void
+get_args (int *argc, char ***argv)
+{
+  *argc = argc_save;
+  *argv = argv_save;
+}
+
+
 /* Initialize the runtime library.  */
 
 static void __attribute__((constructor))