[PATCH] Add an AUTOMATIC statement for use with -fno-automatic.
mark.doffman@codethink.co.uk
mark.doffman@codethink.co.uk
Thu Jan 30 15:38:00 GMT 2014
From: Mark Doffman <mark.doffman@codethink.co.uk>
Add an AUTOMATIC statement and attribute specification
that places data objects back on the stack when otherwise
they would be statically assigned.
The AUTOMATIC statement is not part of any Fortran standard (As far as
I am aware). However it is supported by the Sun Fortran compiler, see
http://docs.oracle.com/cd/E19957-01/806-3594/806-3594.pdf. It is also
supported by the IBM XL fortran compiler, see
https://www-304.ibm.com/support/docview.wss?uid=swg27018978&aid=1
page 271.
The addition of AUTOMATIC statment and attribute spec here tries to
adhere to these documents.
As automatic allocation is the default behavior the AUTOMATIC statment
should only have an effect when using -fno-automatic or an equivalent
compiler option to limit the size of objects placed on the stack.
2014-1-29 Mark Doffman <mark.doffman@codethink.co.uk>
* decl.c (gfc_match_attr_spec): Add automatic attr spec.
* gfortran.h: Add automatic attribute to symbol_attribute.
* match.h: Add automatic match funciton declaration.
* parse.c (decode_statement): Use the automatic statement match function.
(decode_specification_statement): Use automatic statement match function.
* symbol.c (check_conflict): Add automatic attribute conflicts.
(gfc_match_automatic): New function matching automatic statement.
* trans-decl.c (gfc_finish_var_decl): Do not make symbol
static if automatic attribute is set when using
-fno-automatic.
---
gcc/fortran/decl.c | 55 +++++++++++++++++++++++++++++++++++++++++++++---
gcc/fortran/gfortran.h | 3 ++-
gcc/fortran/match.h | 1 +
gcc/fortran/parse.c | 2 ++
gcc/fortran/symbol.c | 54 ++++++++++++++++++++++++++++++++++++++++++++---
gcc/fortran/trans-decl.c | 1 +
6 files changed, 109 insertions(+), 7 deletions(-)
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 0a0f8e0..dbecdee 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -3300,9 +3300,9 @@ match_attr_spec (void)
DECL_ALLOCATABLE = GFC_DECL_BEGIN, DECL_DIMENSION, DECL_EXTERNAL,
DECL_IN, DECL_OUT, DECL_INOUT, DECL_INTRINSIC, DECL_OPTIONAL,
DECL_PARAMETER, DECL_POINTER, DECL_PROTECTED, DECL_PRIVATE,
- DECL_PUBLIC, DECL_SAVE, DECL_TARGET, DECL_VALUE, DECL_VOLATILE,
- DECL_IS_BIND_C, DECL_CODIMENSION, DECL_ASYNCHRONOUS, DECL_CONTIGUOUS,
- DECL_NONE, GFC_DECL_END /* Sentinel */
+ DECL_PUBLIC, DECL_SAVE, DECL_AUTOMATIC, DECL_TARGET, DECL_VALUE,
+ DECL_VOLATILE, DECL_IS_BIND_C, DECL_CODIMENSION, DECL_ASYNCHRONOUS,
+ DECL_CONTIGUOUS, DECL_NONE, GFC_DECL_END /* Sentinel */
};
/* GFC_DECL_END is the sentinel, index starts at 0. */
@@ -3363,6 +3363,14 @@ match_attr_spec (void)
d = DECL_ASYNCHRONOUS;
}
break;
+
+ case 'u':
+ if (match_string_p ("tomatic"))
+ {
+ /* Matched "automatic". */
+ d = DECL_AUTOMATIC;
+ }
+ break;
}
break;
@@ -3629,6 +3637,9 @@ match_attr_spec (void)
case DECL_SAVE:
attr = "SAVE";
break;
+ case DECL_AUTOMATIC:
+ attr = "AUTOMATIC";
+ break;
case DECL_TARGET:
attr = "TARGET";
break;
@@ -3797,6 +3808,10 @@ match_attr_spec (void)
t = gfc_add_save (¤t_attr, SAVE_EXPLICIT, NULL, &seen_at[d]);
break;
+ case DECL_AUTOMATIC:
+ t = gfc_add_automatic (¤t_attr, NULL, &seen_at[d]);
+ break;
+
case DECL_TARGET:
t = gfc_add_target (¤t_attr, &seen_at[d]);
break;
@@ -7113,6 +7128,40 @@ syntax:
return MATCH_ERROR;
}
+match
+gfc_match_automatic (void)
+{
+ gfc_symbol *sym;
+ match m;
+
+ gfc_match (" ::");
+
+ for (;;)
+ {
+ m = gfc_match_symbol (&sym, 0);
+ switch (m)
+ {
+ case MATCH_YES:
+ if (!gfc_add_automatic (&sym->attr, sym->name,
+ &gfc_current_locus))
+ return MATCH_ERROR;
+ if (gfc_match_eos () == MATCH_YES)
+ return MATCH_YES;
+ if (gfc_match_char (',') != MATCH_YES)
+ goto syntax;
+ break;
+ case MATCH_NO:
+ goto syntax;
+ case MATCH_ERROR:
+ return MATCH_ERROR;
+ }
+ }
+
+syntax:
+ gfc_error ("Syntax error in AUTOMATIC statement at %C");
+ return MATCH_ERROR;
+}
+
match
gfc_match_value (void)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index ff3ffb5..e5b642e 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -702,7 +702,7 @@ typedef struct
optional:1, pointer:1, target:1, value:1, volatile_:1, temporary:1,
dummy:1, result:1, assign:1, threadprivate:1, not_always_present:1,
implied_index:1, subref_array_pointer:1, proc_pointer:1, asynchronous:1,
- contiguous:1;
+ contiguous:1, automatic:1;
/* For CLASS containers, the pointer attribute is sometimes set internally
even though it was not directly specified. In this case, keep the
@@ -2569,6 +2569,7 @@ match gfc_mod_pointee_as (gfc_array_spec *);
bool gfc_add_protected (symbol_attribute *, const char *, locus *);
bool gfc_add_result (symbol_attribute *, const char *, locus *);
bool gfc_add_save (symbol_attribute *, save_state, const char *, locus *);
+bool gfc_add_automatic (symbol_attribute *, const char *, locus *);
bool gfc_add_threadprivate (symbol_attribute *, const char *, locus *);
bool gfc_add_saved_common (symbol_attribute *, locus *);
bool gfc_add_target (symbol_attribute *, locus *);
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 1a701f0..4b6793c 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -187,6 +187,7 @@ match gfc_match_protected (void);
match gfc_match_private (gfc_statement *);
match gfc_match_public (gfc_statement *);
match gfc_match_save (void);
+match gfc_match_automatic (void);
match gfc_match_modproc (void);
match gfc_match_target (void);
match gfc_match_value (void);
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index e8b9885..5db1add 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -162,6 +162,7 @@ decode_specification_statement (void)
ST_INTERFACE);
match ("allocatable", gfc_match_allocatable, ST_ATTR_DECL);
match ("asynchronous", gfc_match_asynchronous, ST_ATTR_DECL);
+ match ("automatic", gfc_match_automatic, ST_ATTR_DECL);
break;
case 'b':
@@ -384,6 +385,7 @@ decode_statement (void)
match ("allocatable", gfc_match_allocatable, ST_ATTR_DECL);
match ("assign", gfc_match_assign, ST_LABEL_ASSIGNMENT);
match ("asynchronous", gfc_match_asynchronous, ST_ATTR_DECL);
+ match ("automatic", gfc_match_automatic, ST_ATTR_DECL);
break;
case 'b':
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 9d23e8b..2e25ac4 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -349,9 +349,9 @@ gfc_check_function_type (gfc_namespace *ns)
static bool
check_conflict (symbol_attribute *attr, const char *name, locus *where)
{
- static const char *dummy = "DUMMY", *save = "SAVE", *pointer = "POINTER",
- *target = "TARGET", *external = "EXTERNAL", *intent = "INTENT",
- *intent_in = "INTENT(IN)", *intrinsic = "INTRINSIC",
+ static const char *dummy = "DUMMY", *save = "SAVE", *automatic = "AUTOMATIC",
+ *pointer = "POINTER", *target = "TARGET", *external = "EXTERNAL",
+ *intent = "INTENT", *intent_in = "INTENT(IN)", *intrinsic = "INTRINSIC",
*intent_out = "INTENT(OUT)", *intent_inout = "INTENT(INOUT)",
*allocatable = "ALLOCATABLE", *elemental = "ELEMENTAL",
*privat = "PRIVATE", *recursive = "RECURSIVE",
@@ -418,6 +418,34 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
}
}
+ if (attr->automatic)
+ {
+ conf (save, automatic);
+ conf (data, automatic);
+
+ switch (attr->flavor)
+ {
+ case FL_PROGRAM:
+ case FL_BLOCK_DATA:
+ case FL_MODULE:
+ case FL_LABEL:
+ case FL_DERIVED:
+ case FL_PARAMETER:
+ a1 = gfc_code2string (flavors, attr->flavor);
+ a2 = save;
+ goto conflict;
+ case FL_NAMELIST:
+ gfc_error ("Namelist group name at %L cannot have the "
+ "AUTOMATIC attribute", where);
+ return false;
+ break;
+ case FL_PROCEDURE:
+ case FL_VARIABLE:
+ default:
+ break;
+ }
+ }
+
if (attr->save == SAVE_EXPLICIT)
{
conf (dummy, save);
@@ -1126,6 +1154,24 @@ gfc_add_save (symbol_attribute *attr, save_state s, const char *name,
return check_conflict (attr, name, where);
}
+bool
+gfc_add_automatic (symbol_attribute *attr, const char *name, locus *where)
+{
+
+ if (check_used (attr, name, where))
+ return false;
+
+ if (attr->automatic)
+ {
+ if (!gfc_notify_std (GFC_STD_LEGACY,
+ "Duplicate AUTOMATIC attribute specified at %L",
+ where))
+ return false;
+ }
+
+ attr->automatic = 1;
+ return check_conflict (attr, name, where);
+}
bool
gfc_add_value (symbol_attribute *attr, const char *name, locus *where)
@@ -1748,6 +1794,8 @@ gfc_copy_attr (symbol_attribute *dest, symbol_attribute *src, locus *where)
goto fail;
if (src->save && !gfc_add_save (dest, src->save, NULL, where))
goto fail;
+ if (src->automatic && !gfc_add_automatic (dest, NULL, where))
+ goto fail;
if (src->value && !gfc_add_value (dest, NULL, where))
goto fail;
if (src->volatile_ && !gfc_add_volatile (dest, NULL, where))
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index f974c6e..002b69e 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -594,6 +594,7 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
if (!sym->ns->proc_name->attr.recursive
&& INTEGER_CST_P (DECL_SIZE_UNIT (decl))
&& !gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl))
+ && !sym->attr.automatic
/* Put variable length auto array pointers always into stack. */
&& (TREE_CODE (TREE_TYPE (decl)) != POINTER_TYPE
|| sym->attr.dimension == 0
--
1.8.4
More information about the Fortran
mailing list