Commit b122dc6a by Jakub Jelinek

trans.h (gfc_conv_cray_pointee): Remove.

	* trans.h (gfc_conv_cray_pointee): Remove.
	* trans-expr.c (gfc_conv_variable): Revert 2005-10-24 change.
	* trans-array.c (gfc_conv_array_parameter): Likewise.
	* trans-decl.c (gfc_conv_cray_pointee): Remove.
	(gfc_finish_cray_pointee): New function.
	(gfc_finish_var_decl): Use it.  Don't return early for Cray
	pointees.
	(gfc_create_module_variable): Revert 2005-10-24 change.
	* decl.c (cray_pointer_decl): Update comment.
	* gfortran.texi: Don't mention Cray pointees aren't visible in the
	debugger.

	* symbol.c (check_conflict): Add conflict between cray_pointee
	and in_common resp. in_equivalence.
	* resolve.c (resolve_equivalence): Revert 2005-10-24 change.
testsuite/
	* gfortran.dg/cray_pointers_4.f90: New test.

	* module.c (ab_attribute): Add AB_CRAY_POINTER and AB_CRAY_POINTEE.
	(attr_bits): Likewise.
	(mio_symbol_attribute): Save and restore cray_pointe{r,e} attributes.
	(mio_symbol): For cray_pointee write/read cp_pointer reference.
testsuite/
	* gfortran.dg/cray_pointers_5.f90: New test.

