OSDN Git Service

* Makefile.in (CFLAGS-collect2.o, CFLAGS-c-family/c-opts.o)
[pf3gnuchains/gcc-fork.git] / gcc / fortran / f95-lang.c
index a3ac860..648831f 100644 (file)
@@ -59,7 +59,7 @@ lang_identifier {
 /* The resulting tree type.  */
 
 union GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"),
-     chain_next ("(union lang_tree_node *)TREE_CHAIN (&%h.generic)")))
+     chain_next ("CODE_CONTAINS_STRUCT (TREE_CODE (&%h.generic), TS_COMMON) ? ((union lang_tree_node *) TREE_CHAIN (&%h.generic)) : NULL")))
 
 lang_tree_node {
   union tree_node GTY((tag ("0"),
@@ -91,7 +91,7 @@ static void gfc_finish (void);
 static void gfc_write_global_declarations (void);
 static void gfc_print_identifier (FILE *, tree, int);
 void do_function_end (void);
-int global_bindings_p (void);
+bool global_bindings_p (void);
 static void clear_binding_stack (void);
 static void gfc_be_parse_file (void);
 static alias_set_type gfc_get_alias_set (tree);
@@ -373,12 +373,12 @@ static GTY(()) struct binding_level *global_binding_level;
 static struct binding_level clear_binding_level = { NULL, NULL, NULL };
 
 
-/* Return nonzero if we are currently in the global binding level.  */
+/* Return true if we are in the global binding level.  */
 
-int
+bool
 global_bindings_p (void)
 {
-  return current_binding_level == global_binding_level ? -1 : 0;
+  return current_binding_level == global_binding_level;
 }
 
 tree
@@ -444,7 +444,7 @@ poplevel (int keep, int reverse, int functionbody)
 
   /* Record the BLOCK node just built as the subblock its enclosing scope.  */
   for (subblock_node = subblock_chain; subblock_node;
-       subblock_node = TREE_CHAIN (subblock_node))
+       subblock_node = BLOCK_CHAIN (subblock_node))
     BLOCK_SUPERCONTEXT (subblock_node) = block_node;
 
   /* Clear out the meanings of the local variables of this level.  */
@@ -475,7 +475,7 @@ poplevel (int keep, int reverse, int functionbody)
   else if (block_node)
     {
       current_binding_level->blocks
-       = chainon (current_binding_level->blocks, block_node);
+       = block_chainon (current_binding_level->blocks, block_node);
     }
 
   /* If we did not make a block for the level just exited, any blocks made for
@@ -484,7 +484,7 @@ poplevel (int keep, int reverse, int functionbody)
      else.  */
   else if (subblock_chain)
     current_binding_level->blocks
-      = chainon (current_binding_level->blocks, subblock_chain);
+      = block_chainon (current_binding_level->blocks, subblock_chain);
   if (block_node)
     TREE_USED (block_node) = 1;
 
@@ -498,13 +498,20 @@ poplevel (int keep, int reverse, int functionbody)
 tree
 pushdecl (tree decl)
 {
-  /* External objects aren't nested, other objects may be.  */
-  if (DECL_EXTERNAL (decl))
-    DECL_CONTEXT (decl) = NULL_TREE;
-  else if (global_bindings_p ())
+  if (global_bindings_p ())
     DECL_CONTEXT (decl) = current_translation_unit;
   else
-    DECL_CONTEXT (decl) = current_function_decl;
+    {
+      /* External objects aren't nested.  For debug info insert a copy
+         of the decl into the binding level.  */
+      if (DECL_EXTERNAL (decl))
+       {
+         tree orig = decl;
+         decl = copy_node (decl);
+         DECL_CONTEXT (orig) = NULL_TREE;
+       }
+      DECL_CONTEXT (decl) = current_function_decl;
+    }
 
   /* Put the declaration on the list.  The list of declarations is in reverse
      order. The list will be reversed later if necessary.  This needs to be
@@ -581,12 +588,8 @@ gfc_init_decl_processing (void)
   /* Build common tree nodes. char_type_node is unsigned because we
      only use it for actual characters, not for INTEGER(1). Also, we
      want double_type_node to actually have double precision.  */
-  build_common_tree_nodes (false);
-
-  size_type_node = gfc_build_uint_type (POINTER_SIZE);
-  set_sizetype (size_type_node);
+  build_common_tree_nodes (false, false);
 
-  build_common_tree_nodes_2 (0);
   void_list_node = build_tree_list (NULL_TREE, void_type_node);
 
   /* Set up F95 type nodes.  */
@@ -688,10 +691,9 @@ build_builtin_fntypes (tree *fntype, tree type)
                                         type, integer_type_node, NULL_TREE);
   /* type (*) (void) */
   fntype[3] = build_function_type_list (type, NULL_TREE);
-  /* type (*) (&int, type) */
-  fntype[4] = build_function_type_list (type,
+  /* type (*) (type, &int) */
+  fntype[4] = build_function_type_list (type, type,
                                         build_pointer_type (integer_type_node),
-                                        type,
                                         NULL_TREE);
   /* type (*) (int, type) */
   fntype[5] = build_function_type_list (type,