Fix 980628-*.f:
authorCraig Burley <burley@gnu.org>
Tue, 30 Jun 1998 07:59:40 +0000 (03:59 -0400)
committerDave Love <fx@gcc.gnu.org>
Tue, 30 Jun 1998 07:59:40 +0000 (07:59 +0000)
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

gcc/f/ChangeLog
gcc/f/bld.c
gcc/f/bld.h
gcc/f/com.c
gcc/f/data.c
gcc/f/equiv.c
gcc/f/global.c
gcc/f/global.h
gcc/f/news.texi
gcc/f/target.c
gcc/f/version.c

index c6cafbf4f81aa323ae2288a37fbb9b038f8d0f6e..b4821f7863297a26a04b35627c929ef3845faffa 100644 (file)
@@ -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
index e8002b8e10fa09ed0f2cf5f532263c892ef194e6..6e756928919921b9bc0984a706e5d87bc53bce76 100644 (file)
@@ -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;
 }
 
index 406ac58c9e718f9edbccb0a0e1b3bbf2afe0f8f9..d3b613efac24aa986b03bb1789315bd38c0080c1 100644 (file)
@@ -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
index 3bb4921ea062e497ce32fe0bb046f0f3b303c5dc..e6e4f6ec33b23edac5d773f60a6df890a82124a4 100644 (file)
@@ -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
index 60cf1aea1a050a02624ccd174b53da11fc6c533c..a8acd5c64cdd06710471fd437abf1da7bb5f8ecc 100644 (file)
@@ -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_);
        }
     }
index 33f2eed6065d53f7145cd9c66f44b7497926b507..9fd856bd0244cde2204f692c0ba77eea917cc546 100644 (file)
@@ -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
index 932a9d83387d84443aab77031ad6b80f4ba96814..8be7d0c4c66cdf922b40abd033d20fa4d69e345c 100644 (file)
@@ -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;
 }
 
index d0ac871b71c9e8e1cc24e98f45df7ac86f177a82..38cf8d55cfc001c368df506ece217b9a4d020061 100644 (file)
@@ -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) \
index 05cb258205e5079dfd27def1e60e3c2298208048..b64ba3d3d1fc420485d7c2e70363191deaa1091e 100644 (file)
@@ -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
index b66fdc8907b05998cf330bd16be6e8b9cc0e2d9e..2244dbc1fad803485e7016052781b2db962c1a5b 100644 (file)
@@ -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;
index 4292522d90c04c9c1366d2f36b6f75b1abf84556..fbec2902f45b07e0ec805aebd81328ceaac3eda1 100644 (file)
@@ -1 +1 @@
-char *ffe_version_string = "0.5.23";
+char *ffe_version_string = "0.5.24-19980629";