This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[patch, fortran] Implement VOLATILE statement/attribute (PR 29601)
- From: Tobias Burnus <burnus at net-b dot de>
- To: gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Tue, 31 Oct 2006 01:22:34 +0100
- Subject: [patch, fortran] Implement VOLATILE statement/attribute (PR 29601)
- Reply-to: gcc-patches <gcc-patches at gcc dot gnu dot org>, "'fortran at gcc dot gnu dot org'" <fortran at gcc dot gnu dot org>
:ADDPATCH:
Hello,
the following patch implements the volatile attribute and statement.
I'm not positive that this patch does the right thing (especially
whether it indeeds sets the right attribute [e.g. also for pointers]).
For the restrictions I use:
C526 If the VOLATILE attribute is specified, the PARAMETER, INTRINSIC,
EXTERNAL, or INTENT(IN) attribute shall not be specified.
(In principle VALUE is missing, but I think it is not yet supported by
gfortran.)
Whether it should prohibit other objects, I don't know. (I wonder about
e.g. about pure functions.)
I use
TREE_THIS_VOLATILE (decl) = 1
(this automatically sets TREE_SIDE_EFFECTS according to tree.h)
Using the fortran program:
------------------
real :: l,m
real, volatile :: r = 3.
volatile :: l
l = 4.0
m = 3.0
------------------
the dumped original tree is:
------------------
MAIN__ ()
{
real4 m;
real4 l;
_gfortran_set_std (70, 127, 0);
l = 4.0e+0;
m = 3.0e+0;
}
------------------
Whereas using the C program
------------------
int main() {
volatile int r;
r = 5.0;
}
------------------
the tree contains
------------------
{
volatile int r;
volatile int r;
r = 5;
}
------------------
This puzzles me. Glancing at Andy's g95 source code showed that he uses
also only TREE_THIS_VOLATILE().
My C program might be using the following function - or not as I think
the "r" is not static.
varasm.c: /* Make the rtl for variable VAR be volatile. Use this only
for static variables. */
make_var_volatile (tree var) {
gcc_assert (MEM_P (DECL_RTL (var)));
MEM_VOLATILE_P (DECL_RTL (var)) = 1;
}
* * *
The test cases only shows that volatiles is correctly recognized (F2003)
or rejected (F95), but I don't know how to test that the variable is
actually marked as volatile.
Regtested on x86_64-unknown-linux-gnu.
Tobias
fortran/
2006-10-30 Tobias Burnus <burnus@net-b.de>
fortran/29601
* symbol.c (check_conflict, gfc_add_volatile): Add volatile support.
* decl.c (match_attr_spec, gfc_match_volatile): Add volatile support.
* gfortran.h (symbol_attribute): Add volatile_ to struct.
* resolve.c (was_declared): Add volatile support.
* trans-decl.c (gfc_finish_var_decl): Add volatile support.
* match.h: Declare gfc_match_volatile.
* parse.c (decode_statement): Recognize volatile.
testsuite/
2006-10-30 Tobias Burnus <burnus@net-b.de>
fortran/29601
* volatile.f90: Add.
* volatile2.f90: Add.
* volatile3.f90: Add.
Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c (Revision 118191)
+++ gcc/fortran/symbol.c (Arbeitskopie)
@@ -265,14 +265,15 @@
{
static const char *dummy = "DUMMY", *save = "SAVE", *pointer = "POINTER",
*target = "TARGET", *external = "EXTERNAL", *intent = "INTENT",
- *intrinsic = "INTRINSIC", *allocatable = "ALLOCATABLE",
- *elemental = "ELEMENTAL", *private = "PRIVATE", *recursive = "RECURSIVE",
+ *intent_in = "INTENT(IN)", *intrinsic = "INTRINSIC",
+ *allocatable = "ALLOCATABLE", *elemental = "ELEMENTAL",
+ *private = "PRIVATE", *recursive = "RECURSIVE",
*in_common = "COMMON", *result = "RESULT", *in_namelist = "NAMELIST",
*public = "PUBLIC", *optional = "OPTIONAL", *entry = "ENTRY",
*function = "FUNCTION", *subroutine = "SUBROUTINE",
*dimension = "DIMENSION", *in_equivalence = "EQUIVALENCE",
*use_assoc = "USE ASSOCIATED", *cray_pointer = "CRAY POINTER",
- *cray_pointee = "CRAY POINTEE", *data = "DATA";
+ *cray_pointee = "CRAY POINTEE", *data = "DATA", *volatile_ = "VOLATILE";
static const char *threadprivate = "THREADPRIVATE";
const char *a1, *a2;
@@ -399,6 +400,16 @@
conf (data, allocatable);
conf (data, use_assoc);
+ conf (volatile_, intrinsic)
+ conf (volatile_, external)
+
+ if (attr->volatile_ && attr->intent == INTENT_IN)
+ {
+ a1 = volatile_;
+ a2 = intent_in;
+ goto conflict;
+ }
+
a1 = gfc_code2string (flavors, attr->flavor);
if (attr->in_namelist
@@ -508,6 +520,7 @@
conf2 (dummy);
conf2 (in_common);
conf2 (save);
+ conf2 (volatile_);
conf2 (threadprivate);
break;
@@ -812,7 +825,27 @@
return check_conflict (attr, name, where);
}
+try
+gfc_add_volatile (symbol_attribute * attr, const char *name, locus * where)
+{
+ if (check_used (attr, name, where))
+ return FAILURE;
+
+ if (attr->volatile_)
+ {
+ if (gfc_notify_std (GFC_STD_LEGACY,
+ "Duplicate VOLATILE attribute specified at %L",
+ where)
+ == FAILURE)
+ return FAILURE;
+ }
+
+ attr->volatile_ = 1;
+ return check_conflict (attr, name, where);
+}
+
+
try
gfc_add_threadprivate (symbol_attribute * attr, const char *name, locus * where)
{
@@ -1249,6 +1282,8 @@
goto fail;
if (src->save && gfc_add_save (dest, NULL, where) == FAILURE)
goto fail;
+ if (src->volatile_ && gfc_add_volatile (dest, NULL, where) == FAILURE)
+ goto fail;
if (src->threadprivate && gfc_add_threadprivate (dest, NULL, where) == FAILURE)
goto fail;
if (src->target && gfc_add_target (dest, where) == FAILURE)
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c (Revision 118191)
+++ gcc/fortran/decl.c (Arbeitskopie)
@@ -2024,7 +2024,7 @@
DECL_ALLOCATABLE = GFC_DECL_BEGIN, DECL_DIMENSION, DECL_EXTERNAL,
DECL_IN, DECL_OUT, DECL_INOUT, DECL_INTRINSIC, DECL_OPTIONAL,
DECL_PARAMETER, DECL_POINTER, DECL_PRIVATE, DECL_PUBLIC, DECL_SAVE,
- DECL_TARGET, DECL_COLON, DECL_NONE,
+ DECL_TARGET, DECL_VOLATILE, DECL_COLON, DECL_NONE,
GFC_DECL_END /* Sentinel */
}
decl_types;
@@ -2047,6 +2047,7 @@
minit (", public", DECL_PUBLIC),
minit (", save", DECL_SAVE),
minit (", target", DECL_TARGET),
+ minit (", volatile", DECL_VOLATILE),
minit ("::", DECL_COLON),
minit (NULL, DECL_NONE)
};
@@ -2167,6 +2168,9 @@
case DECL_TARGET:
attr = "TARGET";
break;
+ case DECL_VOLATILE:
+ attr = "VOLATILE";
+ break;
default:
attr = NULL; /* This shouldn't happen */
}
@@ -2281,6 +2285,16 @@
t = gfc_add_target (¤t_attr, &seen_at[d]);
break;
+ case DECL_VOLATILE:
+ if (gfc_notify_std (GFC_STD_F2003,
+ "In the selected standard, the VOLATILE "
+ "attribute is not allowed at %C")
+ == FAILURE)
+ t = FAILURE;
+ else
+ t = gfc_add_volatile (¤t_attr, NULL, &seen_at[d]);
+ break;
+
default:
gfc_internal_error ("match_attr_spec(): Bad attribute");
}
@@ -3893,7 +3907,7 @@
{
if (gfc_notify_std (GFC_STD_LEGACY,
"SAVE statement at %C follows blanket SAVE statement")
- == FAILURE)
+ == FAILURE)
return MATCH_ERROR;
}
@@ -3943,6 +3957,60 @@
}
+match
+gfc_match_volatile (void)
+{
+ gfc_symbol *sym;
+ match m;
+
+ if (gfc_notify_std (GFC_STD_F2003,
+ "In the selected standard, the VOLATILE "
+ "statement is not allowed at %C")
+ == FAILURE)
+ return MATCH_ERROR;
+
+ if (gfc_match (" ::") == MATCH_NO && gfc_match_space () == MATCH_NO)
+ {
+ return MATCH_ERROR;
+ }
+
+ if (gfc_match_eos () == MATCH_YES)
+ goto syntax;
+
+ for(;;)
+ {
+ m = gfc_match_symbol (&sym, 0);
+ switch (m)
+ {
+ case MATCH_YES:
+ if (gfc_add_volatile (&sym->attr, sym->name,
+ &gfc_current_locus) == FAILURE)
+ return MATCH_ERROR;
+ goto next_item;
+
+ case MATCH_NO:
+ break;
+
+ case MATCH_ERROR:
+ return MATCH_ERROR;
+ }
+
+ next_item:
+ if (gfc_match_eos () == MATCH_YES)
+ break;
+ if (gfc_match_char (',') != MATCH_YES)
+ goto syntax;
+ }
+
+ return MATCH_YES;
+
+syntax:
+ gfc_error ("Syntax error in VOLATILE statement at %C");
+ return MATCH_ERROR;
+}
+
+
+
/* Match a module procedure statement. Note that we have to modify
symbols in the parent's namespace because the current one was there
to receive symbols that are in an interface's formal argument list. */
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (Revision 118191)
+++ gcc/fortran/gfortran.h (Arbeitskopie)
@@ -477,7 +477,7 @@
{
/* Variable attributes. */
unsigned allocatable:1, dimension:1, external:1, intrinsic:1,
- optional:1, pointer:1, save:1, target:1,
+ optional:1, pointer:1, save:1, target:1, volatile_:1,
dummy:1, result:1, assign:1, threadprivate:1;
unsigned data:1, /* Symbol is named in a DATA statement. */
@@ -1866,6 +1866,7 @@
try gfc_add_recursive (symbol_attribute *, locus *);
try gfc_add_function (symbol_attribute *, const char *, locus *);
try gfc_add_subroutine (symbol_attribute *, const char *, locus *);
+try gfc_add_volatile (symbol_attribute *, const char *, locus *);
try gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *);
try gfc_add_flavor (symbol_attribute *, sym_flavor, const char *, locus *);
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (Revision 118191)
+++ gcc/fortran/resolve.c (Arbeitskopie)
@@ -677,7 +677,7 @@
return 1;
if (a.allocatable || a.dimension || a.dummy || a.external || a.intrinsic
- || a.optional || a.pointer || a.save || a.target
+ || a.optional || a.pointer || a.save || a.target || a.volatile_
|| a.access != ACCESS_UNKNOWN || a.intent != INTENT_UNKNOWN)
return 1;
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c (Revision 118191)
+++ gcc/fortran/trans-decl.c (Arbeitskopie)
@@ -513,6 +513,9 @@
if ((sym->attr.save || sym->attr.data || sym->value)
&& !sym->attr.use_assoc)
TREE_STATIC (decl) = 1;
+
+ if (sym->attr.volatile_)
+ TREE_THIS_VOLATILE (decl) = TREE_SIDE_EFFECTS (decl) = 1;
/* Keep variables larger than max-stack-var-size off stack. */
if (!sym->ns->proc_name->attr.recursive
Index: gcc/fortran/match.h
===================================================================
--- gcc/fortran/match.h (Revision 118191)
+++ gcc/fortran/match.h (Arbeitskopie)
@@ -146,6 +146,7 @@
match gfc_match_save (void);
match gfc_match_modproc (void);
match gfc_match_target (void);
+match gfc_match_volatile (void);
/* primary.c */
match gfc_match_structure_constructor (gfc_symbol *, gfc_expr **);
Index: gcc/fortran/parse.c
===================================================================
--- gcc/fortran/parse.c (Revision 118191)
+++ gcc/fortran/parse.c (Arbeitskopie)
@@ -282,6 +282,10 @@
match ("use% ", gfc_match_use, ST_USE);
break;
+ case 'v':
+ match ("volatile", gfc_match_volatile, ST_ATTR_DECL);
+ break;
+
case 'w':
match ("write", gfc_match_write, ST_WRITE);
break;
--- /dev/null 2006-10-21 23:34:46.000000000 +0200
+++ gcc/testsuite/gfortran.dg/volatile.f90 2006-10-31 00:47:51.000000000 +0100
@@ -0,0 +1,11 @@
+! { dg-do run }
+! Test whether volatile statements and attributes are accepted
+! PR fortran/29601
+program volatile_test
+ implicit none
+ real :: l,m
+ real, volatile :: r = 3.
+ volatile :: l
+ l = 4.0
+ m = 3.0
+end program volatile_test
--- /dev/null 2006-10-21 23:34:46.000000000 +0200
+++ gcc/testsuite/gfortran.dg/volatile2.f90 2006-10-31 01:15:40.000000000 +0100
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! { dg-shouldfail "VOLATILE not part of F95" }
+! { dg-options "-std=f95" }
+! Test whether volatile statements and attributes are rejected
+! with -std=f95.
+! PR fortran/29601
+program volatile_test
+ implicit none
+ real, external, volatile :: foo ! { dg-error "VOLATILE attribute is not allowed" }
+ real, intrinsic, volatile :: sin ! { dg-error "VOLATILE attribute is not allowed" }
+ real, parameter, volatile :: r = 5.5 ! { dg-error "VOLATILE attribute is not allowed" }
+ real :: l,m
+ real, volatile :: r = 3. ! { dg-error "VOLATILE attribute is not allowed" }
+ volatile :: l ! { dg-error "VOLATILE statement is not allowed" }
+ l = 4.0
+ m = 3.0
+end program volatile_test
--- /dev/null 2006-10-21 23:34:46.000000000 +0200
+++ gcc/testsuite/gfortran.dg/volatile3.f90 2006-10-31 01:13:17.000000000 +0100
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-shouldfail "Invalid use of VOLATILE" }
+! Test whether volatile statements and attributes are
+! properly error checked.
+! PR fortran/29601
+program volatile_test
+ implicit none
+ real, external, volatile :: foo ! { dg-error "VOLATILE attribute conflicts with EXTERNAL attribute" }
+ real, intrinsic, volatile :: sin ! { dg-error "VOLATILE attribute conflicts with INTRINSIC attribute" }
+ real, parameter, volatile :: r = 5.5 ! { dg-error "PARAMETER attribute conflicts with VOLATILE attribute" }
+ real :: l,m
+ real,volatile :: n
+ real, volatile,volatile :: r = 3. ! { dg-error "Duplicate VOLATILE attribute" }
+ volatile :: l,n ! { dg-error "Duplicate VOLATILE attribute" }
+ volatile ! { dg-error "Syntax error in VOLATILE statement" }
+ l = 4.0
+ m = 3.0
+contains
+ subroutine foo(a) ! { dg-error "has no IMPLICIT type" } ! due to error below
+ integer, intent(in), volatile :: a ! { dg-error "VOLATILE attribute conflicts with INTENT\\(IN\\)" }
+ end subroutine
+end program volatile_test