* c-common.c, c-parser.c, cfgbuild.c, cfghooks.c, cfghooks.h,

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

diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 727a7d7..70630cb 100644 (file)
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -1,5 +1,5 @@
 /* Code translation -- generate GCC trees from gfc_code.
-   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.
@@ -24,13 +24,10 @@ Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 #include "coretypes.h"
 #include "tree.h"
 #include "tree-gimple.h"
-#include <stdio.h>
 #include "ggc.h"
 #include "toplev.h"
 #include "defaults.h"
 #include "real.h"
-#include <gmp.h>
-#include <assert.h>
 #include "gfortran.h"
 #include "trans.h"
 #include "trans-stmt.h"
@@ -56,7 +53,7 @@ gfc_advance_chain (tree t, int n)
 {
   for (; n > 0; n--)
     {
-      assert (t != NULL_TREE);
+      gcc_assert (t != NULL_TREE);
       t = TREE_CHAIN (t);
     }
   return t;
@@ -128,7 +125,7 @@ gfc_evaluate_now (tree expr, stmtblock_t * pblock)
 {
   tree var;
 
-  if (TREE_CODE_CLASS (TREE_CODE (expr)) == 'c')
+  if (CONSTANT_CLASS_P (expr))
     return expr;
 
   var = gfc_create_var (TREE_TYPE (expr), NULL);
@@ -151,18 +148,17 @@ gfc_add_modify_expr (stmtblock_t * pblock, tree lhs, tree rhs)
      for scalar assignments.  We should probably have something
      similar for aggregates, but right now removing that check just
      breaks everything.  */
-  if (TREE_TYPE (rhs) != TREE_TYPE (lhs)
-      && !AGGREGATE_TYPE_P (TREE_TYPE (lhs)))
-    abort ();
+  gcc_assert (TREE_TYPE (rhs) == TREE_TYPE (lhs)
+             || AGGREGATE_TYPE_P (TREE_TYPE (lhs)));
 #endif
 
-  tmp = fold (build2_v (MODIFY_EXPR, lhs, rhs));
+  tmp = fold_build2 (MODIFY_EXPR, void_type_node, lhs, rhs);
   gfc_add_expr_to_block (pblock, tmp);
 }
 
 
 /* Create a new scope/binding level and initialize a block.  Care must be
-   taken when translating expessions as any temporaries will be placed in
+   taken when translating expressions as any temporaries will be placed in
    the innermost scope.  */
 
 void
@@ -197,7 +193,7 @@ gfc_merge_block_scope (stmtblock_t * block)
   tree decl;
   tree next;
 
-  assert (block->has_scope);
+  gcc_assert (block->has_scope);
   block->has_scope = 0;
 
   /* Remember the decls in this scope.  */
@@ -292,8 +288,7 @@ tree
 gfc_build_indirect_ref (tree t)
 {
   tree type = TREE_TYPE (t);
-  if (!POINTER_TYPE_P (type))
-    abort ();
+  gcc_assert (POINTER_TYPE_P (type));
   type = TREE_TYPE (type);
 
   if (TREE_CODE (t) == ADDR_EXPR)
@@ -309,8 +304,7 @@ tree
 gfc_build_array_ref (tree base, tree offset)
 {
   tree type = TREE_TYPE (base);
-  if (TREE_CODE (type) != ARRAY_TYPE)
-    abort ();
+  gcc_assert (TREE_CODE (type) == ARRAY_TYPE);
   type = TREE_TYPE (type);
 
   if (DECL_P (base))
@@ -356,7 +350,7 @@ gfc_trans_runtime_check (tree cond, tree msg, stmtblock_t * pblock)
   /* The code to generate the error.  */
   gfc_start_block (&block);
 
-  assert (TREE_CODE (msg) == STRING_CST);
+  gcc_assert (TREE_CODE (msg) == STRING_CST);
 
   TREE_USED (msg) = 1;
 
@@ -396,7 +390,7 @@ gfc_trans_runtime_check (tree cond, tree msg, stmtblock_t * pblock)
 void
 gfc_add_expr_to_block (stmtblock_t * block, tree expr)
 {
-  assert (block);
+  gcc_assert (block);
 
   if (expr == NULL_TREE || IS_EMPTY_STMT (expr))
     return;
@@ -427,8 +421,8 @@ gfc_add_expr_to_block (stmtblock_t * block, tree expr)
 void
 gfc_add_block_to_block (stmtblock_t * block, stmtblock_t * append)
 {
-  assert (append);
-  assert (!append->has_scope);
+  gcc_assert (append);
+  gcc_assert (!append->has_scope);
 
   gfc_add_expr_to_block (block, append->head);
   append->head = NULL_TREE;
@@ -442,7 +436,11 @@ void
 gfc_get_backend_locus (locus * loc)
 {
   loc->lb = gfc_getmem (sizeof (gfc_linebuf));    
+#ifdef USE_MAPPED_LOCATION
+  loc->lb->location = input_location; /* FIXME adjust?? */
+#else
   loc->lb->linenum = input_line - 1;
+#endif
   loc->lb->file = gfc_current_backend_file;
 }
 
@@ -452,9 +450,13 @@ gfc_get_backend_locus (locus * loc)
 void
 gfc_set_backend_locus (locus * loc)
 {
-  input_line = loc->lb->linenum;
   gfc_current_backend_file = loc->lb->file;
+#ifdef USE_MAPPED_LOCATION
+  input_location = loc->lb->location;
+#else
+  input_line = loc->lb->linenum;
   input_filename = loc->lb->file->filename;
+#endif
 }
 
 
@@ -475,8 +477,6 @@ gfc_trans_code (gfc_code * code)
      the end of this gfc_code branch.  */
   for (; code; code = code->next)
     {
-      gfc_set_backend_locus (&code->loc);
-
       if (code->here != 0)
        {
          res = gfc_trans_label_here (code);
@@ -621,14 +621,16 @@ gfc_trans_code (gfc_code * code)
          internal_error ("gfc_trans_code(): Bad statement code");
        }
 
+      gfc_set_backend_locus (&code->loc);
+
       if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
        {
          if (TREE_CODE (res) == STATEMENT_LIST)
            annotate_all_with_locus (&res, input_location);
          else
-           annotate_with_locus (res, input_location);
-
-         /* Add the new statemment to the block.  */
+           SET_EXPR_LOCATION (res, input_location);
+           
+         /* Add the new statement to the block.  */
          gfc_add_expr_to_block (&block, res);
        }
     }
@@ -665,6 +667,9 @@ gfc_generate_code (gfc_namespace * ns)
       attr.subroutine = 1;
       attr.access = ACCESS_PUBLIC;
       main_program->attr = attr;
+      /* Set the location to the first line of code.  */
+      if (ns->code)
+       main_program->declared_at = ns->code->loc;
       ns->proc_name = main_program;
       gfc_commit_symbols ();
     }