X-Git-Url: http://git.sourceforge.jp/view?p=pf3gnuchains%2Fgcc-fork.git;a=blobdiff_plain;f=gcc%2Ffortran%2Ftrans.h;h=567e5a343f1b4f0f2c388c9bb0f639acbcc1cbce;hp=efd5eb9e525d1872c54a9fd3a5a87d3f08e90789;hb=aaaf75f7383104e9da85f377bf647e21f79049dd;hpb=dff2ea5fc98a56aea5ca4f6d2c6a1bc35b32dffb diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index efd5eb9e525..567e5a343f1 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -1,5 +1,5 @@ /* Header for code translation functions - Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 + Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc. Contributed by Paul Brook @@ -86,6 +86,8 @@ typedef struct gfc_se args alias. */ unsigned force_tmp:1; + unsigned want_coarray:1; + /* Scalarization parameters. */ struct gfc_se *parent; struct gfc_ss *ss; @@ -94,17 +96,25 @@ typedef struct gfc_se gfc_se; -/* Scalarization State chain. Created by walking an expression tree before - creating the scalarization loops. Then passed as part of a gfc_se structure - to translate the expression inside the loop. Note that these chains are - terminated by gfc_se_terminator, not NULL. A NULL pointer in a gfc_se - indicates to gfc_conv_* that this is a scalar expression. - Note that some member arrays correspond to scalarizer rank and others - are the variable rank. */ +/* Denotes different types of coarray. + Please keep in sync with libgfortran/caf/libcaf.h. */ +typedef enum +{ + GFC_CAF_COARRAY_STATIC, + GFC_CAF_COARRAY_ALLOC, + GFC_CAF_LOCK, + GFC_CAF_LOCK_COMP +} +gfc_coarray_type; -typedef struct gfc_ss_info + +/* The array-specific scalarization informations. The array members of + this struct are indexed by actual array index, and thus can be sparse. */ + +typedef struct gfc_array_info { - int dimen; + mpz_t *shape; + /* The ref that holds information on this section. */ gfc_ref *ref; /* The descriptor of this array. */ @@ -125,12 +135,8 @@ typedef struct gfc_ss_info tree end[GFC_MAX_DIMENSIONS]; tree stride[GFC_MAX_DIMENSIONS]; tree delta[GFC_MAX_DIMENSIONS]; - - /* Translation from loop dimensions to actual dimensions. - actual_dim = dim[loop_dim] */ - int dim[GFC_MAX_DIMENSIONS]; } -gfc_ss_info; +gfc_array_info; typedef enum { @@ -176,37 +182,59 @@ typedef enum } gfc_ss_type; -/* SS structures can only belong to a single loopinfo. They must be added - otherwise they will not get freed. */ -typedef struct gfc_ss + +typedef struct gfc_ss_info { gfc_ss_type type; gfc_expr *expr; - mpz_t *shape; tree string_length; + union { /* If type is GFC_SS_SCALAR or GFC_SS_REFERENCE. */ struct { - tree expr; + tree value; } scalar; + } + data; +} +gfc_ss_info; + +#define gfc_get_ss_info() XCNEW (gfc_ss_info) + + +/* Scalarization State chain. Created by walking an expression tree before + creating the scalarization loops. Then passed as part of a gfc_se structure + to translate the expression inside the loop. Note that these chains are + terminated by gfc_ss_terminator, not NULL. A NULL pointer in a gfc_se + indicates to gfc_conv_* that this is a scalar expression. + SS structures can only belong to a single loopinfo. They must be added + otherwise they will not get freed. */ + +typedef struct gfc_ss +{ + gfc_ss_info *info; + union + { /* GFC_SS_TEMP. */ struct { - /* The rank of the temporary. May be less than the rank of the - assigned expression. */ - int dimen; tree type; } temp; /* All other types. */ - gfc_ss_info info; + gfc_array_info info; } data; + int dimen; + /* Translation from loop dimensions to actual array dimensions. + actual_dim = dim[loop_dim] */ + int dim[GFC_MAX_DIMENSIONS]; + /* All the SS in a loop and linked through loop_chain. The SS for an expression are linked by the next pointer. */ struct gfc_ss *loop_chain; @@ -216,7 +244,7 @@ typedef struct gfc_ss loops the terms appear in. This will be 1 for the RHS expressions, 2 for the LHS expressions, and 3(=1|2) for the temporary. The bit 'where' suppresses precalculation of scalars in WHERE assignments. */ - unsigned useflags:2, where:1; + unsigned useflags:2, where:1, is_alloc_lhs:1; } gfc_ss; #define gfc_get_ss() XCNEW (gfc_ss) @@ -319,9 +347,6 @@ void gfc_conv_string_parameter (gfc_se * se); /* Compare two strings. */ tree gfc_build_compare_string (tree, tree, tree, tree, int, enum tree_code); -/* Add an item to the end of TREE_LIST. */ -tree gfc_chainon_list (tree, tree); - /* When using the gfc_conv_* make sure you understand what they do, i.e. when a POST chain may be created, and what the returned expression may be used for. Note that character strings have special handling. This @@ -348,7 +373,8 @@ tree gfc_evaluate_now (tree, stmtblock_t *); /* Find the appropriate variant of a math intrinsic. */ tree gfc_builtin_decl_for_float_kind (enum built_in_function, int); -/* Intrinsic function handling. */ +/* Intrinsic procedure handling. */ +tree gfc_conv_intrinsic_subroutine (gfc_code *); void gfc_conv_intrinsic_function (gfc_se *, gfc_expr *); /* Is the intrinsic expanded inline. */ @@ -359,8 +385,6 @@ bool gfc_inline_intrinsic_function_p (gfc_expr *); gfc_inline_intrinsic_function_p returns true. */ int gfc_is_intrinsic_libcall (gfc_expr *); -tree gfc_conv_intrinsic_move_alloc (gfc_code *); - /* Used to call ordinary functions/subroutines and procedure pointer components. */ int gfc_conv_procedure_call (gfc_se *, gfc_symbol *, gfc_actual_arglist *, @@ -396,6 +420,8 @@ void gfc_trans_vla_type_sizes (gfc_symbol *, stmtblock_t *); /* Add an expression to the end of a block. */ void gfc_add_expr_to_block (stmtblock_t *, tree); +/* Add an expression to the beginning of a block. */ +void gfc_prepend_expr_to_block (stmtblock_t *, tree); /* Add a block to the end of a block. */ void gfc_add_block_to_block (stmtblock_t *, stmtblock_t *); /* Add a MODIFY_EXPR to a block. */ @@ -444,6 +470,9 @@ void gfc_build_builtin_function_decls (void); /* Set the backend source location of a decl. */ void gfc_set_decl_location (tree, locus *); +/* Get a module symbol backend_decl if possible. */ +bool gfc_get_module_backend_decl (gfc_symbol *); + /* Return the variable decl for a symbol. */ tree gfc_get_symbol_decl (gfc_symbol *); @@ -504,6 +533,10 @@ void gfc_generate_constructors (void); /* Get the string length of an array constructor. */ bool get_array_ctor_strlen (stmtblock_t *, gfc_constructor_base, tree *); +/* Mark a condition as likely or unlikely. */ +tree gfc_likely (tree); +tree gfc_unlikely (tree); + /* Generate a runtime error call. */ tree gfc_trans_runtime_error (bool, locus*, const char*, ...); @@ -524,14 +557,16 @@ tree gfc_call_malloc (stmtblock_t *, tree, tree); /* Build a memcpy call. */ tree gfc_build_memcpy_call (tree, tree, tree); -/* Allocate memory for arrays, with optional status variable. */ -tree gfc_allocate_array_with_status (stmtblock_t*, tree, tree, tree, gfc_expr*); +/* Allocate memory for allocatable variables, with optional status variable. */ +void gfc_allocate_allocatable (stmtblock_t*, tree, tree, tree, + tree, tree, tree, gfc_expr*); /* Allocate memory, with optional status variable. */ -tree gfc_allocate_with_status (stmtblock_t *, tree, tree); +void gfc_allocate_using_malloc (stmtblock_t *, tree, tree, tree); /* Generate code to deallocate an array. */ tree gfc_deallocate_with_status (tree, tree, bool, gfc_expr*); +tree gfc_deallocate_scalar_with_status (tree, tree, bool, gfc_expr*, gfc_typespec); /* Generate code to call realloc(). */ tree gfc_call_realloc (stmtblock_t *, tree, tree); @@ -553,7 +588,7 @@ tree gfc_build_library_function_decl_with_spec (tree name, const char *spec, tree rettype, int nargs, ...); /* Process the local variable decls of a block construct. */ -void gfc_process_block_locals (gfc_namespace*, gfc_association_list*); +void gfc_process_block_locals (gfc_namespace*); /* Output initialization/clean-up code that was deferred. */ void gfc_trans_deferred_vars (gfc_symbol*, gfc_wrapped_block *); @@ -607,6 +642,23 @@ extern GTY(()) tree gfor_fndecl_in_pack; extern GTY(()) tree gfor_fndecl_in_unpack; extern GTY(()) tree gfor_fndecl_associated; + +/* Coarray run-time library function decls. */ +extern GTY(()) tree gfor_fndecl_caf_init; +extern GTY(()) tree gfor_fndecl_caf_finalize; +extern GTY(()) tree gfor_fndecl_caf_register; +extern GTY(()) tree gfor_fndecl_caf_critical; +extern GTY(()) tree gfor_fndecl_caf_end_critical; +extern GTY(()) tree gfor_fndecl_caf_sync_all; +extern GTY(()) tree gfor_fndecl_caf_sync_images; +extern GTY(()) tree gfor_fndecl_caf_error_stop; +extern GTY(()) tree gfor_fndecl_caf_error_stop_str; + +/* Coarray global variables for num_images/this_image. */ +extern GTY(()) tree gfort_gvar_caf_num_images; +extern GTY(()) tree gfort_gvar_caf_this_image; + + /* Math functions. Many other math functions are handled in trans-intrinsic.c. */ @@ -688,7 +740,7 @@ enum gfc_array_kind variable-sized in some other frontends. Due to gengtype deficiency the GTY options of such types have to agree across all frontends. */ struct GTY((variable_size)) lang_type { - int rank; + int rank, corank; enum gfc_array_kind akind; tree lbound[GFC_MAX_DIMENSIONS]; tree ubound[GFC_MAX_DIMENSIONS]; @@ -699,6 +751,9 @@ struct GTY((variable_size)) lang_type { tree dataptr_type; tree span; tree base_decl[2]; + tree nonrestricted_type; + tree caf_token; + tree caf_offset; }; struct GTY((variable_size)) lang_decl { @@ -711,12 +766,16 @@ struct GTY((variable_size)) lang_decl { tree stringlen; tree addr; tree span; + /* For assumed-shape coarrays. */ + tree token, caf_offset; }; #define GFC_DECL_ASSIGN_ADDR(node) DECL_LANG_SPECIFIC(node)->addr #define GFC_DECL_STRING_LEN(node) DECL_LANG_SPECIFIC(node)->stringlen #define GFC_DECL_SPAN(node) DECL_LANG_SPECIFIC(node)->span +#define GFC_DECL_TOKEN(node) DECL_LANG_SPECIFIC(node)->token +#define GFC_DECL_CAF_OFFSET(node) DECL_LANG_SPECIFIC(node)->caf_offset #define GFC_DECL_SAVED_DESCRIPTOR(node) \ (DECL_LANG_SPECIFIC(node)->saved_descriptor) #define GFC_DECL_PACKED_ARRAY(node) DECL_LANG_FLAG_0(node) @@ -742,6 +801,9 @@ struct GTY((variable_size)) lang_decl { #define GFC_TYPE_ARRAY_STRIDE(node, dim) \ (TYPE_LANG_SPECIFIC(node)->stride[dim]) #define GFC_TYPE_ARRAY_RANK(node) (TYPE_LANG_SPECIFIC(node)->rank) +#define GFC_TYPE_ARRAY_CORANK(node) (TYPE_LANG_SPECIFIC(node)->corank) +#define GFC_TYPE_ARRAY_CAF_TOKEN(node) (TYPE_LANG_SPECIFIC(node)->caf_token) +#define GFC_TYPE_ARRAY_CAF_OFFSET(node) (TYPE_LANG_SPECIFIC(node)->caf_offset) #define GFC_TYPE_ARRAY_SIZE(node) (TYPE_LANG_SPECIFIC(node)->size) #define GFC_TYPE_ARRAY_OFFSET(node) (TYPE_LANG_SPECIFIC(node)->offset) #define GFC_TYPE_ARRAY_AKIND(node) (TYPE_LANG_SPECIFIC(node)->akind) @@ -755,51 +817,6 @@ struct GTY((variable_size)) lang_decl { (TYPE_LANG_SPECIFIC(node)->base_decl[(internal)]) -/* Create _loc version of build[0-9]. */ - -static inline tree -build1_stat_loc (location_t loc, enum tree_code code, tree type, - tree op MEM_STAT_DECL) -{ - tree t = build1_stat (code, type, op PASS_MEM_STAT); - SET_EXPR_LOCATION (t, loc); - return t; -} -#define build1_loc(l,c,t1,t2) build1_stat_loc (l,c,t1,t2 MEM_STAT_INFO) - -static inline tree -build2_stat_loc (location_t loc, enum tree_code code, tree type, tree arg0, - tree op MEM_STAT_DECL) -{ - tree t = build2_stat (code, type, arg0, op PASS_MEM_STAT); - SET_EXPR_LOCATION (t, loc); - return t; -} -#define build2_loc(l,c,t1,t2,t3) build2_stat_loc (l,c,t1,t2,t3 MEM_STAT_INFO) - -static inline tree -build3_stat_loc (location_t loc, enum tree_code code, tree type, tree arg0, - tree arg1, tree op MEM_STAT_DECL) -{ - tree t = build3_stat (code, type, arg0, arg1, op PASS_MEM_STAT); - SET_EXPR_LOCATION (t, loc); - return t; -} -#define build3_loc(l,c,t1,t2,t3,t4) \ - build3_stat_loc (l,c,t1,t2,t3,t4 MEM_STAT_INFO) - -static inline tree -build4_stat_loc (location_t loc, enum tree_code code, tree type, tree arg0, - tree arg1, tree arg2, tree op MEM_STAT_DECL) -{ - tree t = build4_stat (code, type, arg0, arg1, arg2, op PASS_MEM_STAT); - SET_EXPR_LOCATION (t, loc); - return t; -} -#define build4_loc(l,c,t1,t2,t3,t4,t5) \ - build4_stat_loc (l,c,t1,t2,t3,t4,t5 MEM_STAT_INFO) - - /* Build an expression with void type. */ #define build1_v(code, arg) \ fold_build1_loc (input_location, code, void_type_node, arg)