aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-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";
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-22 21:05:17 +0000