/* Code translation -- generate GCC trees from gfc_code.
- Copyright (C) 2002, 2003 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
Contributed by Paul Brook
-This file is part of GNU G95.
+This file is part of GCC.
-GNU G95 is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 2, or (at your option) any later
+version.
-GNU G95 is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
You should have received a copy of the GNU General Public License
-along with GNU G95; see the file COPYING. If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
+along with GCC; see the file COPYING. If not, write to the Free
+Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
+02110-1301, USA. */
#include "config.h"
#include "system.h"
#include "coretypes.h"
#include "tree.h"
-#include "tree-simple.h"
-#include <stdio.h>
+#include "tree-gimple.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"
{
for (; n > 0; n--)
{
- assert (t != NULL_TREE);
+ gcc_assert (t != NULL_TREE);
t = TREE_CHAIN (t);
}
return t;
{
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);
{
tree tmp;
- tmp = fold (build_v (MODIFY_EXPR, lhs, rhs));
+#ifdef ENABLE_CHECKING
+ /* Make sure that the types of the rhs and the lhs are the same
+ for scalar assignments. We should probably have something
+ similar for aggregates, but right now removing that check just
+ breaks everything. */
+ gcc_assert (TREE_TYPE (rhs) == TREE_TYPE (lhs)
+ || AGGREGATE_TYPE_P (TREE_TYPE (lhs)));
+#endif
+
+ 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
tree decl;
tree next;
- assert (block->has_scope);
+ gcc_assert (block->has_scope);
block->has_scope = 0;
/* Remember the decls in this scope. */
tree expr;
tree block;
- expr = rationalize_compound_expr (stmtblock->head);
+ expr = stmtblock->head;
+ if (!expr)
+ expr = build_empty_stmt ();
+
stmtblock->head = NULL_TREE;
if (stmtblock->has_scope)
if (decl)
{
block = poplevel (1, 0, 0);
- expr = build_v (BIND_EXPR, decl, expr, block);
+ expr = build3_v (BIND_EXPR, decl, expr, block);
}
else
poplevel (0, 0, 0);
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)
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))
TREE_ADDRESSABLE (base) = 1;
- return build (ARRAY_REF, type, base, offset);
+ return build4 (ARRAY_REF, type, base, offset, NULL_TREE, NULL_TREE);
}
-/* Given a funcion declaration FNDECL and an argument list ARGLIST,
+/* Given a function declaration FNDECL and an argument list ARGLIST,
build a CALL_EXPR. */
tree
tree call;
fn = gfc_build_addr_expr (NULL, fndecl);
- call = build (CALL_EXPR, TREE_TYPE (TREE_TYPE (fndecl)), fn, arglist, NULL);
+ call = build3 (CALL_EXPR, TREE_TYPE (TREE_TYPE (fndecl)),
+ fn, arglist, NULL);
TREE_SIDE_EFFECTS (call) = 1;
return call;
/* 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;
tmp = gfc_build_addr_expr (pchar_type_node, gfc_strconst_current_filename);
args = gfc_chainon_list (args, tmp);
- tmp = build_int_2 (input_line, 0);
+ tmp = build_int_cst (NULL_TREE, input_line);
args = gfc_chainon_list (args, tmp);
tmp = gfc_build_function_call (gfor_fndecl_runtime_error, args);
}
else
{
- /* Tell the compiler that this isn't likley. */
+ /* Tell the compiler that this isn't likely. */
tmp = gfc_chainon_list (NULL_TREE, cond);
tmp = gfc_chainon_list (tmp, integer_zero_node);
cond = gfc_build_function_call (built_in_decls[BUILT_IN_EXPECT], tmp);
- tmp = build_v (COND_EXPR, cond, body, build_empty_stmt ());
+ tmp = build3_v (COND_EXPR, cond, body, build_empty_stmt ());
gfc_add_expr_to_block (pblock, tmp);
}
}
-/* Add a statement to a bock. */
+/* Add a statement to a block. */
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;
- expr = fold (expr);
+ if (TREE_CODE (expr) != STATEMENT_LIST)
+ expr = fold (expr);
+
if (block->head)
- block->head = build_v (COMPOUND_EXPR, block->head, expr);
+ {
+ if (TREE_CODE (block->head) != STATEMENT_LIST)
+ {
+ tree tmp;
+
+ tmp = block->head;
+ block->head = NULL_TREE;
+ append_to_statement_list (tmp, &block->head);
+ }
+ append_to_statement_list (expr, &block->head);
+ }
else
+ /* Don't bother creating a list if we only have a single statement. */
block->head = 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;
/* Get the current locus. The structure may not be complete, and should
- only be used with gfc_set_current_locus. */
+ only be used with gfc_set_backend_locus. */
void
gfc_get_backend_locus (locus * loc)
{
- loc->line = input_line - 1;
- loc->file = gfc_current_backend_file;
+ loc->lb = gfc_getmem (sizeof (gfc_linebuf));
+#ifdef USE_MAPPED_LOCATION
+ loc->lb->location = input_location;
+#else
+ loc->lb->linenum = input_line;
+#endif
+ loc->lb->file = gfc_current_backend_file;
}
void
gfc_set_backend_locus (locus * loc)
{
- input_line = loc->line + 1;
- gfc_current_backend_file = loc->file;
- input_filename = loc->file->filename;
+ 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
}
gfc_start_block (&block);
- /* Translate statements one by one to SIMPLE trees until we reach
+ /* Translate statements one by one to GIMPLE trees until we reach
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);
res = gfc_trans_goto (code);
break;
+ case EXEC_ENTRY:
+ res = gfc_trans_entry (code);
+ break;
+
case EXEC_PAUSE:
res = gfc_trans_pause (code);
break;
res = gfc_trans_select (code);
break;
+ case EXEC_FLUSH:
+ res = gfc_trans_flush (code);
+ break;
+
case EXEC_FORALL:
res = gfc_trans_forall (code);
break;
internal_error ("gfc_trans_code(): Bad statement code");
}
+ gfc_set_backend_locus (&code->loc);
+
if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
{
- annotate_with_locus (res, input_location);
- /* Add the new statemment to the block. */
+ if (TREE_CODE (res) == STATEMENT_LIST)
+ annotate_all_with_locus (&res, input_location);
+ else
+ SET_EXPR_LOCATION (res, input_location);
+
+ /* Add the new statement to the block. */
gfc_add_expr_to_block (&block, res);
}
}
void
gfc_generate_code (gfc_namespace * ns)
{
- gfc_symbol *main_program = NULL;
- symbol_attribute attr;
+ if (ns->is_block_data)
+ {
+ gfc_generate_block_data (ns);
+ return;
+ }
/* Main program subroutine. */
if (!ns->proc_name)
{
+ gfc_symbol *main_program;
+ symbol_attribute attr;
+
/* Lots of things get upset if a subroutine doesn't have a symbol, so we
make one now. Hopefully we've set all the required fields. */
gfc_get_symbol ("MAIN__", ns, &main_program);
attr.proc = PROC_UNKNOWN;
attr.subroutine = 1;
attr.access = ACCESS_PUBLIC;
+ attr.is_main_program = 1;
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 ();
}
if (!n->proc_name)
continue;
- gfc_build_function_decl (n->proc_name);
+ gfc_create_function_decl (n);
}
for (n = ns->contained; n; n = n->sibling)
OSDN Git Service
