This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]

egcs-g77 patch set


This patch set should fix the nest of bugs that my `align' program
exposed in g77.  Perhaps with this applied, efforts to figure
out how to improve x86 double-precision alignment will meet with
fewer weird problems when trying out g77.

Dave, could you apply this patch for me?

        tq vm, (burley)


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.


*** g77-e0/gcc/f/bld.c.~1~	Mon Jun 15 22:23:12 1998
--- g77-e0/gcc/f/bld.c	Mon Jun 29 10:11:32 1998
*************** ffebld_new_accter (ffebldConstantArray a
*** 5508,5511 ****
--- 5508,5512 ----
    x->u.accter.array = a;
    x->u.accter.bits = b;
+   x->u.accter.pad = 0;
    return x;
  }
*************** ffebld_new_arrter (ffebldConstantArray a
*** 5530,5533 ****
--- 5531,5535 ----
    x->u.arrter.array = a;
    x->u.arrter.size = size;
+   x->u.arrter.pad = 0;
    return x;
  }
*************** ffebld_new_conter_with_orig (ffebldConst
*** 5551,5554 ****
--- 5553,5557 ----
    x->u.conter.expr = c;
    x->u.conter.orig = o;
+   x->u.conter.pad = 0;
    return x;
  }
*** g77-e0/gcc/f/bld.h.~1~	Mon Jun 15 22:23:13 1998
--- g77-e0/gcc/f/bld.h	Mon Jun 29 10:11:28 1998
*************** struct _ffebld_
*** 419,422 ****
--- 419,423 ----
  	    ffebldConstant expr;
  	    ffebld orig;	/* Original expression, or NULL if none. */
+ 	    ffetargetAlign pad;	/* Initial padding (for DATA, etc.). */
  	  }
  	conter;
*************** struct _ffebld_
*** 425,428 ****
--- 426,430 ----
  	    ffebldConstantArray array;
  	    ffetargetOffset size;
+ 	    ffetargetAlign pad;	/* Initial padding (for DATA, etc.). */
  	  }
  	arrter;
*************** struct _ffebld_
*** 431,434 ****
--- 433,437 ----
  	    ffebldConstantArray array;
  	    ffebit bits;
+ 	    ffetargetAlign pad;	/* Initial padding (for DATA, etc.). */
  	  }
  	accter;
*************** ffetargetCharacterSize ffebld_size_max (
*** 733,737 ****
--- 736,742 ----
  #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),	      \
*************** ffetargetCharacterSize ffebld_size_max (
*** 740,743 ****
--- 745,750 ----
  #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)
*************** ffetargetCharacterSize ffebld_size_max (
*** 828,832 ****
--- 835,841 ----
  #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
*** g77-e0/gcc/f/com.c.~1~	Mon Jun 15 22:23:14 1998
--- g77-e0/gcc/f/com.c	Mon Jun 29 10:11:48 1998
*************** ffecom_expr_ (ffebld expr, tree dest_tre
*** 2772,2779 ****
  	ffebit bits = ffebld_accter_bits (expr);
  	ffetargetOffset source_offset = 0;
! 	size_t size;
  	tree purpose;
  
! 	size = ffetype_size (ffeinfo_type (bt, kt));
  
  	list = item = NULL;
--- 2772,2781 ----
  	ffebit bits = ffebld_accter_bits (expr);
  	ffetargetOffset source_offset = 0;
! 	ffetargetOffset dest_offset = ffebld_accter_pad (expr);
  	tree purpose;
  
! 	assert (dest_offset == 0
! 		|| (bt == FFEINFO_basictypeCHARACTER
! 		    && kt == FFEINFO_kindtypeCHARACTER1));
  
  	list = item = NULL;
*************** ffecom_expr_ (ffebld expr, tree dest_tre
*** 2798,2803 ****
  		    t = ffecom_constantunion (&cu, bt, kt, tree_type);
  
! 		    if (i == 0)
! 		      purpose = build_int_2 (source_offset, 0);
  		    else
  		      purpose = NULL_TREE;
--- 2800,2806 ----
  		    t = ffecom_constantunion (&cu, bt, kt, tree_type);
  
! 		    if (i == 0
! 			&& dest_offset != 0)
! 		      purpose = build_int_2 (dest_offset, 0);
  		    else
  		      purpose = NULL_TREE;
*************** ffecom_expr_ (ffebld expr, tree dest_tre
*** 2813,2820 ****
  	      }
  	    source_offset += length;
  	  }
        }
  
!       item = build_int_2 (ffebld_accter_size (expr), 0);
        ffebit_kill (ffebld_accter_bits (expr));
        TREE_TYPE (item) = ffecom_integer_type_node;
--- 2816,2825 ----
  	      }
  	    source_offset += length;
+ 	    dest_offset += length;
  	  }
        }
  
!       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;
*************** ffecom_expr_ (ffebld expr, tree dest_tre
*** 2834,2838 ****
  	ffetargetOffset i;
  
! 	list = item = NULL_TREE;
  	for (i = 0; i < ffebld_arrter_size (expr); ++i)
  	  {
--- 2839,2854 ----
  	ffetargetOffset i;
  
! 	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)
  	  {
*************** ffecom_expr_ (ffebld expr, tree dest_tre
*** 2843,2847 ****
  
  	    if (list == NULL_TREE)
! 	      list = item = build_tree_list (NULL_TREE, t);
  	    else
  	      {
--- 2859,2864 ----
  
  	    if (list == NULL_TREE)
! 	      /* Assume item is PURPOSE first time through loop.  */
! 	      list = item = build_tree_list (item, t);
  	    else
  	      {
*************** ffecom_expr_ (ffebld expr, tree dest_tre
*** 2852,2856 ****
        }
  
!       item = build_int_2 (ffebld_arrter_size (expr), 0);
        TREE_TYPE (item) = ffecom_integer_type_node;
        item
--- 2869,2874 ----
        }
  
!       item = build_int_2 ((ffebld_arrter_size (expr)
! 			  + ffebld_arrter_pad (expr)) - 1, 0);
        TREE_TYPE (item) = ffecom_integer_type_node;
        item
*************** ffecom_expr_ (ffebld expr, tree dest_tre
*** 2858,2862 ****
  	  (tree_type,
  	   build_range_type (ffecom_integer_type_node,
! 			     ffecom_integer_one_node,
  			     item));
        list = build (CONSTRUCTOR, item, NULL_TREE, list);
--- 2876,2880 ----
  	  (tree_type,
  	   build_range_type (ffecom_integer_type_node,
! 			     ffecom_integer_zero_node,
  			     item));
        list = build (CONSTRUCTOR, item, NULL_TREE, list);
*************** ffecom_finish_global_ (ffeglobal global)
*** 6655,6663 ****
    /* Give the array a size now.  */
  
!   size = build_int_2 (ffeglobal_common_size (global), 0);
  
    cbtype = TREE_TYPE (cbt);
    TYPE_DOMAIN (cbtype) = build_range_type (integer_type_node,
! 					   integer_one_node,
  					   size);
    if (!TREE_TYPE (size))
--- 6673,6683 ----
    /* Give the array a size now.  */
  
!   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_zero_node,
  					   size);
    if (!TREE_TYPE (size))
*************** ffecom_transform_common_ (ffesymbol s)
*** 9200,9203 ****
--- 9220,9224 ----
    tree cbtype;
    tree init;
+   tree high;
    bool is_init = ffestorag_is_init (st);
  
*************** ffecom_transform_common_ (ffesymbol s)
*** 9232,9236 ****
        if (ffestorag_init (st) != NULL)
  	{
! 	  init = ffecom_expr (ffestorag_init (st));
  	  if (init == error_mark_node)
  	    {			/* Hopefully the back end complained! */
--- 9253,9280 ----
        if (ffestorag_init (st) != NULL)
  	{
! 	  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! */
*************** ffecom_transform_common_ (ffesymbol s)
*** 9251,9261 ****
    /* cbtype must be permanently allocated!  */
  
    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)));
    else
      cbtype = build_array_type (char_type_node, NULL_TREE);
--- 9295,9308 ----
    /* 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_zero_node,
! 						 high));
    else
      cbtype = build_array_type (char_type_node, NULL_TREE);
*************** ffecom_transform_common_ (ffesymbol s)
*** 9309,9313 ****
  			      size_int (BITS_PER_UNIT));
        assert (TREE_INT_CST_HIGH (size_tree) == 0);
!       assert (TREE_INT_CST_LOW (size_tree) == ffeglobal_common_size (g));
      }
  
--- 9356,9361 ----
  			      size_int (BITS_PER_UNIT));
        assert (TREE_INT_CST_HIGH (size_tree) == 0);
!       assert (TREE_INT_CST_LOW (size_tree)
! 	      == ffeglobal_common_size (g) + ffeglobal_common_pad (g));
      }
  
*************** ffecom_transform_equiv_ (ffestorag eqst)
*** 9347,9351 ****
        if (ffestorag_init (eqst) != NULL)
  	{
! 	  init = ffecom_expr (ffestorag_init (eqst));
  	  if (init == error_mark_node)
  	    init = NULL_TREE;	/* Hopefully the back end complained! */
--- 9395,9422 ----
        if (ffestorag_init (eqst) != NULL)
  	{
! 	  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! */
*************** ffecom_transform_equiv_ (ffestorag eqst)
*** 9366,9375 ****
    yes = suspend_momentary ();
  
!   high = build_int_2 (ffestorag_size (eqst), 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,
  					       high));
  
--- 9437,9447 ----
    yes = suspend_momentary ();
  
!   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_zero_node,
  					       high));
  
*************** ffecom_transform_equiv_ (ffestorag eqst)
*** 9430,9434 ****
  			    size_int (BITS_PER_UNIT));
      assert (TREE_INT_CST_HIGH (size_tree) == 0);
!     assert (TREE_INT_CST_LOW (size_tree) == ffestorag_size (eqst));
    }
  
--- 9502,9507 ----
  			    size_int (BITS_PER_UNIT));
      assert (TREE_INT_CST_HIGH (size_tree) == 0);
!     assert (TREE_INT_CST_LOW (size_tree)
! 	    == ffestorag_size (eqst) + ffestorag_modulo (eqst));
    }
  
*************** ffecom_notify_init_storage (ffestorag st
*** 12843,12846 ****
--- 12916,12920 ----
  #if 0 && FFECOM_targetCURRENT == FFECOM_targetGCC
    ffetargetOffset size;		/* The size of the entity. */
+   ffetargetAlign pad;		/* Its initial padding. */
  #endif
  
*************** ffecom_notify_init_storage (ffestorag st
*** 12855,12862 ****
--- 12929,12938 ----
        /* 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
  
*************** ffecom_notify_init_symbol (ffesymbol s)
*** 12929,12932 ****
--- 13005,13009 ----
  #if 0 && FFECOM_targetCURRENT == FFECOM_targetGCC
    ffetargetOffset size;		/* The size of the entity. */
+   ffetargetAlign pad;		/* Its initial padding. */
  #endif
  
*************** ffecom_notify_init_symbol (ffesymbol s)
*** 12944,12951 ****
--- 13021,13030 ----
        /* 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
  
*** g77-e0/gcc/f/data.c.~1~	Tue May 19 06:49:24 1998
--- g77-e0/gcc/f/data.c	Mon Jun 29 10:11:48 1998
*************** ffedata_gather_ (ffestorag mst, ffestora
*** 1277,1280 ****
--- 1277,1281 ----
  	  ffebld_arrter_set_size (ffestorag_init (mst),
  				  ffedata_storage_size_);
+ 	  ffebld_arrter_set_pad (ffestorag_init (mst), 0);
  	  ffecom_notify_init_storage (mst);
  	}
*************** ffedata_gather_ (ffestorag mst, ffestora
*** 1317,1320 ****
--- 1318,1322 ----
  	  ffebld_arrter_set_size (ffestorag_init (mst),
  				  ffedata_storage_size_);
+ 	  ffebld_arrter_set_pad (ffestorag_init (mst), 0);
  	  ffecom_notify_init_storage (mst);
  	}
*************** ffedata_gather_ (ffestorag mst, ffestora
*** 1378,1381 ****
--- 1380,1384 ----
  	  ffebld_arrter_set_size (ffestorag_init (mst),
  				  ffedata_storage_size_);
+ 	  ffebld_arrter_set_pad (ffestorag_init (mst), 0);
  	  ffecom_notify_init_storage (mst);
  	}
*************** ffedata_value_ (ffebld value, ffelexToke
*** 1659,1662 ****
--- 1662,1667 ----
  	      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_);
  	    }
*************** ffedata_value_ (ffebld value, ffelexToke
*** 1795,1798 ****
--- 1800,1804 ----
  	  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_);
  	}
*** g77-e0/gcc/f/equiv.c.~1~	Mon Jun 15 22:23:17 1998
--- g77-e0/gcc/f/equiv.c	Mon Jun 29 10:11:48 1998
*************** ffeequiv_layout_local_ (ffeequiv eq)
*** 436,444 ****
  		  ffetargetOffset new_size;
  
  		  /* 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,
  					     ffestorag_size (st)))
  		    ffetarget_offset_overflow (ffesymbol_text (s));
--- 436,452 ----
  		  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)
! 					     + pad,
  					     ffestorag_size (st)))
  		    ffetarget_offset_overflow (ffesymbol_text (s));
*************** ffeequiv_layout_local_ (ffeequiv eq)
*** 447,451 ****
  
  		  ffestorag_set_symbol (st, item_sym);
! 		  ffestorag_set_offset (st, item_offset);
  
  #if FFEEQUIV_DEBUG
--- 455,459 ----
  
  		  ffestorag_set_symbol (st, item_sym);
! 		  ffestorag_set_offset (st, item_offset - pad);
  
  #if FFEEQUIV_DEBUG
*** g77-e0/gcc/f/global.c.~1~	Thu Jun  4 06:41:20 1998
--- g77-e0/gcc/f/global.c	Mon Jun 29 10:11:20 1998
*************** ffeglobal_pad_common (ffesymbol s, ffeta
*** 438,441 ****
--- 438,455 ----
        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
*************** ffeglobal_pad_common (ffesymbol s, ffeta
*** 460,479 ****
  	  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 ();
      }
  }
  
--- 474,486 ----
  	  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
  }
  
*************** ffeglobal_save_common (ffesymbol s, bool
*** 1425,1429 ****
  
     ffesymbol s;	 // the common area
!    long size;  // size in units
     if (ffeglobal_size_common(s,size))  // new size is largest seen
  
--- 1432,1436 ----
  
     ffesymbol s;	 // the common area
!    ffetargetOffset size;  // size in units
     if (ffeglobal_size_common(s,size))  // new size is largest seen
  
*************** ffeglobal_save_common (ffesymbol s, bool
*** 1436,1440 ****
  #if FFEGLOBAL_ENABLED
  bool
! ffeglobal_size_common (ffesymbol s, long size)
  {
    ffeglobal g;
--- 1443,1447 ----
  #if FFEGLOBAL_ENABLED
  bool
! ffeglobal_size_common (ffesymbol s, ffetargetOffset size)
  {
    ffeglobal g;
*************** ffeglobal_size_common (ffesymbol s, long
*** 1453,1463 ****
      }
  
!   if ((g->u.common.size < size) && (g->tick > 0) && (g->tick < ffe_count_2))
      {
        char oldsize[40];
        char newsize[40];
  
!       sprintf (&oldsize[0], "%ld", g->u.common.size);
!       sprintf (&newsize[0], "%ld", size);
  
        ffebad_start (FFEBAD_COMMON_ENLARGED);
--- 1460,1475 ----
      }
  
!   if ((g->tick > 0) && (g->tick < ffe_count_2)
!       && (g->u.common.size < size))
      {
        char oldsize[40];
        char newsize[40];
  
!       /* 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);
*************** ffeglobal_size_common (ffesymbol s, long
*** 1491,1496 ****
  	 always be issued.  */
  
!       sprintf (&oldsize[0], "%ld", g->u.common.size);
!       sprintf (&newsize[0], "%ld", size);
  
        ffebad_start (FFEBAD_COMMON_DIFF_SIZE);
--- 1503,1508 ----
  	 always be issued.  */
  
!       sprintf (&oldsize[0], "%" ffetargetOffset_f "d", g->u.common.size);
!       sprintf (&newsize[0], "%" ffetargetOffset_f "d", size);
  
        ffebad_start (FFEBAD_COMMON_DIFF_SIZE);
*************** ffeglobal_size_common (ffesymbol s, long
*** 1514,1517 ****
--- 1526,1530 ----
        return TRUE;
      }
+ 
    return FALSE;
  }
*** g77-e0/gcc/f/global.h.~1~	Thu Jun  4 06:41:21 1998
--- g77-e0/gcc/f/global.h	Mon Jun 29 10:11:20 1998
*************** struct _ffeglobal_
*** 109,113 ****
        ffewhereColumn save_where_col;
        bool have_size;		/* Size info avail for COMMON? */
!       long size;		/* Size info for COMMON. */
        bool blank;		/* TRUE if blank COMMON. */
      } common;
--- 109,113 ----
        ffewhereColumn save_where_col;
        bool have_size;		/* Size info avail for COMMON? */
!       ffetargetOffset size;	/* Size info for COMMON. */
        bool blank;		/* TRUE if blank COMMON. */
      } common;
*************** bool ffeglobal_ref_progunit_ (ffesymbol 
*** 149,153 ****
  void ffeglobal_save_common (ffesymbol s, bool save, ffewhereLine wl,
  			    ffewhereColumn wc);
! bool ffeglobal_size_common (ffesymbol s, long size);
  void ffeglobal_terminate_1 (void);
  
--- 149,153 ----
  void ffeglobal_save_common (ffesymbol s, bool save, ffewhereLine wl,
  			    ffewhereColumn wc);
! bool ffeglobal_size_common (ffesymbol s, ffetargetOffset size);
  void ffeglobal_terminate_1 (void);
  
*************** void ffeglobal_terminate_1 (void);
*** 165,168 ****
--- 165,169 ----
  #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)
*************** void ffeglobal_terminate_1 (void);
*** 179,183 ****
  #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)
--- 180,183 ----
*** g77-e0/gcc/f/news.texi.~1~	Mon Jun 15 03:37:26 1998
--- g77-e0/gcc/f/news.texi	Mon Jun 29 10:11:29 1998
*************** involve a combination of these elements.
*** 50,53 ****
--- 50,60 ----
  @itemize @bullet
  @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
*** g77-e0/gcc/f/target.c.~1~	Mon Jun 15 22:23:42 1998
--- g77-e0/gcc/f/target.c	Mon Jun 29 10:11:48 1998
*************** ffetarget_align (ffetargetAlign *updated
*** 218,223 ****
    assert (modulo < alignment);
  
!   /* The easy case: similar alignment requirements. */
! 
    if (*updated_alignment == alignment)
      {
--- 218,222 ----
    assert (modulo < alignment);
  
!   /* The easy case: similar alignment requirements.  */
    if (*updated_alignment == alignment)
      {
*************** ffetarget_align (ffetargetAlign *updated
*** 226,229 ****
--- 225,231 ----
        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)
*************** ffetarget_align (ffetargetAlign *updated
*** 241,245 ****
    cnt = ua / alignment;
  
!   min_pad = ~(ffetargetAlign) 0;/* Set to largest value. */
  
    /* Find all combinations of modulo values the two alignment requirements
--- 243,252 ----
    cnt = ua / alignment;
  
!   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
*************** ffetarget_align (ffetargetAlign *updated
*** 252,270 ****
        for (m = modulo, j = 0; j < cnt; m += alignment, ++j)
  	{
! 	  if (m > um)		/* This code is similar to the "easy case"
! 				   code above. */
  	    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. */
  	      *updated_alignment = ua;
  	      *updated_modulo = um;
  	      return 0;
  	    }
  	  if (pad < min_pad)
  	    {			/* New minimum padding value. */
--- 259,276 ----
        for (m = modulo, j = 0; j < cnt; m += alignment, ++j)
  	{
! 	  /* 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)
! 	    {
! 	      /* 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. */
*** g77-e0/gcc/f/version.c.~1~	Mon Jun 15 03:54:39 1998
--- g77-e0/gcc/f/version.c	Mon Jun 29 10:15:34 1998
***************
*** 1 ****
! char *ffe_version_string = "0.5.23";
--- 1 ----
! char *ffe_version_string = "0.5.24-19980629";


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]