Fix 980628-*.f:
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. From-SVN: r20817
This commit is contained in:
Craig Burley
Dave Love
parent
145836925d
commit
a6fa642003
11 changed files with 239 additions and 60 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
121
gcc/f/com.c
121
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
|
||||
|
|
|
|||
|
|
@ -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_);
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ();
|
||||
}
|
||||
|
||||
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
|
||||
|
||||
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 ();
|
||||
}
|
||||
}
|
||||
|
||||
/* 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;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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) \
|
||||
|
|
|
|||
|
|
@ -57,6 +57,13 @@ in the SunOS4 @samp{-lm} library
|
|||
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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
char *ffe_version_string = "0.5.23";
|
||||
char *ffe_version_string = "0.5.24-19980629";
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue