OSDN Git Service

fortran/
[pf3gnuchains/gcc-fork.git] / gcc / fortran / trans-decl.c
index 8cb308d..08dd72a 100644 (file)
@@ -1,5 +1,5 @@
 /* Backend function setup
-   Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
+   Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
    Contributed by Paul Brook
 
 This file is part of GCC.
@@ -148,9 +148,9 @@ gfc_add_decl_to_function (tree decl)
 }
 
 
-/* Build a  backend label declaration.
-   Set TREE_USED for named lables.  For artificial labels it's up to the
-   caller to mark the label as used.  */
+/* Build a  backend label declaration.  Set TREE_USED for named labels.
+   The context of the label is always the current_function_decl.  All
+   labels are marked artificial.  */
 
 tree
 gfc_build_label_decl (tree label_id)
@@ -174,19 +174,13 @@ gfc_build_label_decl (tree label_id)
   DECL_CONTEXT (label_decl) = current_function_decl;
   DECL_MODE (label_decl) = VOIDmode;
 
-  if (label_name)
-    {
-      DECL_ARTIFICIAL (label_decl) = 1;
-    }
-  else
-    {
-      /* We always define the label as used, even if the original source
-         file never references the label.  We don't want all kinds of
-         spurious warnings for old-style Fortran code with too many
-         labels.  */
-      TREE_USED (label_decl) = 1;
-    }
+  /* We always define the label as used, even if the original source
+     file never references the label.  We don't want all kinds of
+     spurious warnings for old-style Fortran code with too many
+     labels.  */
+  TREE_USED (label_decl) = 1;
 
+  DECL_ARTIFICIAL (label_decl) = 1;
   return label_decl;
 }
 
@@ -278,7 +272,7 @@ gfc_sym_mangled_identifier (gfc_symbol * sym)
 {
   char name[GFC_MAX_MANGLED_SYMBOL_LEN + 1];
 
-  if (sym->module[0] == 0)
+  if (sym->module == NULL)
     return gfc_sym_identifier (sym);
   else
     {
@@ -296,8 +290,8 @@ gfc_sym_mangled_function_id (gfc_symbol * sym)
   int has_underscore;
   char name[GFC_MAX_MANGLED_SYMBOL_LEN + 1];
 
-  if (sym->module[0] == 0 || sym->attr.proc == PROC_EXTERNAL
-      || (sym->module[0] != 0 && sym->attr.if_source == IFSRC_IFBODY))
+  if (sym->module == NULL || sym->attr.proc == PROC_EXTERNAL
+      || (sym->module != NULL && sym->attr.if_source == IFSRC_IFBODY))
     {
       if (strcmp (sym->name, "MAIN__") == 0
          || sym->attr.proc == PROC_INTRINSIC)
@@ -323,6 +317,32 @@ gfc_sym_mangled_function_id (gfc_symbol * sym)
 }
 
 
+/* Returns true if a variable of specified size should go on the stack.  */
+
+int
+gfc_can_put_var_on_stack (tree size)
+{
+  unsigned HOST_WIDE_INT low;
+
+  if (!INTEGER_CST_P (size))
+    return 0;
+
+  if (gfc_option.flag_max_stack_var_size < 0)
+    return 1;
+
+  if (TREE_INT_CST_HIGH (size) != 0)
+    return 0;
+
+  low = TREE_INT_CST_LOW (size);
+  if (low > (unsigned HOST_WIDE_INT) gfc_option.flag_max_stack_var_size)
+    return 0;
+
+/* TODO: Set a per-function stack size limit.  */
+
+  return 1;
+}
+
+
 /* Finish processing of a declaration and install its initial value.  */
 
 static void
@@ -410,9 +430,9 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
       DECL_EXTERNAL (decl) = 1;
       TREE_PUBLIC (decl) = 1;
     }
-  else if (sym->module[0] && !sym->attr.result)
+  else if (sym->module && !sym->attr.result && !sym->attr.dummy)
     {
-      /* TODO: Don't set sym->module for result variables.  */
+      /* TODO: Don't set sym->module for result or dummy variables.  */
       gcc_assert (current_function_decl == NULL_TREE);
       /* This is the declaration of a module variable.  */
       TREE_PUBLIC (decl) = 1;
@@ -539,7 +559,7 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
 
 
 /* For some dummy arguments we don't use the actual argument directly.
-   Instead we create a local decl and use that.  This allows us to preform
+   Instead we create a local decl and use that.  This allows us to perform
    initialization, and construct full type information.  */
 
 static tree
@@ -772,7 +792,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
   /* 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[0])
+  if (sym->module)
     SET_DECL_ASSEMBLER_NAME (decl, gfc_sym_mangled_identifier (sym));
 
   if (sym->attr.dimension)
@@ -814,7 +834,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
        {
          char name[GFC_MAX_MANGLED_SYMBOL_LEN + 2];
 
-         if (sym->module[0])
+         if (sym->module)
            {
              /* Also prefix the mangled name for symbols from modules.  */
              strcpy (&name[1], sym->name);
@@ -1135,6 +1155,7 @@ create_function_arglist (gfc_symbol * sym)
       DECL_CONTEXT (parm) = fndecl;
       DECL_ARG_TYPE (parm) = type;
       TREE_READONLY (parm) = 1;
+      DECL_ARTIFICIAL (parm) = 1;
       gfc_finish_decl (parm, NULL_TREE);
 
       arglist = chainon (arglist, parm);
@@ -1162,6 +1183,7 @@ create_function_arglist (gfc_symbol * sym)
          DECL_CONTEXT (length) = fndecl;
          DECL_ARG_TYPE (length) = type;
          TREE_READONLY (length) = 1;
+         DECL_ARTIFICIAL (length) = 1;
          gfc_finish_decl (length, NULL_TREE);
        }
     }