From-SVN: r105891
parent 910450c1
2005-10-25 Jakub Jelinek <jakub@redhat.com>
* trans.h (gfc_conv_cray_pointee): Remove.
* trans-expr.c (gfc_conv_variable): Revert 2005-10-24 change.
* trans-array.c (gfc_conv_array_parameter): Likewise.
* trans-decl.c (gfc_conv_cray_pointee): Remove.
(gfc_finish_cray_pointee): New function.
(gfc_finish_var_decl): Use it. Don't return early for Cray
pointees.
(gfc_create_module_variable): Revert 2005-10-24 change.
* decl.c (cray_pointer_decl): Update comment.
* gfortran.texi: Don't mention Cray pointees aren't visible in the
debugger.
* symbol.c (check_conflict): Add conflict between cray_pointee
and in_common resp. in_equivalence.
* resolve.c (resolve_equivalence): Revert 2005-10-24 change.
* module.c (ab_attribute): Add AB_CRAY_POINTER and AB_CRAY_POINTEE.
(attr_bits): Likewise.
(mio_symbol_attribute): Save and restore cray_pointe{r,e} attributes.
(mio_symbol): For cray_pointee write/read cp_pointer reference.
2005-10-25 Feng Wang <fengwang@nudt.edu.cn> 2005-10-25 Feng Wang <fengwang@nudt.edu.cn>
PR fortran/22290 PR fortran/22290
...@@ -14,7 +37,7 @@ ...@@ -14,7 +37,7 @@
PR fortran/17031 PR fortran/17031
PR fortran/22282 PR fortran/22282
* check.c (gfc_check_loc) : New function * check.c (gfc_check_loc): New function.
* decl.c (variable_decl): New variables cp_as and sym. Added a * decl.c (variable_decl): New variables cp_as and sym. Added a
check for variables that have already been declared as Cray check for variables that have already been declared as Cray
Pointers, so we can get the necessary attributes without adding Pointers, so we can get the necessary attributes without adding
...@@ -24,7 +47,7 @@ ...@@ -24,7 +47,7 @@
(cray_pointer_decl): New method. (cray_pointer_decl): New method.
(gfc_match_pointer): Added Cray pointer parsing code. (gfc_match_pointer): Added Cray pointer parsing code.
(gfc_mod_pointee_as): New method. (gfc_mod_pointee_as): New method.
* expr.c (gfc_check_assign): added a check to catch vector-type * expr.c (gfc_check_assign): Added a check to catch vector-type
assignments to pointees with an unspecified final dimension. assignments to pointees with an unspecified final dimension.
* gfortran.h: (GFC_ISYM_LOC): New. * gfortran.h: (GFC_ISYM_LOC): New.
(symbol_attribute): Added cray_pointer and cray_pointee bits. (symbol_attribute): Added cray_pointer and cray_pointee bits.
...@@ -39,7 +62,7 @@ ...@@ -39,7 +62,7 @@
(gfc_resolve_loc): Declare. (gfc_resolve_loc): Declare.
* iresolve.c (gfc_resolve_loc): New. * iresolve.c (gfc_resolve_loc): New.
* lang.opt: Added fcray-pointer flag. * lang.opt: Added fcray-pointer flag.
* options.c (gfc_init_options): Intialized * options.c (gfc_init_options): Initialized.
gfc_match_option.flag_cray_pointer. gfc_match_option.flag_cray_pointer.
(gfc_handle_option): Deal with -fcray-pointer. (gfc_handle_option): Deal with -fcray-pointer.
* parse.c:(resolve_equivalence): Added code prohibiting Cray * parse.c:(resolve_equivalence): Added code prohibiting Cray
...@@ -50,9 +73,9 @@ ...@@ -50,9 +73,9 @@
statements. statements.
* symbol.c (check_conflict): Added Cray pointer/pointee * symbol.c (check_conflict): Added Cray pointer/pointee
attribute checking. attribute checking.
(gfc_add_cray_pointer): New (gfc_add_cray_pointer): New.
(gfc_add_cray_pointee): New (gfc_add_cray_pointee): New.
(gfc_copy_attr): New code for Cray pointers and pointees (gfc_copy_attr): New code for Cray pointers and pointees.
* trans-array.c (gfc_trans_auto_array_allocation): Added code to * trans-array.c (gfc_trans_auto_array_allocation): Added code to
prevent space from being allocated for pointees. prevent space from being allocated for pointees.
(gfc_conv_array_parameter): Added code to catch pointees and (gfc_conv_array_parameter): Added code to catch pointees and
...@@ -60,18 +83,18 @@ ...@@ -60,18 +83,18 @@
* trans-decl.c (gfc_finish_var_decl): Added code to prevent * trans-decl.c (gfc_finish_var_decl): Added code to prevent
pointee declarations from making it to the back end. pointee declarations from making it to the back end.
(gfc_create_module_variable): Same. (gfc_create_module_variable): Same.
* trans-expr.c (gfc_conv_variable): added code to detect and * trans-expr.c (gfc_conv_variable): Added code to detect and
translate pointees. translate pointees.
(gfc_conv_cray_pointee): New. (gfc_conv_cray_pointee): New.
* trans-intrinsic.c (gfc_conv_intrinsic_loc): New. * trans-intrinsic.c (gfc_conv_intrinsic_loc): New.
(gfc_conv_intrinsic_function): added entry point for loc (gfc_conv_intrinsic_function): Added entry point for loc
translation. translation.
* trans.h (gfc_conv_cray_pointee): Declare. * trans.h (gfc_conv_cray_pointee): Declare.
* gfortran.texi: Added section on Cray pointers, removed Cray * gfortran.texi: Added section on Cray pointers, removed Cray
pointers from list of proposed extensions pointers from list of proposed extensions.
* intrinsic.texi: Added documentation for loc intrinsic. * intrinsic.texi: Added documentation for loc intrinsic.
* invoke.texi: Documented -fcray-pointer flag * invoke.texi: Documented -fcray-pointer flag.
2005-10-24 Asher Langton <langton2@llnl.gov> 2005-10-24 Asher Langton <langton2@llnl.gov>
...@@ -2417,7 +2440,7 @@ ...@@ -2417,7 +2440,7 @@
gfc_match_null, match_type_spec, match_attr_spec, gfc_match_null, match_type_spec, match_attr_spec,
gfc_match_formal_arglist, match_result, gfc_match_function_decl): gfc_match_formal_arglist, match_result, gfc_match_function_decl):
Update callers to match. Update callers to match.
(gfc_match_entry) : Likewise, fix comment typo. (gfc_match_entry): Likewise, fix comment typo.
(gfc_match_subroutine, attr_decl1, gfc_add_dimension, (gfc_match_subroutine, attr_decl1, gfc_add_dimension,
access_attr_decl, do_parm, gfc_match_save, gfc_match_modproc, access_attr_decl, do_parm, gfc_match_save, gfc_match_modproc,
gfc_match_derived_decl): Update callers. gfc_match_derived_decl): Update callers.
...@@ -2568,7 +2591,7 @@ ...@@ -2568,7 +2591,7 @@
unsigned issue. Use build_int_cst instead of converting unsigned issue. Use build_int_cst instead of converting
integer_zero_node. Remove unnecessary conversion. integer_zero_node. Remove unnecessary conversion.
* trans-types.c (gfc_get_character_type_len): : Use * trans-types.c (gfc_get_character_type_len): Use
gfc_charlen_type_node as basic type for the range field. gfc_charlen_type_node as basic type for the range field.
* trans-intrinsic.c (build_fixbound_expr, * trans-intrinsic.c (build_fixbound_expr,
......
...@@ -2995,8 +2995,7 @@ attr_decl (void) ...@@ -2995,8 +2995,7 @@ attr_decl (void)
pointer (ipt, ar(10)) pointer (ipt, ar(10))
any subsequent uses of ar will be translated (in C-notation) as any subsequent uses of ar will be translated (in C-notation) as
ar(i) => ((<type> *) ipt)(i) ar(i) => ((<type> *) ipt)(i)
By the time the code is translated into GENERIC, the pointee will After gimplification, pointee variable will disappear in the code. */
have disappeared from the code entirely. */
static match static match
cray_pointer_decl (void) cray_pointer_decl (void)
...@@ -3112,7 +3111,7 @@ cray_pointer_decl (void) ...@@ -3112,7 +3111,7 @@ cray_pointer_decl (void)
} }
/* Point the Pointee at the Pointer. */ /* Point the Pointee at the Pointer. */
cpte->cp_pointer=cptr; cpte->cp_pointer = cptr;
if (gfc_match_char (')') != MATCH_YES) if (gfc_match_char (')') != MATCH_YES)
{ {
......
...@@ -899,11 +899,7 @@ expect. Adding 1 to ipt just adds one byte to the address stored in ...@@ -899,11 +899,7 @@ expect. Adding 1 to ipt just adds one byte to the address stored in
ipt. ipt.
Any expression involving the pointee will be translated to use the Any expression involving the pointee will be translated to use the
value stored in the pointer as the base address. This translation is value stored in the pointer as the base address.
done in the front end, and so the pointees are not present in the
GENERIC tree that is handed off to the backend. One disadvantage of
this is that pointees will not appear in gdb when debugging a Fortran
program that uses Cray pointers.
To get the address of elements, this extension provides an intrinsic To get the address of elements, this extension provides an intrinsic
function loc(), loc() is essentially the C '&' operator, except the function loc(), loc() is essentially the C '&' operator, except the
......
...@@ -1431,7 +1431,8 @@ typedef enum ...@@ -1431,7 +1431,8 @@ typedef enum
AB_POINTER, AB_SAVE, AB_TARGET, AB_DUMMY, AB_RESULT, AB_POINTER, AB_SAVE, AB_TARGET, AB_DUMMY, AB_RESULT,
AB_DATA, AB_IN_NAMELIST, AB_IN_COMMON, AB_DATA, AB_IN_NAMELIST, AB_IN_COMMON,
AB_FUNCTION, AB_SUBROUTINE, AB_SEQUENCE, AB_ELEMENTAL, AB_PURE, AB_FUNCTION, AB_SUBROUTINE, AB_SEQUENCE, AB_ELEMENTAL, AB_PURE,
AB_RECURSIVE, AB_GENERIC, AB_ALWAYS_EXPLICIT AB_RECURSIVE, AB_GENERIC, AB_ALWAYS_EXPLICIT, AB_CRAY_POINTER,
AB_CRAY_POINTEE
} }
ab_attribute; ab_attribute;
...@@ -1458,6 +1459,8 @@ static const mstring attr_bits[] = ...@@ -1458,6 +1459,8 @@ static const mstring attr_bits[] =
minit ("RECURSIVE", AB_RECURSIVE), minit ("RECURSIVE", AB_RECURSIVE),
minit ("GENERIC", AB_GENERIC), minit ("GENERIC", AB_GENERIC),
minit ("ALWAYS_EXPLICIT", AB_ALWAYS_EXPLICIT), minit ("ALWAYS_EXPLICIT", AB_ALWAYS_EXPLICIT),
minit ("CRAY_POINTER", AB_CRAY_POINTER),
minit ("CRAY_POINTEE", AB_CRAY_POINTEE),
minit (NULL, -1) minit (NULL, -1)
}; };
...@@ -1542,6 +1545,10 @@ mio_symbol_attribute (symbol_attribute * attr) ...@@ -1542,6 +1545,10 @@ mio_symbol_attribute (symbol_attribute * attr)
MIO_NAME(ab_attribute) (AB_RECURSIVE, attr_bits); MIO_NAME(ab_attribute) (AB_RECURSIVE, attr_bits);
if (attr->always_explicit) if (attr->always_explicit)
MIO_NAME(ab_attribute) (AB_ALWAYS_EXPLICIT, attr_bits); MIO_NAME(ab_attribute) (AB_ALWAYS_EXPLICIT, attr_bits);
if (attr->cray_pointer)
MIO_NAME(ab_attribute) (AB_CRAY_POINTER, attr_bits);
if (attr->cray_pointee)
MIO_NAME(ab_attribute) (AB_CRAY_POINTEE, attr_bits);
mio_rparen (); mio_rparen ();
...@@ -1622,6 +1629,12 @@ mio_symbol_attribute (symbol_attribute * attr) ...@@ -1622,6 +1629,12 @@ mio_symbol_attribute (symbol_attribute * attr)
case AB_ALWAYS_EXPLICIT: case AB_ALWAYS_EXPLICIT:
attr->always_explicit = 1; attr->always_explicit = 1;
break; break;
case AB_CRAY_POINTER:
attr->cray_pointer = 1;
break;
case AB_CRAY_POINTEE:
attr->cray_pointee = 1;
break;
} }
} }
} }
...@@ -2815,6 +2828,9 @@ mio_symbol (gfc_symbol * sym) ...@@ -2815,6 +2828,9 @@ mio_symbol (gfc_symbol * sym)
mio_symbol_ref (&sym->result); mio_symbol_ref (&sym->result);
if (sym->attr.cray_pointee)
mio_symbol_ref (&sym->cp_pointer);
/* Note that components are always saved, even if they are supposed /* Note that components are always saved, even if they are supposed
to be private. Component access is checked during searching. */ to be private. Component access is checked during searching. */
......
...@@ -5177,14 +5177,6 @@ resolve_equivalence (gfc_equiv *eq) ...@@ -5177,14 +5177,6 @@ resolve_equivalence (gfc_equiv *eq)
break; break;
} }
/* Shall not be a Cray pointee. */
if (sym->attr.cray_pointee)
{
gfc_error ("Cray Pointee '%s' at %L cannot be an EQUIVALENCE "
"object", sym->name, &e->where);
continue;
}
/* Shall not be a named constant. */ /* Shall not be a named constant. */
if (e->expr_type == EXPR_CONSTANT) if (e->expr_type == EXPR_CONSTANT)
{ {
......
...@@ -368,6 +368,8 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where) ...@@ -368,6 +368,8 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
conf (cray_pointee, function); conf (cray_pointee, function);
conf (cray_pointee, subroutine); conf (cray_pointee, subroutine);
conf (cray_pointee, entry); conf (cray_pointee, entry);
conf (cray_pointee, in_common);
conf (cray_pointee, in_equivalence);
a1 = gfc_code2string (flavors, attr->flavor); a1 = gfc_code2string (flavors, attr->flavor);
......
...@@ -4083,11 +4083,6 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77) ...@@ -4083,11 +4083,6 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77)
&& expr->ref->u.ar.type == AR_FULL && g77) && expr->ref->u.ar.type == AR_FULL && g77)
{ {
sym = expr->symtree->n.sym; sym = expr->symtree->n.sym;
/* Check to see if we're dealing with a Cray Pointee. */
if (sym->attr.cray_pointee)
tmp = gfc_conv_cray_pointee (sym);
else
tmp = gfc_get_symbol_decl (sym); tmp = gfc_get_symbol_decl (sym);
if (sym->ts.type == BT_CHARACTER) if (sym->ts.type == BT_CHARACTER)
......
...@@ -351,6 +351,44 @@ gfc_can_put_var_on_stack (tree size) ...@@ -351,6 +351,44 @@ gfc_can_put_var_on_stack (tree size)
} }
/* gfc_finish_cray_pointee sets DECL_VALUE_EXPR for a Cray pointee to
an expression involving its corresponding pointer. There are
2 cases; one for variable size arrays, and one for everything else,
because variable-sized arrays require one fewer level of
indirection. */
static void
gfc_finish_cray_pointee (tree decl, gfc_symbol *sym)
{
tree ptr_decl = gfc_get_symbol_decl (sym->cp_pointer);
tree value;
/* Parameters need to be dereferenced. */
if (sym->cp_pointer->attr.dummy)
ptr_decl = gfc_build_indirect_ref (ptr_decl);
/* Check to see if we're dealing with a variable-sized array. */
if (sym->attr.dimension
&& TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE)
{
/* These decls will be derefenced later, so we don't dereference
them here. */
value = convert (TREE_TYPE (decl), ptr_decl);
}
else
{
ptr_decl = convert (build_pointer_type (TREE_TYPE (decl)),
ptr_decl);
value = gfc_build_indirect_ref (ptr_decl);
}
SET_DECL_VALUE_EXPR (decl, value);
DECL_HAS_VALUE_EXPR_P (decl) = 1;
/* This is a fake variable just for debugging purposes. */
TREE_ASM_WRITTEN (decl) = 1;
}
/* Finish processing of a declaration and install its initial value. */ /* Finish processing of a declaration and install its initial value. */
static void static void
...@@ -417,9 +455,9 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) ...@@ -417,9 +455,9 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
We also need to set this if the variable is passed by reference in a We also need to set this if the variable is passed by reference in a
CALL statement. */ CALL statement. */
/* We don't want real declarations for Cray Pointees. */ /* Set DECL_VALUE_EXPR for Cray Pointees. */
if (sym->attr.cray_pointee) if (sym->attr.cray_pointee)
return; gfc_finish_cray_pointee (decl, sym);
if (sym->attr.target) if (sym->attr.target)
TREE_ADDRESSABLE (decl) = 1; TREE_ADDRESSABLE (decl) = 1;
...@@ -437,6 +475,9 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) ...@@ -437,6 +475,9 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
gfc_add_decl_to_parent_function (decl); gfc_add_decl_to_parent_function (decl);
} }
if (sym->attr.cray_pointee)
return;
/* If a variable is USE associated, it's always external. */ /* If a variable is USE associated, it's always external. */
if (sym->attr.use_assoc) if (sym->attr.use_assoc)
{ {
...@@ -2309,10 +2350,6 @@ gfc_create_module_variable (gfc_symbol * sym) ...@@ -2309,10 +2350,6 @@ gfc_create_module_variable (gfc_symbol * sym)
/* Create the decl. */ /* Create the decl. */
decl = gfc_get_symbol_decl (sym); decl = gfc_get_symbol_decl (sym);
/* Don't create a "real" declaration for a Cray Pointee. */
if (sym->attr.cray_pointee)
return;
/* Create the variable. */ /* Create the variable. */
pushdecl (decl); pushdecl (decl);
rest_of_decl_compilation (decl, 1, 0); rest_of_decl_compilation (decl, 1, 0);
...@@ -2734,36 +2771,5 @@ gfc_generate_block_data (gfc_namespace * ns) ...@@ -2734,36 +2771,5 @@ gfc_generate_block_data (gfc_namespace * ns)
rest_of_decl_compilation (decl, 1, 0); rest_of_decl_compilation (decl, 1, 0);
} }
/* gfc_conv_cray_pointee takes a sym with attribute cray_pointee and
swaps in the backend_decl of its corresponding pointer. There are
2 cases; one for variable size arrays, and one for everything else,
because variable-sized arrays require one fewer level of
indirection. */
tree
gfc_conv_cray_pointee(gfc_symbol *sym)
{
tree decl = gfc_get_symbol_decl (sym->cp_pointer);
/* Parameters need to be dereferenced. */
if (sym->cp_pointer->attr.dummy)
decl = gfc_build_indirect_ref (decl);
/* Check to see if we're dealing with a variable-sized array. */
if (sym->attr.dimension
&& TREE_CODE (TREE_TYPE (sym->backend_decl)) == POINTER_TYPE)
{
/* These decls will be derefenced later, so we don't dereference
them here. */
decl = convert (TREE_TYPE (sym->backend_decl), decl);
}
else
{
decl = convert (build_pointer_type (TREE_TYPE (sym->backend_decl)),
decl);
decl = gfc_build_indirect_ref (decl);
}
return decl;
}
#include "gt-fortran-trans-decl.h" #include "gt-fortran-trans-decl.h"
...@@ -316,10 +316,6 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr) ...@@ -316,10 +316,6 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
{ {
tree se_expr = NULL_TREE; tree se_expr = NULL_TREE;
/* Handle Cray Pointees. */
if (sym->attr.cray_pointee)
se->expr = gfc_conv_cray_pointee (sym);
else
se->expr = gfc_get_symbol_decl (sym); se->expr = gfc_get_symbol_decl (sym);
/* Special case for assigning the return value of a function. /* Special case for assigning the return value of a function.
......
...@@ -406,9 +406,6 @@ void gfc_generate_block_data (gfc_namespace *); ...@@ -406,9 +406,6 @@ void gfc_generate_block_data (gfc_namespace *);
/* Output a decl for a module variable. */ /* Output a decl for a module variable. */
void gfc_generate_module_vars (gfc_namespace *); void gfc_generate_module_vars (gfc_namespace *);
/* Translate the declaration for a Cray Pointee. */
tree gfc_conv_cray_pointee (gfc_symbol *sym);
/* Get and set the current location. */ /* Get and set the current location. */
void gfc_set_backend_locus (locus *); void gfc_set_backend_locus (locus *);
void gfc_get_backend_locus (locus *); void gfc_get_backend_locus (locus *);
......
2005-10-25 Jakub Jelinek <jakub@redhat.com>
* gfortran.dg/cray_pointers_4.f90: New test.
* gfortran.dg/cray_pointers_5.f90: New test.
2005-10-25 Feng Wang <fengwang@nudt.edu.cn> 2005-10-25 Feng Wang <fengwang@nudt.edu.cn>
PR fortran/22290 PR fortran/22290
! { dg-do compile }
! { dg-options "-fcray-pointer" }
subroutine err1
integer :: in_common1, in_common2, v, w, equiv1, equiv2
common /in_common1/ in_common1
pointer (ipt1, in_common1) ! { dg-error "conflicts with COMMON" }
pointer (ipt2, in_common2)
common /in_common2/ in_common2 ! { dg-error "conflicts with COMMON" }
equivalence (v, equiv1)
pointer (ipt3, equiv1) ! { dg-error "conflicts with EQUIVALENCE" }
pointer (ipt4, equiv2)
equivalence (w, equiv2) ! { dg-error "conflicts with EQUIVALENCE" }
end subroutine err1
! { dg-do run }
! { dg-options "-fcray-pointer -fno-strict-aliasing" }
module cray_pointers_5
integer :: var (10), arr(100)
pointer (ipt, var)
end module cray_pointers_5
use cray_pointers_5
integer :: i
forall (i = 1:100) arr(i) = i
ipt = loc (arr)
if (any (var .ne. (/1, 2, 3, 4, 5, 6, 7, 8, 9, 10/))) call abort
end
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment