aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorCraig Burley <burley@gnu.org>1998-06-30 07:59:40 +0000
committerDave Love <d.love@dl.ac.uk>1998-06-30 07:59:40 +0000
commit9c87ea4e684ba7d6a9c322c7cb5500fb1d258e5f (patch)
treebadf945c7c86aa03d0d5e89459b31761502c8973
parent84eae89df76e72b23fbe8b04f732fdbd3027763b (diff)
Mon Jun 29 09:47:33 1998 Craig Burley <burley@gnu.org>
Fix 980628-*.f: * bld.h: New `pad' field and accessor macros for ACCTER, ARRTER, and CONTER ops. * bld.c (ffebld_new_accter, ffebld_new_arrter, ffebld_new_conter_with_orig): Initialize `pad' field to zero. * com.c (ffecom_transform_common_): Include initial padding (aka modulo aka offset) in size calculation. Copy initial padding value into FFE initialization expression so the GBE transformation of that expression includes it. Make array low bound 0 instead of 1, for consistency. (ffecom_transform_equiv_): Include initial padding (aka modulo aka offset) in size calculation. Copy initial padding value into FFE initialization expression so the GBE transformation of that expression includes it. Make array low bound 0 instead of 1, for consistency. (ffecom_expr_, case FFEBLD_opACCTER): Delete unused `size' variable. Track destination offset separately, allowing for initial padding. Don't bother setting initial PURPOSE offset if zero. Include initial padding in size calculation. (ffecom_expr_, case FFEBLD_opARRTER): Allow for initial padding. Include initial padding in size calculation. Make array low bound 0 instead of 1, for consistency. (ffecom_finish_global_): Make array low bound 0 instead of 1, for consistency. (ffecom_notify_init_storage): Copy `pad' field from old ACCTER to new ARRTER. (ffecom_notify_init_symbol): Ditto. * data.c (ffedata_gather_): Initialize `pad' field in new ARRTER to 0. (ffedata_value_): Ditto. * equiv.c (ffeequiv_layout_local_): When lowering start of equiv area, extend lowering to maintain needed alignment. * target.c (ffetarget_align): Handle negative offset correctly. * global.c (ffeglobal_pad_common): Warn about non-zero padding only the first time its seen. If new padding larger than old, update old. (ffeglobal_save_common): Use correct type for size throughout. * global.h: Use correct type for size throughout. (ffeglobal_common_pad): New macro. (ffeglobal_pad): Delete this unused and broken macro. git-svn-id: https://gcc.gnu.org/svn/gcc/trunk@20817 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r--gcc/f/ChangeLog48
-rw-r--r--gcc/f/bld.c3
-rw-r--r--gcc/f/bld.h9
-rw-r--r--gcc/f/com.c121
-rw-r--r--gcc/f/data.c6
-rw-r--r--gcc/f/equiv.c16
-rw-r--r--gcc/f/global.c55
-rw-r--r--gcc/f/global.h6
-rw-r--r--gcc/f/news.texi7
-rw-r--r--gcc/f/target.c26
-rw-r--r--gcc/f/version.c2
11 files changed, 239 insertions, 60 deletions
diff --git a/gcc/f/ChangeLog b/gcc/f/ChangeLog
index c6cafbf4f81..b4821f78632 100644
--- a/gcc/f/ChangeLog
+++ b/gcc/f/ChangeLog
@@ -1,3 +1,51 @@
+Mon Jun 29 09:47:33 1998 Craig Burley <burley@gnu.org>
+
+ Fix 980628-*.f:
+ * bld.h: New `pad' field and accessor macros for
+ ACCTER, ARRTER, and CONTER ops.
+ * bld.c (ffebld_new_accter, ffebld_new_arrter,
+ ffebld_new_conter_with_orig): Initialize `pad' field
+ to zero.
+ * com.c (ffecom_transform_common_): Include initial
+ padding (aka modulo aka offset) in size calculation.
+ Copy initial padding value into FFE initialization expression
+ so the GBE transformation of that expression includes it.
+ Make array low bound 0 instead of 1, for consistency.
+ (ffecom_transform_equiv_): Include initial
+ padding (aka modulo aka offset) in size calculation.
+ Copy initial padding value into FFE initialization expression
+ so the GBE transformation of that expression includes it.
+ Make array low bound 0 instead of 1, for consistency.
+ (ffecom_expr_, case FFEBLD_opACCTER): Delete unused `size'
+ variable.
+ Track destination offset separately, allowing for
+ initial padding.
+ Don't bother setting initial PURPOSE offset if zero.
+ Include initial padding in size calculation.
+ (ffecom_expr_, case FFEBLD_opARRTER): Allow for
+ initial padding.
+ Include initial padding in size calculation.
+ Make array low bound 0 instead of 1, for consistency.
+ (ffecom_finish_global_): Make array low bound 0 instead
+ of 1, for consistency.
+ (ffecom_notify_init_storage): Copy `pad' field from old
+ ACCTER to new ARRTER.
+ (ffecom_notify_init_symbol): Ditto.
+ * data.c (ffedata_gather_): Initialize `pad' field in new
+ ARRTER to 0.
+ (ffedata_value_): Ditto.
+ * equiv.c (ffeequiv_layout_local_): When lowering start
+ of equiv area, extend lowering to maintain needed alignment.
+ * target.c (ffetarget_align): Handle negative offset correctly.
+
+ * global.c (ffeglobal_pad_common): Warn about non-zero
+ padding only the first time its seen.
+ If new padding larger than old, update old.
+ (ffeglobal_save_common): Use correct type for size throughout.
+ * global.h: Use correct type for size throughout.
+ (ffeglobal_common_pad): New macro.
+ (ffeglobal_pad): Delete this unused and broken macro.
+
Fri Jun 26 11:54:19 1998 Craig Burley <burley@gnu.org>
* g77spec.c (lang_specific_driver): Put `-lg2c' in
diff --git a/gcc/f/bld.c b/gcc/f/bld.c
index e8002b8e10f..6e756928919 100644
--- a/gcc/f/bld.c
+++ b/gcc/f/bld.c
@@ -5507,6 +5507,7 @@ ffebld_new_accter (ffebldConstantArray a, ffebit b)
x->op = FFEBLD_opACCTER;
x->u.accter.array = a;
x->u.accter.bits = b;
+ x->u.accter.pad = 0;
return x;
}
@@ -5529,6 +5530,7 @@ ffebld_new_arrter (ffebldConstantArray a, ffetargetOffset size)
x->op = FFEBLD_opARRTER;
x->u.arrter.array = a;
x->u.arrter.size = size;
+ x->u.arrter.pad = 0;
return x;
}
@@ -5550,6 +5552,7 @@ ffebld_new_conter_with_orig (ffebldConstant c, ffebld o)
x->op = FFEBLD_opCONTER;
x->u.conter.expr = c;
x->u.conter.orig = o;
+ x->u.conter.pad = 0;
return x;
}
diff --git a/gcc/f/bld.h b/gcc/f/bld.h
index 406ac58c9e7..d3b613efac2 100644
--- a/gcc/f/bld.h
+++ b/gcc/f/bld.h
@@ -418,18 +418,21 @@ struct _ffebld_
{
ffebldConstant expr;
ffebld orig; /* Original expression, or NULL if none. */
+ ffetargetAlign pad; /* Initial padding (for DATA, etc.). */
}
conter;
struct
{
ffebldConstantArray array;
ffetargetOffset size;
+ ffetargetAlign pad; /* Initial padding (for DATA, etc.). */
}
arrter;
struct
{
ffebldConstantArray array;
ffebit bits;
+ ffetargetAlign pad; /* Initial padding (for DATA, etc.). */
}
accter;
struct
@@ -732,13 +735,17 @@ ffetargetCharacterSize ffebld_size_max (ffebld b);
#define ffebld_accter(b) ((b)->u.accter.array)
#define ffebld_accter_bits(b) ((b)->u.accter.bits)
+#define ffebld_accter_pad(b) ((b)->u.accter.pad)
#define ffebld_accter_set_bits(b,bt) ((b)->u.accter.bits = (bt))
+#define ffebld_accter_set_pad(b,p) ((b)->u.accter.pad = (p))
#define ffebld_accter_size(b) ffebit_size((b)->u.accter.bits)
#define ffebld_append_item(b,i) (**(b) = ffebld_new_item((i),NULL), \
*(b) = &((**(b))->u.item.trail))
#define ffebld_arity(b) ffebld_arity_op(ffebld_op(b))
#define ffebld_arity_op(o) (ffebld_arity_op_[o])
#define ffebld_arrter(b) ((b)->u.arrter.array)
+#define ffebld_arrter_pad(b) ((b)->u.arrter.pad)
+#define ffebld_arrter_set_pad(b,p) ((b)->u.arrter.pad = (p))
#define ffebld_arrter_set_size(b,s) ((b)->u.arrter.size = (s))
#define ffebld_arrter_size(b) ((b)->u.arrter.size)
#if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstPROGUNIT_
@@ -827,7 +834,9 @@ ffetargetCharacterSize ffebld_size_max (ffebld b);
#define ffebld_constant_union(c) ((c)->u)
#define ffebld_conter(b) ((b)->u.conter.expr)
#define ffebld_conter_orig(b) ((b)->u.conter.orig)
+#define ffebld_conter_pad(b) ((b)->u.conter.pad)
#define ffebld_conter_set_orig(b,o) ((b)->u.conter.orig = (o))
+#define ffebld_conter_set_pad(b,p) ((b)->u.conter.pad = (p))
#define ffebld_copy(b) (b) /* ~~~Someday really make a copy. */
#define ffebld_cu_ptr_typeless(u) &(u).typeless
#define ffebld_cu_ptr_hollerith(u) &(u).hollerith
diff --git a/gcc/f/com.c b/gcc/f/com.c
index 3bb4921ea06..e6e4f6ec33b 100644
--- a/gcc/f/com.c
+++ b/gcc/f/com.c
@@ -2771,10 +2771,12 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
ffebitCount i;
ffebit bits = ffebld_accter_bits (expr);
ffetargetOffset source_offset = 0;
- size_t size;
+ ffetargetOffset dest_offset = ffebld_accter_pad (expr);
tree purpose;
- size = ffetype_size (ffeinfo_type (bt, kt));
+ assert (dest_offset == 0
+ || (bt == FFEINFO_basictypeCHARACTER
+ && kt == FFEINFO_kindtypeCHARACTER1));
list = item = NULL;
for (;;)
@@ -2797,8 +2799,9 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
t = ffecom_constantunion (&cu, bt, kt, tree_type);
- if (i == 0)
- purpose = build_int_2 (source_offset, 0);
+ if (i == 0
+ && dest_offset != 0)
+ purpose = build_int_2 (dest_offset, 0);
else
purpose = NULL_TREE;
@@ -2812,10 +2815,12 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
}
}
source_offset += length;
+ dest_offset += length;
}
}
- item = build_int_2 (ffebld_accter_size (expr), 0);
+ item = build_int_2 ((ffebld_accter_size (expr)
+ + ffebld_accter_pad (expr)) - 1, 0);
ffebit_kill (ffebld_accter_bits (expr));
TREE_TYPE (item) = ffecom_integer_type_node;
item
@@ -2833,7 +2838,18 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
{
ffetargetOffset i;
- list = item = NULL_TREE;
+ list = NULL_TREE;
+ if (ffebld_arrter_pad (expr) == 0)
+ item = NULL_TREE;
+ else
+ {
+ assert (bt == FFEINFO_basictypeCHARACTER
+ && kt == FFEINFO_kindtypeCHARACTER1);
+
+ /* Becomes PURPOSE first time through loop. */
+ item = build_int_2 (ffebld_arrter_pad (expr), 0);
+ }
+
for (i = 0; i < ffebld_arrter_size (expr); ++i)
{
ffebldConstantUnion cu
@@ -2842,7 +2858,8 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
t = ffecom_constantunion (&cu, bt, kt, tree_type);
if (list == NULL_TREE)
- list = item = build_tree_list (NULL_TREE, t);
+ /* Assume item is PURPOSE first time through loop. */
+ list = item = build_tree_list (item, t);
else
{
TREE_CHAIN (item) = build_tree_list (NULL_TREE, t);
@@ -2851,13 +2868,14 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
}
}
- item = build_int_2 (ffebld_arrter_size (expr), 0);
+ item = build_int_2 ((ffebld_arrter_size (expr)
+ + ffebld_arrter_pad (expr)) - 1, 0);
TREE_TYPE (item) = ffecom_integer_type_node;
item
= build_array_type
(tree_type,
build_range_type (ffecom_integer_type_node,
- ffecom_integer_one_node,
+ ffecom_integer_zero_node,
item));
list = build (CONSTRUCTOR, item, NULL_TREE, list);
TREE_CONSTANT (list) = 1;
@@ -6654,11 +6672,13 @@ ffecom_finish_global_ (ffeglobal global)
/* Give the array a size now. */
- size = build_int_2 (ffeglobal_common_size (global), 0);
+ size = build_int_2 ((ffeglobal_common_size (global)
+ + ffeglobal_common_pad (global)) - 1,
+ 0);
cbtype = TREE_TYPE (cbt);
TYPE_DOMAIN (cbtype) = build_range_type (integer_type_node,
- integer_one_node,
+ integer_zero_node,
size);
if (!TREE_TYPE (size))
TREE_TYPE (size) = TYPE_DOMAIN (cbtype);
@@ -9199,6 +9219,7 @@ ffecom_transform_common_ (ffesymbol s)
tree cbt;
tree cbtype;
tree init;
+ tree high;
bool is_init = ffestorag_is_init (st);
assert (st != NULL);
@@ -9231,7 +9252,30 @@ ffecom_transform_common_ (ffesymbol s)
{
if (ffestorag_init (st) != NULL)
{
- init = ffecom_expr (ffestorag_init (st));
+ ffebld sexp;
+
+ /* Set the padding for the expression, so ffecom_expr
+ knows to insert that many zeros. */
+ switch (ffebld_op (sexp = ffestorag_init (st)))
+ {
+ case FFEBLD_opCONTER:
+ ffebld_conter_set_pad (sexp, ffestorag_modulo (st));
+ break;
+
+ case FFEBLD_opARRTER:
+ ffebld_arrter_set_pad (sexp, ffestorag_modulo (st));
+ break;
+
+ case FFEBLD_opACCTER:
+ ffebld_accter_set_pad (sexp, ffestorag_modulo (st));
+ break;
+
+ default:
+ assert ("bad op for cmn init (pad)" == NULL);
+ break;
+ }
+
+ init = ffecom_expr (sexp);
if (init == error_mark_node)
{ /* Hopefully the back end complained! */
init = NULL_TREE;
@@ -9250,13 +9294,16 @@ ffecom_transform_common_ (ffesymbol s)
/* cbtype must be permanently allocated! */
+ /* Allocate the MAX of the areas so far, seen filewide. */
+ high = build_int_2 ((ffeglobal_common_size (g)
+ + ffeglobal_common_pad (g)) - 1, 0);
+ TREE_TYPE (high) = ffecom_integer_type_node;
+
if (init)
cbtype = build_array_type (char_type_node,
build_range_type (integer_type_node,
- integer_one_node,
- build_int_2
- (ffeglobal_common_size (g),
- 0)));
+ integer_zero_node,
+ high));
else
cbtype = build_array_type (char_type_node, NULL_TREE);
@@ -9308,7 +9355,8 @@ ffecom_transform_common_ (ffesymbol s)
DECL_SIZE (cbt),
size_int (BITS_PER_UNIT));
assert (TREE_INT_CST_HIGH (size_tree) == 0);
- assert (TREE_INT_CST_LOW (size_tree) == ffeglobal_common_size (g));
+ assert (TREE_INT_CST_LOW (size_tree)
+ == ffeglobal_common_size (g) + ffeglobal_common_pad (g));
}
ffeglobal_set_hook (g, cbt);
@@ -9346,7 +9394,30 @@ ffecom_transform_equiv_ (ffestorag eqst)
{
if (ffestorag_init (eqst) != NULL)
{
- init = ffecom_expr (ffestorag_init (eqst));
+ ffebld sexp;
+
+ /* Set the padding for the expression, so ffecom_expr
+ knows to insert that many zeros. */
+ switch (ffebld_op (sexp = ffestorag_init (eqst)))
+ {
+ case FFEBLD_opCONTER:
+ ffebld_conter_set_pad (sexp, ffestorag_modulo (eqst));
+ break;
+
+ case FFEBLD_opARRTER:
+ ffebld_arrter_set_pad (sexp, ffestorag_modulo (eqst));
+ break;
+
+ case FFEBLD_opACCTER:
+ ffebld_accter_set_pad (sexp, ffestorag_modulo (eqst));
+ break;
+
+ default:
+ assert ("bad op for eqv init (pad)" == NULL);
+ break;
+ }
+
+ init = ffecom_expr (sexp);
if (init == error_mark_node)
init = NULL_TREE; /* Hopefully the back end complained! */
}
@@ -9365,12 +9436,13 @@ ffecom_transform_equiv_ (ffestorag eqst)
yes = suspend_momentary ();
- high = build_int_2 (ffestorag_size (eqst), 0);
+ high = build_int_2 ((ffestorag_size (eqst)
+ + ffestorag_modulo (eqst)) - 1, 0);
TREE_TYPE (high) = ffecom_integer_type_node;
eqtype = build_array_type (char_type_node,
build_range_type (ffecom_integer_type_node,
- ffecom_integer_one_node,
+ ffecom_integer_zero_node,
high));
eqt = build_decl (VAR_DECL,
@@ -9429,7 +9501,8 @@ ffecom_transform_equiv_ (ffestorag eqst)
DECL_SIZE (eqt),
size_int (BITS_PER_UNIT));
assert (TREE_INT_CST_HIGH (size_tree) == 0);
- assert (TREE_INT_CST_LOW (size_tree) == ffestorag_size (eqst));
+ assert (TREE_INT_CST_LOW (size_tree)
+ == ffestorag_size (eqst) + ffestorag_modulo (eqst));
}
ffestorag_set_hook (eqst, eqt);
@@ -12842,6 +12915,7 @@ ffecom_notify_init_storage (ffestorag st)
ffebld init; /* The initialization expression. */
#if 0 && FFECOM_targetCURRENT == FFECOM_targetGCC
ffetargetOffset size; /* The size of the entity. */
+ ffetargetAlign pad; /* Its initial padding. */
#endif
if (ffestorag_init (st) == NULL)
@@ -12854,10 +12928,12 @@ ffecom_notify_init_storage (ffestorag st)
#if 0 && FFECOM_targetCURRENT == FFECOM_targetGCC
/* For GNU backend, just turn ACCTER into ARRTER and proceed. */
size = ffebld_accter_size (init);
+ pad = ffebld_accter_pad (init);
ffebit_kill (ffebld_accter_bits (init));
ffebld_set_op (init, FFEBLD_opARRTER);
ffebld_set_arrter (init, ffebld_accter (init));
ffebld_arrter_set_size (init, size);
+ ffebld_arrter_set_pad (init, size);
#endif
#if FFECOM_TWOPASS
@@ -12928,6 +13004,7 @@ ffecom_notify_init_symbol (ffesymbol s)
ffebld init; /* The initialization expression. */
#if 0 && FFECOM_targetCURRENT == FFECOM_targetGCC
ffetargetOffset size; /* The size of the entity. */
+ ffetargetAlign pad; /* Its initial padding. */
#endif
if (ffesymbol_storage (s) == NULL)
@@ -12943,10 +13020,12 @@ ffecom_notify_init_symbol (ffesymbol s)
#if 0 && FFECOM_targetCURRENT == FFECOM_targetGCC
/* For GNU backend, just turn ACCTER into ARRTER and proceed. */
size = ffebld_accter_size (init);
+ pad = ffebld_accter_pad (init);
ffebit_kill (ffebld_accter_bits (init));
ffebld_set_op (init, FFEBLD_opARRTER);
ffebld_set_arrter (init, ffebld_accter (init));
ffebld_arrter_set_size (init, size);
+ ffebld_arrter_set_pad (init, size);
#endif
#if FFECOM_TWOPASS
diff --git a/gcc/f/data.c b/gcc/f/data.c
index 60cf1aea1a0..a8acd5c64cd 100644
--- a/gcc/f/data.c
+++ b/gcc/f/data.c
@@ -1276,6 +1276,7 @@ ffedata_gather_ (ffestorag mst, ffestorag st)
ffebld_accter (ffestorag_init (mst)));
ffebld_arrter_set_size (ffestorag_init (mst),
ffedata_storage_size_);
+ ffebld_arrter_set_pad (ffestorag_init (mst), 0);
ffecom_notify_init_storage (mst);
}
@@ -1316,6 +1317,7 @@ ffedata_gather_ (ffestorag mst, ffestorag st)
ffebld_accter (ffestorag_init (mst)));
ffebld_arrter_set_size (ffestorag_init (mst),
ffedata_storage_size_);
+ ffebld_arrter_set_pad (ffestorag_init (mst), 0);
ffecom_notify_init_storage (mst);
}
@@ -1377,6 +1379,7 @@ ffedata_gather_ (ffestorag mst, ffestorag st)
ffebld_accter (ffestorag_init (mst)));
ffebld_arrter_set_size (ffestorag_init (mst),
ffedata_storage_size_);
+ ffebld_arrter_set_pad (ffestorag_init (mst), 0);
ffecom_notify_init_storage (mst);
}
@@ -1658,6 +1661,8 @@ ffedata_value_ (ffebld value, ffelexToken token)
ffebld_accter (ffestorag_init (ffedata_storage_)));
ffebld_arrter_set_size (ffestorag_init (ffedata_storage_),
ffedata_storage_size_);
+ ffebld_arrter_set_pad (ffestorag_init (ffedata_storage_),
+ 0);
ffecom_notify_init_storage (ffedata_storage_);
}
}
@@ -1794,6 +1799,7 @@ ffedata_value_ (ffebld value, ffelexToken token)
ffebld_accter (ffesymbol_init (ffedata_symbol_)));
ffebld_arrter_set_size (ffesymbol_init (ffedata_symbol_),
ffedata_symbolsize_);
+ ffebld_arrter_set_pad (ffestorag_init (ffedata_symbol_), 0);
ffecom_notify_init_symbol (ffedata_symbol_);
}
}
diff --git a/gcc/f/equiv.c b/gcc/f/equiv.c
index 33f2eed6065..9fd856bd024 100644
--- a/gcc/f/equiv.c
+++ b/gcc/f/equiv.c
@@ -435,18 +435,26 @@ ffeequiv_layout_local_ (ffeequiv eq)
{
ffetargetOffset new_size;
+ /* First, calculate the initial padding necessary
+ to preserve the current alignment/modulo requirements
+ for the storage area. */
+ pad = (-item_offset) % ffestorag_alignment (st);
+ if (pad != 0)
+ pad = ffestorag_alignment (st) - pad;
+
/* Increase size of equiv area to start for lower offset relative
to root symbol. */
-
- if (!ffetarget_offset_add (&new_size,
- ffestorag_offset (st) - item_offset,
+ if (! ffetarget_offset_add (&new_size,
+ (ffestorag_offset (st)
+ - item_offset)
+ + pad,
ffestorag_size (st)))
ffetarget_offset_overflow (ffesymbol_text (s));
else
ffestorag_set_size (st, new_size);
ffestorag_set_symbol (st, item_sym);
- ffestorag_set_offset (st, item_offset);
+ ffestorag_set_offset (st, item_offset - pad);
#if FFEEQUIV_DEBUG
fprintf (stderr, " [eq offset=%" ffetargetOffset_f
diff --git a/gcc/f/global.c b/gcc/f/global.c
index 932a9d83387..8be7d0c4c66 100644
--- a/gcc/f/global.c
+++ b/gcc/f/global.c
@@ -437,6 +437,20 @@ ffeglobal_pad_common (ffesymbol s, ffetargetAlign pad, ffewhereLine wl,
g->u.common.pad = pad;
g->u.common.pad_where_line = ffewhere_line_use (wl);
g->u.common.pad_where_col = ffewhere_column_use (wc);
+
+ if (pad != 0)
+ {
+ char padding[20];
+
+ sprintf (&padding[0], "%" ffetargetAlign_f "u", pad);
+ ffebad_start (FFEBAD_COMMON_INIT_PAD);
+ ffebad_string (ffesymbol_text (s));
+ ffebad_string (padding);
+ ffebad_string ((pad == 1)
+ ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
+ ffebad_here (0, wl, wc);
+ ffebad_finish ();
+ }
}
else
{
@@ -459,22 +473,15 @@ ffeglobal_pad_common (ffesymbol s, ffetargetAlign pad, ffewhereLine wl,
ffebad_here (1, g->u.common.pad_where_line, g->u.common.pad_where_col);
ffebad_finish ();
}
- }
-#endif
-
- if (pad != 0)
- { /* Warn about initial padding in common area. */
- char padding[20];
- sprintf (&padding[0], "%" ffetargetAlign_f "u", pad);
- ffebad_start (FFEBAD_COMMON_INIT_PAD);
- ffebad_string (ffesymbol_text (s));
- ffebad_string (padding);
- ffebad_string ((pad == 1)
- ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
- ffebad_here (0, wl, wc);
- ffebad_finish ();
+ if (g->u.common.pad < pad)
+ {
+ g->u.common.pad = pad;
+ g->u.common.pad_where_line = ffewhere_line_use (wl);
+ g->u.common.pad_where_col = ffewhere_column_use (wc);
+ }
}
+#endif
}
/* Collect info for a global's argument. */
@@ -1424,7 +1431,7 @@ ffeglobal_save_common (ffesymbol s, bool save, ffewhereLine wl,
/* ffeglobal_size_common -- Establish size of COMMON area
ffesymbol s; // the common area
- long size; // size in units
+ ffetargetOffset size; // size in units
if (ffeglobal_size_common(s,size)) // new size is largest seen
In global-enabled mode, set the size if it current size isn't known or is
@@ -1435,7 +1442,7 @@ ffeglobal_save_common (ffesymbol s, bool save, ffewhereLine wl,
#if FFEGLOBAL_ENABLED
bool
-ffeglobal_size_common (ffesymbol s, long size)
+ffeglobal_size_common (ffesymbol s, ffetargetOffset size)
{
ffeglobal g;
@@ -1452,13 +1459,18 @@ ffeglobal_size_common (ffesymbol s, long size)
return TRUE;
}
- if ((g->u.common.size < size) && (g->tick > 0) && (g->tick < ffe_count_2))
+ if ((g->tick > 0) && (g->tick < ffe_count_2)
+ && (g->u.common.size < size))
{
char oldsize[40];
char newsize[40];
- sprintf (&oldsize[0], "%ld", g->u.common.size);
- sprintf (&newsize[0], "%ld", size);
+ /* Common block initialized in a previous program unit, which
+ effectively freezes its size, but now the program is trying
+ to enlarge it. */
+
+ sprintf (&oldsize[0], "%" ffetargetOffset_f "d", g->u.common.size);
+ sprintf (&newsize[0], "%" ffetargetOffset_f "d", size);
ffebad_start (FFEBAD_COMMON_ENLARGED);
ffebad_string (ffesymbol_text (s));
@@ -1490,8 +1502,8 @@ ffeglobal_size_common (ffesymbol s, long size)
that way. Warnings about differing sizes must therefore
always be issued. */
- sprintf (&oldsize[0], "%ld", g->u.common.size);
- sprintf (&newsize[0], "%ld", size);
+ sprintf (&oldsize[0], "%" ffetargetOffset_f "d", g->u.common.size);
+ sprintf (&newsize[0], "%" ffetargetOffset_f "d", size);
ffebad_start (FFEBAD_COMMON_DIFF_SIZE);
ffebad_string (ffesymbol_text (s));
@@ -1513,6 +1525,7 @@ ffeglobal_size_common (ffesymbol s, long size)
g->u.common.size = size;
return TRUE;
}
+
return FALSE;
}
diff --git a/gcc/f/global.h b/gcc/f/global.h
index d0ac871b71c..38cf8d55cfc 100644
--- a/gcc/f/global.h
+++ b/gcc/f/global.h
@@ -108,7 +108,7 @@ struct _ffeglobal_
ffewhereLine save_where_line;
ffewhereColumn save_where_col;
bool have_size; /* Size info avail for COMMON? */
- long size; /* Size info for COMMON. */
+ ffetargetOffset size; /* Size info for COMMON. */
bool blank; /* TRUE if blank COMMON. */
} common;
struct {
@@ -148,7 +148,7 @@ void ffeglobal_ref_intrinsic (ffesymbol s, ffelexToken t, bool explicit);
bool ffeglobal_ref_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type);
void ffeglobal_save_common (ffesymbol s, bool save, ffewhereLine wl,
ffewhereColumn wc);
-bool ffeglobal_size_common (ffesymbol s, long size);
+bool ffeglobal_size_common (ffesymbol s, ffetargetOffset size);
void ffeglobal_terminate_1 (void);
/* Define macros. */
@@ -164,6 +164,7 @@ void ffeglobal_terminate_1 (void);
#define ffeglobal_common_init(g) ((g)->tick != 0)
#define ffeglobal_common_have_pad(g) ((g)->u.common.have_pad)
#define ffeglobal_common_have_size(g) ((g)->u.common.have_size)
+#define ffeglobal_common_pad(g) ((g)->u.common.pad)
#define ffeglobal_common_size(g) ((g)->u.common.size)
#define ffeglobal_hook(g) ((g)->hook)
#define ffeglobal_init_0()
@@ -178,7 +179,6 @@ void ffeglobal_terminate_1 (void);
ffeglobal_new_progunit_(s,t,FFEGLOBAL_typeMAIN)
#define ffeglobal_new_subroutine(s,t) \
ffeglobal_new_progunit_(s,t,FFEGLOBAL_typeSUBR)
-#define ffeglobal_pad(g) ((g)->pad)
#define ffeglobal_ref_blockdata(s,t) \
ffeglobal_ref_progunit_(s,t,FFEGLOBAL_typeBDATA)
#define ffeglobal_ref_external(s,t) \
diff --git a/gcc/f/news.texi b/gcc/f/news.texi
index 05cb258205e..b64ba3d3d1f 100644
--- a/gcc/f/news.texi
+++ b/gcc/f/news.texi
@@ -58,6 +58,13 @@ when the generated code wants to link to the one
in @code{libf2c} (@code{libg2c}).
@item
+@code{g77} no longer produces incorrect code
+and initial values
+for @samp{EQUIVALENCE} and @samp{COMMON}
+aggregates that, due to ``unnatural'' ordering of members
+vis-a-vis their types, require initial padding.
+
+@item
@code{g77} no longer crashes when compiling code
containing specification statements such as
@samp{INTEGER(KIND=7) PTR}.
diff --git a/gcc/f/target.c b/gcc/f/target.c
index b66fdc8907b..2244dbc1fad 100644
--- a/gcc/f/target.c
+++ b/gcc/f/target.c
@@ -217,14 +217,16 @@ ffetarget_align (ffetargetAlign *updated_alignment,
assert (*updated_modulo < *updated_alignment);
assert (modulo < alignment);
- /* The easy case: similar alignment requirements. */
-
+ /* The easy case: similar alignment requirements. */
if (*updated_alignment == alignment)
{
if (modulo > *updated_modulo)
pad = alignment - (modulo - *updated_modulo);
else
pad = *updated_modulo - modulo;
+ if (offset < 0)
+ /* De-negatize offset, since % wouldn't do the expected thing. */
+ offset = alignment - ((- offset) % alignment);
pad = (offset + pad) % alignment;
if (pad != 0)
pad = alignment - pad;
@@ -240,7 +242,12 @@ ffetarget_align (ffetargetAlign *updated_alignment,
cnt = ua / alignment;
- min_pad = ~(ffetargetAlign) 0;/* Set to largest value. */
+ if (offset < 0)
+ /* De-negatize offset, since % wouldn't do the expected thing. */
+ offset = ua - ((- offset) % ua);
+
+ /* Set to largest value. */
+ min_pad = ~(ffetargetAlign) 0;
/* Find all combinations of modulo values the two alignment requirements
have; pick the combination that results in the smallest padding
@@ -251,21 +258,20 @@ ffetarget_align (ffetargetAlign *updated_alignment,
{
for (m = modulo, j = 0; j < cnt; m += alignment, ++j)
{
- if (m > um) /* This code is similar to the "easy case"
- code above. */
+ /* This code is similar to the "easy case" code above. */
+ if (m > um)
pad = ua - (m - um);
else
pad = um - m;
pad = (offset + pad) % ua;
- if (pad != 0)
- pad = ua - pad;
- else
- { /* A zero pad means we've got something
- useful. */
+ if (pad == 0)
+ {
+ /* A zero pad means we've got something useful. */
*updated_alignment = ua;
*updated_modulo = um;
return 0;
}
+ pad = ua - pad;
if (pad < min_pad)
{ /* New minimum padding value. */
min_pad = pad;
diff --git a/gcc/f/version.c b/gcc/f/version.c
index 4292522d90c..fbec2902f45 100644
--- a/gcc/f/version.c
+++ b/gcc/f/version.c
@@ -1 +1 @@
-char *ffe_version_string = "0.5.23";
+char *ffe_version_string = "0.5.24-19980629";