@@ -1216,6 +1238,7 @@ create_function_arglist (gfc_symbol * sym)
 
       arglist = chainon (arglist, length);
       DECL_CONTEXT (length) = fndecl;
+      DECL_ARTIFICIAL (length) = 1;
       DECL_ARG_TYPE (length) = type;
       TREE_READONLY (length) = 1;
       gfc_finish_decl (length, NULL_TREE);
@@ -1255,22 +1278,6 @@ create_function_arglist (gfc_symbol * sym)
   DECL_ARGUMENTS (fndecl) = arglist;
 }
 
-
-/* Finalize DECL and all nested functions with cgraph.  */
-
-static void
-gfc_finalize (tree decl)
-{
-  struct cgraph_node *cgn;
-
-  cgn = cgraph_node (decl);
-  for (cgn = cgn->nested; cgn ; cgn = cgn->next_nested)
-    gfc_finalize (cgn->decl);
-
-  cgraph_finalize_function (decl, false);
-}
-
-
 /* Convert FNDECL's code to GIMPLE and handle any nested functions.  */
 
 static void
@@ -1431,8 +1438,7 @@ build_entry_thunks (gfc_namespace * ns)
       current_function_decl = NULL_TREE;
 
       gfc_gimplify_function (thunk_fndecl);
-      lower_nested_functions (thunk_fndecl);
-      gfc_finalize (thunk_fndecl);
+      cgraph_finalize_function (thunk_fndecl, false);
 
       /* We share the symbols in the formal argument list with other entry
         points and the master function.  Clear them so that they are
@@ -2012,7 +2018,7 @@ gfc_create_module_variable (gfc_symbol * sym)
       internal_error ("module symbol %s in wrong namespace", sym->name);
     }
 
-  /* Only output variables and array valued parametes.  */
+  /* Only output variables and array valued parameters.  */
   if (sym->attr.flavor != FL_VARIABLE
       && (sym->attr.flavor != FL_PARAMETER || sym->attr.dimension == 0))
     return;
@@ -2104,16 +2110,13 @@ generate_local_decl (gfc_symbol * sym)
     {
       if (sym->attr.referenced)
         gfc_get_symbol_decl (sym);
-      else if (sym->attr.dummy)
-        {
-          if (warn_unused_parameter)
-            warning ("unused parameter `%s'", sym->name);
-        }
+      else if (sym->attr.dummy && warn_unused_parameter)
+            warning ("unused parameter %qs", sym->name);
       /* Warn for unused variables, but not if they're inside a common
-        block or are use_associated.  */
+        block or are use-associated.  */
       else if (warn_unused_variable
               && !(sym->attr.in_common || sym->attr.use_assoc))
-       warning ("unused variable `%s'", sym->name); 
+       warning ("unused variable %qs", sym->name); 
     }
 }
 
@@ -2139,16 +2142,13 @@ gfc_trans_entry_master_switch (gfc_entry_list * el)
   for (; el; el = el->next)
     {
       /* Add the case label.  */
-      label = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE);
-      DECL_CONTEXT (label) = current_function_decl;
+      label = gfc_build_label_decl (NULL_TREE);
       val = build_int_cst (gfc_array_index_type, el->id);
       tmp = build3_v (CASE_LABEL_EXPR, val, NULL_TREE, label);
       gfc_add_expr_to_block (&block, tmp);
       
       /* And jump to the actual entry point.  */
       label = gfc_build_label_decl (NULL_TREE);
-      TREE_USED (label) = 1;
-      DECL_CONTEXT (label) = current_function_decl;
       tmp = build1_v (GOTO_EXPR, label);
       gfc_add_expr_to_block (&block, tmp);
 
@@ -2248,7 +2248,7 @@ gfc_generate_function_code (gfc_namespace * ns)
 
   if (TREE_TYPE (DECL_RESULT (fndecl)) != void_type_node)
     {
-      if (sym->attr.subroutine ||sym == sym->result)
+      if (sym->attr.subroutine || sym == sym->result)
        {
          result = current_fake_result_decl;
          current_fake_result_decl = NULL_TREE;
@@ -2313,8 +2313,7 @@ gfc_generate_function_code (gfc_namespace * ns)
   else
     {
       gfc_gimplify_function (fndecl);
-      lower_nested_functions (fndecl);
-      gfc_finalize (fndecl);
+      cgraph_finalize_function (fndecl, false);
     }
 }
 
@@ -2371,7 +2370,7 @@ gfc_generate_constructors (void)
   free_after_parsing (cfun);
   free_after_compilation (cfun);
 
-  tree_rest_of_compilation (fndecl, 0);
+  tree_rest_of_compilation (fndecl);
 
   current_function_decl = NULL_TREE;
 #endif